git » jacl.git » commit 234ddf2

mv prototype updates

author Alan Dipert
2020-07-30 12:42:32 UTC
committer Alan Dipert
2020-07-30 12:42:32 UTC
parent 19561cde81491d6f568bcbb1cef2ad3b1e6d6ba0

mv prototype updates

mv.lisp +65 -1

diff --git a/mv.lisp b/mv.lisp
index 1881e34..814a6a4 100644
--- a/mv.lisp
+++ b/mv.lisp
@@ -1,4 +1,63 @@
-(defvar *values*)
+(defconstant mv-limit 20)
+
+(defparameter *mv-expected* 1)
+
+(defparameter *mv* (make-array mv-limit))
+
+(defun mv (&rest vals)
+  (do ((i 0 (1+ i))
+       (vs vals (cdr vs)))
+      ((or (eql i *mv-expected*) (null vs))
+       (setq *mv-expected* (min i mv-limit))
+       (car vals))
+    (setf (aref *mv* i) (car vs))))
+
+(defmacro mv-list (form)
+  (let ((val1# (gensym)))
+    `(let* ((*mv-expected* mv-limit)
+            (,val1# ,form))
+       (if (eql *mv-expected* mv-limit)
+           (list ,val1#)
+           (coerce (subseq *mv* 0 *mv-expected*)
+                   'list)))))
+
+(defun make-mv-bindings (vars val1# &aux (i 0))
+  (mapcar (lambda (var)
+            (prog1
+                (if (zerop i)
+                    `(,var ,val1#)
+                    `(,var (when (< ,i *mv-expected* mv-limit)
+                             (aref *mv* ,i))))
+              (incf i)))
+          vars))
+
+(defmacro mv-bind (vars expr &body body)
+  (let ((val1# (gensym)))
+    `(let* ((*mv-expected* ,(length vars))
+            (,val1# ,expr))
+       (let ,(make-mv-bindings vars val1#)
+         ,@body))))
+
+(multiple-value-bind* (x) nil
+  (format t "x = ~A~%" x))
+
+(multiple-value-bind* (x) 123
+  (format t "x = ~A~%" x))
+
+(multiple-value-bind* (x y) (values* 1 2 3)
+  (format t "x = ~A, y = ~A~%" x y))
+
+(multiple-value-bind* (x y) ((lambda () (values* 1 2 3)))
+  (format t "x = ~A, y = ~A~%" x y))
+
+
+(multiple-value-list* (foo))
+
+
+
+
+
+;; 
 
 (defun values* (&rest values)
   (if (and (boundp '*values*)
@@ -30,6 +89,11 @@
               `(prog () (setq ,(first vars) ,values#))))
        ,@body)))
 
+(format t "~A~%" (multiple-value-bind* () nil))
+
+(multiple-value-bind* (x) nil
+  (format t "x = ~A~%" x))
+
 (multiple-value-bind* (x) 123
   (format t "x = ~A~%" x))