git » jacl.git » commit 7e472a4

Add %COLLECTOR, WIP PSETQ

author Alan Dipert
2021-07-27 03:03:27 UTC
committer Alan Dipert
2021-07-27 03:03:27 UTC
parent a817fef919de6d1f513591daef94c51eb96f652f

Add %COLLECTOR, WIP PSETQ

boot.lisp +29 -2

diff --git a/boot.lisp b/boot.lisp
index 3b0a823..5506e99 100644
--- a/boot.lisp
+++ b/boot.lisp
@@ -516,8 +516,35 @@
 (defmacro do* (step-forms &rest more)
   (%do 'let* 'setq step-forms more))
 
-(%export 'psetq)
-(defmacro psetq (&rest pairs))
+(defun %collector ()
+  (let ((tail nil)
+        (head nil))
+    (lambda (&optional (item nil argument?))
+      (cond
+        ((not argument?) head)
+        ((null tail) (setq tail (cons item nil)
+                           head tail))
+        (t (let ((new-tail (cons item nil)))
+             (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 'dolist)
 (defmacro dolist (binding &rest body)