(defun ensure-stream (input)
  (ctypecase input
    (stream input)
    (string (make-string-input-stream input))))

(defun nconcatenate (v1 v2)
  (let* ((l1 (length v1))
         (l2 (length v2))
         (needed (+ l1 l2)))
    (when (< (array-total-size v1) needed)
      (adjust-array v1 (max needed (* l1 2)) :initial-element #\?))
    (setf (fill-pointer v1) needed)
    (replace v1 v2 :start1 l1)
    (values)))

(defun make-buffer (&optional (capacity 64))
  (make-array capacity :element-type 'character :adjustable t :fill-pointer 0))

(defmacro-driver (FOR vars IN-FASTA source)
  (nest
    (destructuring-bind (label line) vars)
    (with-gensyms (stream l))
    (let ((kwd (if generate 'generate 'for))))
    `(progn
       (with ,label = nil)
       (with ,stream = (ensure-stream ,source))
       (,kwd ,line :do-next
        (labels ((labelp (line)
                   (char= #\> (aref line 0)))
                 (parse-next ()
                   (let ((,l (read-line ,stream nil nil nil)))
                     (cond
                       ((null ,l) (terminate))
                       ((zerop (length ,l)) (parse-next))
                       ((labelp ,l) (progn (setf ,label (subseq ,l 1)
                                                 ,line (make-buffer))
                                           (parse-next)))
                       (t (progn (nconcatenate ,line ,l)
                                 (unless (char= #\> (peek-char nil ,stream nil #\>)) ; yuck
                                   (parse-next))))))))
          (parse-next))))))