s))))
               '(","))))
         "{" command "@" accum))

(define (embrace x)
  (define (needs-embrace? x)
    (define (has-space? x)
      (and (string? x)
           (string-index x char-set:whitespace)))
    (or (null? x) (or-map has-space? x)))
  (if (needs-embrace? x)
      (append '("}") x '("{"))
      x))

(define (serialize-text-args lp formals rest? args)
  (define (serialize-arg formal rest?)
    (let ((val (assq-ref args formal)))
      (if val
          (let ((out (append-map (lambda (x) (lp x '()))
                                 (reverse val))))
            (if rest?
                out
                (embrace out)))
          #f)))
  (define (serialize-args rformals rest?)
    (match rformals
      (() '())
      ((formal . rformals)
       (cons (serialize-arg formal rest?)
             (serialize-args rformals #f)))))
  (apply append
         (list-intersperse
          (filter identity (serialize-args (reverse formals) rest?))
          '(" "))))

(define (eol-text-args exp lp command type formals rest? args accum)
  (list* "\n"
         (serialize-text-args lp formals rest? args)
         " " command "@" accum))

(define (eol-text exp lp command type formals rest? args accum)
  (list* "\n"
         (append-map (lambda (x) (lp x '()))
                     (reverse (if args (cddr exp) (cdr exp))))
         " " command "@" accum))

(define (eol-args exp lp command type formals rest? args accum)
  (list* "\n"
         (list-intersperse
          (apply append
                 (drop-while not
                             (map (lambda (x) (assq-ref args x))
                                  (reverse formals))))
          ", ")
         " " command "@" accum))

(define (environ exp lp command type formals rest? args accum)
  (case (car exp)
    ((texinfo)
     (list* "@bye\n"
            (append-map (lambda (x) (lp x '())) (reverse (cddr exp)))
            "\n@c %**end of header\n\n"
            (reverse (assq-ref args 'title)) "@settitle "
            (or (and=> (assq-ref args 'filename)
                       (lambda (filename)
                         (cons "\n" (reverse (cons "@setfilename " filename)))))
                "")
            "\\input texinfo   @c -*-texinfo-*-\n@c %**start of header\n"
            accum))
    (else
     (list* "\n\n" command "@end "
            (let ((body (append-map (lambda (x) (lp x '()))
                                    (reverse (if args (cddr exp) (cdr exp))))))
              (if (or (null? body)
                      (eqv? (string-ref (car body)
                                        (1- (string-length (car body))))
                            #\newline))
                  body
                  (cons "\n" body)))
            "\n"
            (serialize-text-args lp formals rest? args)
            " " command "@" accum))))

(define (table-environ exp lp command type formals rest? args accum)
  (list* "\n\n" command "@end "
         (append-map (lambda (x) (lp x '()))
                     (reverse (if args (cddr exp) (cdr exp))))
         "\n"
         (let* ((arg (if args (cadar args) ""))) ;; zero or one args
           (if (pair? arg)
               (list (symbol->string (car arg)) "@")
               arg))
         " " command "@" accum))

(define (wrap strings)
  (fill-string (string-concatenate strings)
               #:line-width 72
               #:break-long-words? #f))

(define (paragraph exp lp command type formals rest? args accum)
  (list* "\n\n"
         (wrap
          (reverse
           (append-map (lambda (x) (lp x '())) (reverse (cdr exp)))))
         accum))

(define (item exp lp command type formals rest? args accum)
  (list* (append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
         "@item\n"
         accum))

(define (entry exp lp command type formals rest? args accum)
  (list* (append-map (lambda (x) (lp x '())) (reverse (cddr exp)))
         "\n"
         (append-map (lambda (x) (lp x '())) (reverse (cdar args)))
         "@item "
         accum))

(define (fragment exp lp command type formals rest? args accum)
  (list* "\n@c %end of fragment\n"
         (append-map (lambda (x) (lp x '())) (reverse (cdr exp)))
         "\n@c %start of fragment\n\n"
         accum))

(define serializers
  `((EMPTY-COMMAND . ,empty-command)
    (INLINE-TEXT . ,inline-text)
    (INLINE-ARGS . ,inline-args)
    (INLINE-TEXT-ARGS . ,inline-text-args)
    (EOL-TEXT . ,eol-text)
    (EOL-TEXT-ARGS . ,eol-text-args)
    (INDEX . ,eol-text-args)
    (EOL-ARGS . ,eol-args)
    (ENVIRON . ,environ)
    (TABLE-ENVIRON . ,table-environ)
    (ENTRY . ,entry)
    (ITEM . ,item)
    (PARAGRAPH . ,paragraph)
    (FRAGMENT . ,fragment)
    (#f . ,include))) ; support writing include statements

(define (serialize exp lp command type formals rest? args accum)
  ((or (assq-ref serializers type)
       (error "Unknown command type" exp type))
   exp lp command type formals rest? args accum))

(define escaped-chars '(#\} #\{ #\@))
(define (escape str)
  "Escapes any illegal texinfo characters (currently @{, @}, and @@)."
  (let loop ((in (string->list str)) (out '()))
    (if (null? in)
        (apply string (reverse out))
        (if (memq (car in) escaped-chars)
            (loop (cdr in) (cons* (car in) #\@ out))
            (loop (cdr in) (cons (car in) out))))))

(define (stexi->texi tree)
  "Serialize the stexi @var{tree} into plain texinfo."
  (string-concatenate-reverse
   (let lp ((in tree) (out '()))
     (cond
      ((or (not in) (null? in)) out)
      ((string? in) (cons (escape in) out))
      ((pair? in)
       (let ((command-spec (assq (car in) texi-command-specs)))
         (if (not command-spec)
             (begin
               (warn "Unknown stexi command, not rendering" in)
               out)
             (serialize in
                        lp
                        (symbol->string (car in))
                        (cadr command-spec)
                        (filter* symbol? (cddr command-spec))
                        (not (list? (cddr command-spec)))
                        (cond
                         ((and (pair? (cdr in)) (pair? (cadr in))
                               (eq? (caadr in) '%))
                          (cdadr in))
                         ((not (cadr command-spec))
                          ;; include
                          (cdr in))
                         (else
                          #f))
                        out))))
      (else
       (error "Invalid stexi" in))))))

;;; arch-tag: d3fa16ea-0bf7-4ec5-ab9f-3f08490f77f5