multiple value defun

• Previous message: Christian Jullien: "ANNONCE: free OpenLisp port on MVS OS/390"
• Next in thread: Frank Buss: "Re: multiple value defun"
• Reply: Frank Buss: "Re: multiple value defun"
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]

Date: Tue, 29 Mar 2005 00:48:38 -0500

I was thinking about something I wanted to do with the painter code
today and realized it would be nice if I could use multiple values
without having to it show in the top level coding. Then
looking at values and standard lambda lists as orthogonal as in
(fn (values 3 4)(values 2 7)) == (fn 3 2)
When I'd like to capture the 4 and 7 sometimes.
Kind of dashed it off, sorry about the variable names.
Looking for comments, replacements, improvements, etc.

(defun parse-lambda-list (list)
  (let (binders mv-lists quick args)
    (do ((x list (rest x)))
        ((null x) (values (nreverse binders) (nreverse mv-lists)
                          (nreverse quick) (nreverse args)))
      (if (eq '&mv (first x))
          (let ((g (gensym)))
            (unless (listp (second x))
              (error "Error argument for &mv not a list: ~S in ~S"
                     (second x) list))
            (push (second x) binders)
            (push g mv-lists)
            (push t quick)
            (push g args)
            (setf x (rest x))) ; skip what follows &mv
        (progn (push nil quick)
          (push (first x) args))))))

(defun generate-funcall (fname arg-list quick)
  (cons fname
        (mapcar (lambda (arg use)
                  (if use
                      (list 'multiple-value-list arg)
                    arg))
                arg-list quick)))

(defmacro defun+ (fn-name arg-list &body body)
  (multiple-value-bind (b m q a) (parse-lambda-list arg-list)
    (if (null m)
        `(defun ,fn-name ,arg-list ,@body)
      (let ((fn (gensym)))
        `(progn
           (defun ,fn ,a (destructuring-bind ,b ,(cons 'list m)
                           ,@body))
           (defmacro ,fn-name (&rest args)
             (generate-funcall ',fn args ',q)))))))

Example:

CL-USER 39 > (defun+ foo (a b &mv (c &optional d &rest r) &mv (e f))
                               (list a b c d e f r))
FOO

CL-USER 40 > (foo 1 2 3 (values 4 5))
(1 2 3 NIL 4 5 NIL)

CL-USER 41 > (foo 1 2 (values 3 4 5 6 7) (values 4 5))
(1 2 3 4 4 5 (5 6 7))

--
Geoff 

• Previous message: Christian Jullien: "ANNONCE: free OpenLisp port on MVS OS/390"
• Next in thread: Frank Buss: "Re: multiple value defun"
• Reply: Frank Buss: "Re: multiple value defun"
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]