git » jacl.git » commit ede0471

diff --git a/boot.lisp b/boot.lisp
index d7030ee..526cbac 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -388,11 +388,6 @@
   (declare (rest-array args))
   (\. function (|apply| function (%js "unspread(~{})" args))))
 
-(%export 'do)
-(defmacro do (vars end &body body)
-  `(let ,(%js "Cons.fromArray(Array.from(~{}).map(([name, val]) => Cons.listOf(name, val)))" vars)
-     ,@body))
-
 (defun %map-pairs (fun pairs)
   (let ((head nil)
         (tail nil))
@@ -482,14 +477,61 @@
       (\. symbol |name|)))
 
 (defun %parse-step-forms (step-forms)
-  )
-
+  (%js "Cons.fromArray(~{})"
+       (%js "List.toArray(~{}).flatMap(~{})"
+            step-forms
+            (lambda (step-form idx arr)
+              (if (car step-form)
+                  (list (car step-form)
+                        (cadr step-form)
+                        (or (caddr step-form)
+                            (car step-form)))
+                  (list))))))
+
+;; (\. (%js "console") (|log| (%js "prstr(~{})" (%parse-step-forms '((x 1) (y 1 (1+ y)))))))
+;; (\. (%js "console") (|log| #'car))
+
+(defun %mapcar (function list)
+  (%js "Cons.fromArray(~{})"
+       (%js "List.toArray(~{}).map(x => ~{}(x))"
+            list
+            function)))
+
+(defun %remove (x list)
+  (%js "Cons.fromArray(~{})"
+       (%js "List.toArray(~{}).filter(x => ~{}(x, ~{}) === null)"
+            list
+            #'eq
+            x)))
+
+;; )]
 (%export 'do)
 (defmacro do (step-forms &rest more)
   (let* ((end-test-and-result-forms (car more))
-         (end-test-form (car end-test-and-result-forms))
-         (result-forms (cdr end-test-and-result-forms))
-         (body (cdr more)))))
+         (end-test-form             (car end-test-and-result-forms))
+         (result-forms              (cdr end-test-and-result-forms))
+         (body                      (cdr more))
+         (parsed-step-forms         (%parse-step-forms step-forms))
+         (begin#                    (gensym "begin"))
+         (bindings                  (%mapcar (lambda (step-form)
+                                               (list (car step-form) (cadr step-form)))
+                                             parsed-step-forms))
+         (assignments               (%remove nil
+                                             (%mapcar (lambda (step-form)
+                                                        (when (caddr step-form)
+                                                          `(setq ,(car step-form) ,(caddr step-form))))
+                                                      parsed-step-forms)))
+         (end#                      (gensym "end")))
+    `(block nil
+       (let ,bindings
+         (tagbody
+            ,begin#
+            (if ,end-test-form (go ,end#))
+            ,@assignments
+            ,@body
+            (go ,begin#)
+            ,end#
+            (progn ,@result-forms))))))
 
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index b8975a1..056e3c4 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -144,6 +144,14 @@
   (assert= (function +) (function +) "FUNCTION")
   (assert= (function +) (symbol-function '+) "SYMBOL-FUNCTION"))
 
+
+(in-module "Iteration")
+
+(deftest "DO"
+  (do ((i 0 (1+ i)))
+      ((eql i 5) (assert= i 5))
+    (return i)))
+
 (start-tests)
 
 ;; ;; (in-module "Control operators")