mv.lisp

(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)
  (if (null vars)
      `(progn () (progn ,expr nil) ,@body)
      (let ((val1# (gensym)))
        `(let* ((*mv-expected* ,(length vars))
                (,val1# ,expr))
           (let ,(make-mv-bindings vars val1#)
             ,@body)))))

(mv-bind (x) nil
  (format t "x = ~A~%" x))

(mv-bind (x) 123
  (format t "x = ~A~%" x))

(mv-bind (x y) (mv 1 2 3)
  (format t "x = ~A, y = ~A~%" x y))

(mv-bind (x y) ((lambda () (mv 1 2 3)))
  (format t "x = ~A, y = ~A~%" x y))

(mv-list (foo))

;; ;; 

;; (defun values* (&rest 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# (let ((*values* (if (boundp '*values*)
;;                                          *values*
;;                                          (make-array '(20) :fill-pointer 0))))
;;                        ,mv-form)))
;;        (if (eq ,values# *values*)
;;            (prog () ,@(loop
;;                          for v in vars
;;                          for i upfrom 0
;;                          collect `(when (> (length ,values#) ,i)
;;                                     (setq ,v (elt ,values# ,i)))))
;;            ,(when (> (length vars) 0)
;;               `(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))

;; (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))