45 lines
1.9 KiB
Common 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)))))
|