Re: Accepting and returning multiple values in 'cl

[Dave Goel <deego3@gmail.com>]

> I'm not sure it's worth trying to develop the cl.el MRV stuff much
> unless it actually works like real CL MRVs:
>
>    (1) _efficient_, no consing
>
>    (2) seamlessly interoperable with SRVs (e.g., non-MRV-aware callers
>        can just pretend a MRV function returns a single value, with no
>        effort on their part)


Miles, In response to these points: after further thinking, I have
added a section on pros and cons at the beginning, and a new test
example of the gotchas at the end.  It seems that no modification to
any SR oerations is needed, so point 2 is takesn care of.  No
efficiency is lost at all for the usual SR stuff eiter.

When I asked to ignore my post, I had worried that the implementation
suffered from a flaw, but with a simple convention that m-v users can
follow, this can be overcome, and is much better than trying to modify
all SR functions.  This way of m-v handling seems preferable to me
than the (list) way of doing things.

Attaching the new file.

;;; cl-multiple.el ---  Handle multiple return values in emacs.
;;
;; Time-stamp: <2009-03-12 12:23:07 deego>
;; Copyright (C) 2009 Dave Goel
;; Emacs Lisp Archive entry
;; Filename: cl-multiple.el
;; Package: cl-multiple
;; Author: Dave Goel <deego3@gmail.com>
;; Keywords:  
;; Version:  dev
 

;; This file is not part of GNU Emacs.
 
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
 
;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; 
;;; Cons, and gotchas:

;;; We don't want to change the usual single-value functions in emacs,
;;; so as to avoid any overhead.  However, this can lead to funny
;;; situations, for example:
;;; 
;;;  (multiple-value-setq (a b) (progn (values 1 2) 3)) a and b should
;;;     be set to 3 and nil respectively, but they are set to 3 and 2
;;;     respectively.

;;; The workaround is very simple for m-v users, and works no matter
;;; how deep you go in the stack. S-v users can continue to function
;;; normally in any case.

;;; Workaround: Any time you have a list of forms, the final form
;;; should always return its value(s) via (values).  Moreover, this
;;; condition only need be satisfied only when one or more among the
;;; list of forms actually returns multiple (or zero) values.  Thus,
;;; in the above example, the right thing can be done by:
;;; (multiple-value-setq (a b) (progn (values 1 2) (values 3)))

;;; If however, a list of your forms looks like:
;;; (progn 1 (list 1 2 ) 3 5), you need not modify your 5 to read
;;; (values 5), because nothing else in your form returned an
;;; abnormal number of values. 

;;; Pros: 

;;; (1) Better CL compatibility.

;;; (2) Suppose you choose to modify your existing function to
;;; return an extra value. Everything that depends on your function
;;; will break in the current emacs, because multiple values become
;;; lists.  You will need to go and hunt for every such invocation of
;;; your function.  But, not in this new way, which is much closer to
;;; the common lisp way.

;;; (3) Also, you can easily do things like these, which is currently not
;;; possible.  If floor* returns (values) rather than a list, you can
;;; make *both* these work.  Currently, only one works. 
;;; 
;;; (setq a (floor* 1 2)) 
;;; (multiple-value-setq (a b) (floor* 1 2))




;;;
;;; Single-value users can continu 

