From ec18c92a0624f298b1b316163578dc5b88c02067 Mon Sep 17 00:00:00 2001 From: mdw Date: Mon, 13 Feb 2006 11:54:16 +0000 Subject: [PATCH] base: Implement named-let and while. --- mdw-base.lisp | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/mdw-base.lisp b/mdw-base.lisp index 3111832..edebebb 100644 --- a/mdw-base.lisp +++ b/mdw-base.lisp @@ -86,6 +86,24 @@ where Y defaults to A if not specified." ((#\space #\tab #\newline #\return #\vt #\formfeed) t) (t nil))) +(defmacro nlet (name binds &body body) + "Scheme's named let." + (multiple-value-bind (vars vals) + (loop for bind in binds + for (var val) = (pairify bind nil) + collect var into vars + collect val into vals + finally (return (values vars vals))) + `(labels ((,name ,vars + ,@body)) + (,name ,@vals)))) + +(defmacro while (cond &body body) + "If COND is false, evaluate to nil; otherwise evaluate BODY and try again." + `(loop + (unless `cond (return)) + ,@body)) + (declaim (ftype (function nil ()) slot-unitialized)) (defun slot-uninitialized () "A function which signals an error. Can be used as an initializer form in -- 2.11.0