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
"Geoffrey Summerhayes" <·······@NhOoStPmAaMil.com> wrote:
> 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.
another idea would be to define a macro for writing the usally multiple-
value-binds, if you want to call a function with values:
(defun foo (a b c d e) (list a b c d e))
(with-values (foo 1 :bind-2 (floor 11 4) 4 5)) -> (1 2 3 4 5)
The advantage is, that you can call it with normal arguments as well and
that you can wrap it this way around predefined functions and macros,
like built-ins:
(with-values (list :bind-2 (values 1 2 3) 4 5)) -> (1 2 4 5)
(note the missing 3. This can be useful sometimes, but perhaps you want
to define a ":bind-3" as well)
The code (it's a quick hack, because there are too much appends, no
general lambda list handling etc.) :
(defun build-body (args body bind-list)
(if (null args)
(loop for bind in bind-list
do (setf body (append bind (list body)))
finally return body)
(let ((arg (car args)))
(if (eql arg ':bind-2)
(let* ((args (cdr args))
(arg (car args)))
(let ((v-arg1 (gensym))
(v-arg2 (gensym)))
(build-body (cdr args)
(append body (list v-arg1 v-arg2))
(append bind-list
`((multiple-value-bind
(,v-arg1 ,v-arg2)
,arg))))))
(build-body (cdr args) (append body (list arg)) bind-list)))))
(defmacro with-values ((&body body))
(destructuring-bind (fun &rest args) body
(build-body args (list fun) '())))
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
"Frank Buss" <··@frank-buss.de> wrote in message ·················@newsreader3.netcologne.de...
>
> another idea would be to define a macro for writing the usally multiple-
> value-binds, if you want to call a function with values:
>
> (defun foo (a b c d e) (list a b c d e))
>
> (with-values (foo 1 :bind-2 (floor 11 4) 4 5)) -> (1 2 3 4 5)
>
> The advantage is, that you can call it with normal arguments as well and
> that you can wrap it this way around predefined functions and macros,
> like built-ins:
>
> (with-values (list :bind-2 (values 1 2 3) 4 5)) -> (1 2 4 5)
>
> (note the missing 3. This can be useful sometimes, but perhaps you want
> to define a ":bind-3" as well)
>
>
> The code (it's a quick hack, because there are too much appends, no
> general lambda list handling etc.) :
>
> (defun build-body (args body bind-list)
> (if (null args)
> (loop for bind in bind-list
> do (setf body (append bind (list body)))
> finally return body)
> (let ((arg (car args)))
> (if (eql arg ':bind-2)
> (let* ((args (cdr args))
> (arg (car args)))
> (let ((v-arg1 (gensym))
> (v-arg2 (gensym)))
> (build-body (cdr args)
> (append body (list v-arg1 v-arg2))
> (append bind-list
> `((multiple-value-bind
> (,v-arg1 ,v-arg2)
> ,arg))))))
> (build-body (cdr args) (append body (list arg)) bind-list)))))
>
> (defmacro with-values ((&body body))
> (destructuring-bind (fun &rest args) body
> (build-body args (list fun) '())))
>
Thanks Frank, I'll read this in a few hours after I get some sleep.
I was attempting to when I realized my code has a major flaw, it doesn't
play well with the other keywords, I'm going to have to recognize
them during the parse phase of the macro call gets assigned wrong...
I hate insomnia, time to take another try.
--
Geoff