(require 'cl)

(defconst multiple-values-limit most-positive-fixnum
  "Our implementation has no internal limit.")

;; This variable should never be used by anything except values.
(defvar cl-internal-multiple nil
  "Internal variable.  Every multiple-value-acceptor binds this
variable to to nil before calling each of its arguments. 

When a call to values returns one value, it leaves this variable
as nil.

When a call to values returns > 1 value, it sets this variable equal
to the cdr of the list of its returned values.

When a call to values returns 0 values, it sets this varible to nil.")

;; These functions are not defined in regular emacs anyway. So, if
;; someone calls them, we can afford to autoload these. Regular cl
;; seems to autoload them too. todo: double-check.


(defun values-list (ls)
  (let ((a1 (car ls)))
    (setq cl-internal-multiple 
	  (if ls (cdr ls) 0))
    a1))

(defun values (&rest args)
  (values-list args))


(defmacro cl-internal-multiple-values-obtain (&rest args)
  "As a test case, try to call this on three args, each providing values."
  (let* ((max (- (length args) 1))
	 (temp (gensym "--cl-var--")))
    (cons 'list 
	  (loop for ii from 0 to max
		collect
		`(let ((cl-internal-multiple nil)
		       ,temp)
		   (setq ,temp ,(nth ii args))
		   (if 
		       (listp cl-internal-multiple)
		       (cons ,temp cl-internal-multiple)
		     nil))))))



(defmacro multiple-value-bind (vars form &rest body)
  ;; This itself needs to return only one value.
  ;; We do need to eval ALL forms, but set only as many as supplied in
  ;; vars.
  (let ((temp (gensym "--cl-var--"))
	(l1 (length vars)))
    `(let ((,temp (first (cl-internal-multiple-values-obtain ,form))))
       (let
	   ,(loop for ii from  0 to (- l1 1) 
		  collect
		  `( ,(nth ii vars) (nth ,ii ,temp)))
	 ,@body))))



(defmacro multiple-value-call (fn &rest forms)
  (let ((temp (gensym "--cl-var--")))
    `(let ((,temp (cl-internal-multiple-values-obtain ,@forms)))
       (apply ,fn 
	      (apply #'append ,temp)))))



(defmacro multiple-value-list (form)
  `(car (cl-internal-multiple-values-obtain ,form)))


(defmacro multiple-value-prog1 (form &rest others)
  (let ((temp (gensym "--cl-var--")))
    `(let  
	 ((,temp (cl-internal-multiple-values-obtain ,form)))
       ,@others
       (values-list (car ,temp)))))



(defmacro multiple-value-setq (vars form)
  ;; We do need to eval ALL forms, but set only as many as supplied in
  ;; vars.
  (let ((temp (gensym "--cl-var--"))
	(l1 (length vars)))
    `(let ((,temp (first (cl-internal-multiple-values-obtain ,form))))
       ,(cons 'prog1 
	      (loop for ii from  0 to (- l1 1) 
		    collect
		    `(setf ,(nth ii vars) (nth ,ii ,temp)))))))


;;;====================================================
;; These functions in cl-extra should now be tweaked to return
;; (values) instead of (list). Until now, values was == list, so it
;; was ok for them to use (list):
;; floor*, ceiling*, truncate*, round*, mod*. 


;; tests. 

(defun cl-internal-test-1-values-values-list-and-setq ()
  (interactive)
  (let ( a b c d e f)
    (multiple-value-setq 
 	(a b c)
      (values-list '(1 2 3)))
    (multiple-value-setq 
 	(d e f)
      (values 4 5 6))
    (message "1 2 3 4 5: %s %s %s %s %s %s" a b c d e f)))



(defun cl-internal-test-2-bind ()
  (interactive)
  (let ((a 0) b c d)
    (multiple-value-bind
 	(a b c d)
 	(values 1 2 3 4)
      (setq b c)
      (setq d a)
      (message "1 3 3 1: %s %s %s %s .. sleeping for 2" a b c d))
    (sit-for 2)
    (message "0 nil nil nil nil: %s %s %s %s" a b c d)))

(defun cl-internal-test-3-call ()
  (interactive)
  (let ((sum 
 	 (multiple-value-call
 	  #'+
 	  (values 1 2 3)
 	  (values)
 	  2 
 	  (values 5 6 7))))
    (message "26: %s" sum)))

(defun cl-internal-test-4-list ()
  (interactive)
  (let ((a (multiple-value-list (values)))
 	(b (multiple-value-list (values 1 2 3)))
 	(c (multiple-value-list 4))
 	(d (multiple-value-list 5)))
    (message "nil (1 2 3) (4) (5): %s %s %s %s" a b c d)))

(defun cl-internal-test-5-prog1 ()
  (interactive)
  (let (a b c d e f)
    (multiple-value-setq 
 	(a b c d)
      (multiple-value-prog1
       (values 1 2 3 4)
       nil 
       (setq e 5)
       (values 5 6 7 8)))
    (message "1 2 3 4 5: %s %s %s %s %s" a b c d e)))

(defun cl-internal-test-6-gotchas ()
  (interactive)
  (flet 
      ((fmy (&rest args)
	    (progn
	      (values 1 2 3)
	      4 5 6
	      nil
	      (values)
	      7
	      (values-list args)))
       (gmy (&rest args)
	    8
	    (values 9 10)
	    (apply #'fmy (cdr args))))
      (let ((hmy (multiple-value-list (gmy 12 13))))
	(message "(13): %s" hmy))))


       
      

(provide 'cl-multiple)
(run-hooks 'cl-multiple-after-load-hook)


;;; cl-multiple.el ends here