git » jacl.git » commit 8c61b0d

diff --git a/mv.lisp b/mv.lisp
index 2ebb9aa..1881e34 100644
--- a/mv.lisp
+++ b/mv.lisp
@@ -1,24 +1,40 @@
-(defvar *values* (make-array '(20) :fill-pointer 0))
+(defvar *values*)
 
 (defun values* (&rest values)
-  (setf (fill-pointer *values*) 20)
-  (loop
-     for v in values
-     for i upfrom 0
-     do (setf (elt *values* i) v)
-     finally (progn (setf (fill-pointer *values*) (1+ i))
-                    (return *values*))))
+  (if (and (boundp '*values*)
+           (> (length values) 1))
+      (progn
+        (setf (fill-pointer *values*) 20)
+        (loop
+           for v in values
+           for i upfrom 0
+           do (setf (elt *values* i) v)
+           finally (progn (setf (fill-pointer *values*) (1+ i))
+                          (return *values*))))
+      (first values)))
 
 (defmacro multiple-value-bind* (vars mv-form &body body)
   (let ((values# (gensym)))
     `(let (,@(mapcar #'list vars)
-           (,values# ,mv-form))
+           (,values# (let ((*values* (if (boundp '*values*)
+                                         *values*
+                                         (make-array '(20) :fill-pointer 0))))
+                       ,mv-form)))
        (if (eq ,values# *values*)
-           (progn ,@(loop
-                       for v in vars
-                       for i upfrom 0
-                       collect `(when (> (length ,values#) ,i)
-                                  (setq ,v (elt ,values# ,i)))))
+           (prog () ,@(loop
+                         for v in vars
+                         for i upfrom 0
+                         collect `(when (> (length ,values#) ,i)
+                                    (setq ,v (elt ,values# ,i)))))
            ,(when (> (length vars) 0)
-              `(setq ,(first vars) ,values#)))
+              `(prog () (setq ,(first vars) ,values#))))
        ,@body)))
+
+(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))