base: Implement named-let and while.

diff --git a/mdw-base.lisp b/mdw-base.lisp
index 3111832..edebebb 100644 (file)
--- 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