syrup/control-flow.lisp

45 lines
1.9 KiB
Common Lisp

(in-package #:syrup)
(defun translate-if* (test body)
(let ((then-forms
;; Collect all un-enclosed forms at the start of the body, and skip past them.
;; These forms are considered part of an implicit :THEN clause.
(loop :for tail :on body
:for form := (car tail)
:until (and (consp form) (find (car form) '(:then :else-if :else)))
:collect form
:finally (setf body tail)))
(else-if-forms nil)
(else-forms nil))
;; Handle :THEN, :ELSE, and :ELSE-IF clauses
(loop :for tail :on body
:for form := (car tail)
:do
(unless (consp form) (error "Not a valid IF* clause: ~S" form))
(case (car form)
(:then
(when then-forms (error "Duplicate :THEN clause"))
(setf then-forms (cdr form)))
(:else
(when (cdr tail) (error "Junk after :ELSE clause: ~S" (cdr tail)))
(setf else-forms (cdr form))
(loop-finish))
(:else-if ;; handle these recursively
(setf else-forms (list (translate-if* (cadr form) `((:then ,@(cddr form)) ,@(cdr tail)))))
(loop-finish))
(t (error "Not a valid IF* clause: ~S" form))))
;; Now build the if statement
(labels ((maybe-progn (x)
(if (cdr x) (cons 'progn x) (car x))))
(if else-forms
`(if ,test ,(maybe-progn then-forms) ,(maybe-progn else-forms))
`(when ,test ,@then-forms)))))
(defmacro if* (test &body body)
"An easier-to-read conditional statement."
(translate-if* test body))
(defmacro while (test &body body)
"Repeatedly evaluate BODY while TEST is true. Return the result of the last iteration, a la PROGN."
(let ((result-var (gensym)))
`(do (,result-var) ((not ,test) ,result-var) (setf ,result-var (progn ,@body)))))