shithub: femtolisp

Download patch

ref: 76edead57b93fa867dd655c6fca3f759db1d0885
parent: 3aad0bd6bed1e0d7e137709fb41393066af448be
author: JeffBezanson <[email protected]>
date: Fri Feb 20 14:50:35 EST 2009

adding (do ) form


--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -424,6 +424,25 @@
 			    (cdr clause)))
 		    clauses)))))
 
+(define-macro (do vars test-spec . commands)
+  (let ((loop (gensym))
+	(test-expr (car test-spec))
+	(vars  (map car  vars))
+	(inits (map cadr vars))
+	(steps (map (lambda (x)
+		      (if (pair? (cddr x))
+			  (caddr x)
+			  (car x)))
+		    vars)))
+    `(letrec ((,loop (lambda ,vars
+		       (if ,test-expr
+			   (begin
+			     ,@(cdr test-spec))
+			   (begin
+			     ,@commands
+			     (,loop ,@steps))))))
+       (,loop ,@inits))))
+
 (define-macro (dotimes var . body)
   (let ((v (car var))
         (cnt (cadr var)))