always-accum.lisp

(defmacro always-accum-helper (stash-var)
  `(setf ,stash-var ,iter::*result-var*))

(defmacro always-accum ((acc &rest acc-args) &body body)
  (multiple-value-bind (iter-name body)
      (if (symbolp (car body))
          (values (car body) (cdr body))
          (values nil body))
    (with-gensyms (stash-result-var)
      `(let ((,stash-result-var nil))
         (unwind-protect
              (iter ,iter-name
                (unwind-protect
                     (progn ,@body)
                  (always-accum-helper ,stash-result-var)))
           (,acc ,stash-result-var ,@acc-args))))))

(defun parse-simple-format-lambda-list (lambda-list)
  "Returns (values REQ-ARGS OPT-ARGS REST-ARG KEY-ARGS)"
  (values-list
   (iter arg-types
     (for next-arg-type in '(&optional &rest &key))
     (generate arg in lambda-list)
     (if-first-time (next arg))
     (always-accum (collect)
       (until (or (null arg) (member arg lambda-list-keywords)))
       (collect arg)
       (in arg-types (next arg)))
     (when (eq arg next-arg-type)
       (next arg)))))