git » jacl.git » commit 2ab8380

diff --git a/boot.lisp b/boot.lisp
index ec63e9e..1b51785 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -489,8 +489,7 @@
   (%js "[...~{}].reduce((x, y) => Cons.append(x, y))"
        (%mapcar function list)))
 
-(%export 'do*)
-(defmacro do* (step-forms &rest more)
+(defmacro %do (op-bind op-set 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))
@@ -499,12 +498,12 @@
          (bindings                  (%mapcar (lambda (step-form)
                                                (list (car step-form) (cadr step-form)))
                                              step-forms))
-         (assignments               `(setq ,@(%mapcan (lambda (step-form)
-                                                        (when (caddr step-form)
-                                                          (list (car step-form) (caddr step-form))))
-                                                      step-forms))))
+         (assignments               `(,op-set ,@(%mapcan (lambda (step-form)
+                                                            (when (caddr step-form)
+                                                              (list (car step-form) (caddr step-form))))
+                                                          step-forms))))
     `(block nil
-       (let* ,bindings
+       (,op-bind ,bindings
          (tagbody
             ,begin#
             (if ,end-test-form
@@ -513,6 +512,13 @@
             ,@body
             (go ,begin#))))))
 
+(%export 'do*)
+(defmacro do* (step-forms &rest more)
+  `(%do let* setq ,step-forms ,@more))
+
+(%export 'psetq)
+(defmacro psetq (&rest pairs))
+
 (%export 'dolist)
 (defmacro dolist (binding &rest body)
   (let ((list# (gensym "list")))
diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index c8f84b2..e163055 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -144,6 +144,9 @@
   (assert= (function +) (function +) "FUNCTION")
   (assert= (function +) (symbol-function '+) "SYMBOL-FUNCTION"))
 
+(in-module "Assignment")
+(deftest "PSETQ")
+
 (in-module "Iteration")
 
 (deftest "DO*"