(define read-string
  (lambda (ip)
    (unless (eqv? (read-char ip) #\")
      (error 'read-string "no starting double-quote"))
    (list->string
      (let f ()
        (let ([c (read-char ip)])
          (cond
            [(eqv? c #\") '()]
            [(or (eqv? c #\newline) (eof-object? c))
             (error 'read-string "no ending double-quote")]
            [else (cons c (f))]))))))

(define readrol
   (lambda (ip)
      (let ([c (read-char ip)])
         (if (eq? c #\newline)
             '()
             (cons c (readrol ip))))))

(define read-line
  (lambda (ip)
    (if (eof-object? (peek-char ip))
        (peek-char ip)
        (let ([x (read-string ip)])
          (cons x (readrol ip))))))

(define summary-read
   (lambda (ip)
      (do ([ls '() (cons line ls)]
           [line (read-line ip) (read-line ip)])
          ((eof-object? line) (reverse! ls)))))

(define summary-sort
   (lambda (x)
      (sort! (lambda (x y) (string<? (car x) (car y))) x)))

(define write-list
   (lambda (ls op)
      (unless (null? ls)
         (write-char (car ls) op)
         (write-list (cdr ls) op))))

(define summary-print
   (lambda (x op)
      (for-each
         (lambda (x) (write-list (cdr x) op) (newline op))
         x)))

(define summary-make
  (lambda (root)
    (parameterize ((reset-handler abort))
      (let ([ip (open-input-file (format "~a.rfm" root))]
            [op (open-output-file (format "~a.sfm" root) 'replace)])
        (dynamic-wind
          (lambda () #f)
          (lambda ()
            (fprintf op "\\begin{thesummary}~%")
            (summary-print
              (summary-sort (summary-read ip))
              op)
            (fprintf op "\\end{thesummary}~%"))
          (lambda ()
            (close-input-port ip)
            (close-output-port op)))))))