Plaster

common-lisp
(ql:quickload '(:alexandria) :silent t) (defmacro mvdo ((&rest bindings) (end-test &body end-forms) &body body) "(mvdo (((var1 var2 ... varN) init-form step-form) ...) (end-test-form result-form ...) declaration ... body ...) => result ... Much like do but the init and step forms can return multiple values that are all bound." (multiple-value-bind (body-forms declarations doc-string) (alexandria:parse-body body :whole 'mvdo*) (declare (ignore doc-string)) (alexandria:with-gensyms (gbegin) `(block nil (let ,(loop for binding in bindings append (first binding)) (locally ,@declarations (tagbody (psetf ,@(loop for binding in bindings collect (cons 'values (first binding)) collect (second binding))) ,gbegin (if ,end-test (return (progn ,@end-forms)) (progn ,@body-forms (psetf ,@(loop for binding in bindings collect (cons 'values (first binding)) collect (third binding))) (go ,gbegin)))))))))) (defmacro mvdo* ((&rest bindings) (end-test &body end-forms) &body body) "(mvdo* (((var1 var2 ... varN) init-form step-form) ...) (end-test-form result-form ...) declaration ... body ...) => result ... Much like do* but the init and step forms can return multiple values that are all bound." (multiple-value-bind (body-forms declarations doc-string) (alexandria:parse-body body :whole 'mvdo*) (declare (ignore doc-string)) (alexandria:with-gensyms (gbegin) `(block nil (let ,(loop for binding in bindings append (first binding)) (locally ,@declarations (tagbody ,@(loop for binding in bindings collect (list 'multiple-value-setq (first binding) (second binding))) ,gbegin (if ,end-test (return (progn ,@end-forms)) (progn ,@body-forms ,@(loop for binding in bindings collect (list 'multiple-value-setq (first binding) (third binding))) (go ,gbegin))))))))))