git » jacl.git » commit c86d4ca

diff --git a/boot.lisp b/boot.lisp
index 5506e99..834822e 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -480,14 +480,14 @@
       (\. symbol |name|)))
 
 (defun %mapcar (function list)
-  (%js "Cons.fromArray(~{})"
-       (%js "List.toArray(~{}).map(x => ~{}(x))"
-            list
-            function)))
+  (when list
+    (cons (funcall function (car list))
+          (%mapcar function (cdr list)))))
 
 (defun %mapcan (function list)
-  (%js "[...~{}].reduce((x, y) => Cons.append(x, y))"
-       (%mapcar function list)))
+  (when list
+    (append (funcall function (car list))
+            (%mapcan function (cdr list)))))
 
 (defun %do (op-bind op-set step-forms more)
   (let* ((end-test-and-result-forms (car more))
@@ -508,8 +508,8 @@
                     ,begin#
                     (if ,end-test-form
                         (return (progn ,@result-forms)))
-                    ,assignments
                     ,@body
+                    ,assignments
                     (go ,begin#))))))
 
 (%export 'do*)
@@ -528,29 +528,34 @@
              (rplacd tail new-tail)
              (setq tail new-tail)))))))
 
-;; (%export 'psetq)
-;; (defmacro psetq (&rest pairs)
-;;   (let ((tmp-names (do* ((collect (%collector))
-;;                          (head pairs (cddr head)))
-;;                         ((not head) (funcall collect))
-;;                      (%log (funcall collect))
-;;                      (funcall collect (list (gensym) (car head) (cadr head))))))
-;;     (%log tmp-names)
-;;     ;; (let ,(%mapcar (lambda (triple) (list (car triple)))
-;;      ;;                triples)
-;;      ;;   (setq ,@(%mapcan (lambda (triple)
-;;      ;;                      (list (car triple) (caddr triple)))
-;;      ;;                    triples))
-;;      ;;   (setq ,@(%mapcan (lambda (triple)
-;;      ;;                      (list (cadr triple) (car triple)))
-;;      ;;                    triples))))
-;;   )
+(%export 'psetq)
+(defmacro psetq (&rest pairs)
+  (let ((triples (do* ((collect (%collector))
+                       (head pairs (cddr head)))
+                      ((not head) (funcall collect))
+                   (funcall collect (list
+                                     (gensym "psetq-var")
+                                     (car head)
+                                     (cadr head))))))
+    `(let ,(%mapcar (lambda (triple)
+                      (list (car triple)))
+                    triples)
+       (setq ,@(%mapcan (lambda (triple)
+                          (list (car triple) (caddr triple)))
+                        triples))
+       (setq ,@(%mapcan (lambda (triple)
+                          (list (cadr triple) (car triple)))
+                        triples)))))
+
+(%export 'do)
+(defmacro do (step-forms &rest more)
+  (%do 'let 'psetq step-forms more))
 
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
   (let ((list# (gensym "list")))
-    `(do* ((,(car binding) nil (car ,list#))
-          (,list# ,(cadr binding) (cdr ,list#)))
+    `(do* ((,list# ,(cadr binding) (cdr ,list#))
+           (,(car binding) (car ,list#) (car ,list#)))
          ((not ,list#) ,(caddr binding))
        ,@body)))
 
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index e163055..0f35429 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -145,7 +145,15 @@
   (assert= (function +) (symbol-function '+) "SYMBOL-FUNCTION"))
 
 (in-module "Assignment")
-(deftest "PSETQ")
+
+(deftest "PSETQ"
+    (let ((a 1)
+          (b 2)
+          (c 3))
+      (psetq a (1+ b) b (1+ a) c (+ a b))
+      (assert= a 3)
+      (assert= b 2)
+      (assert= c 3)))
 
 (in-module "Iteration")
 
@@ -161,7 +169,7 @@
         (y x (1+ x)))
        ((eql x 5) (assert= y 6))))
 
-;; (deftest "DO")
+(deftest "DO")
 
 (deftest "DOLIST"
   (let ((x 0))