macro to feed a calculated binding list into a 'let'?

Question

I'm trying different binding models for macro lambda lists.

Edit: in fact the lambda list for my test macros is always (&rest ...). Which means that I'm 'destructuring' the argument list and not the lambda list. I try to get a solution that works for combining optional with key arguments or rest/body with key arguments - both combinations don't work in the Common Lisp standard implementation.

So I have different functions giving me a list of bindings having the same syntax as used by 'let'.

E.g:

(build-bindings ...) => ((first 1) middle (last "three"))

Now I thought to use a simple macro inside my test macros feeding such a list to 'let'.

This is trivial if I have a literal list:

(defmacro let-list (_list &rest _body)
  `(let ,_list ,@_body))

(let-list ((a 236)) a) => 236

But that's the same as a plain 'let'.

What I'd like to have is the same thing with a generated list.

So e.g.

(let-list (build-bindings ...)
    (format t "first: ~s~%" first)
    last)

with (build-bindings ...), evaluated in the same lexical scope as the call (let-list ...), returning

((first 1) middle (last "three"))

the expansion of the macro should be

(let
  ((first 1) middle (last "three"))

  (format t "first: ~s~%" first)
  last)

and should print 1 and return "three".

Any idea how to accomplish that?

Edit (to make the question more general):

If I have a list of (symbol value) pairs, i.e. same syntax that let requires for it's list of bindings, e.g. ((one 1) (two 'two) (three "three")), is there any way to write a macro that creates lexical bindings of the symbols with the supplied values for it's &rest/&body parameter?

This is seems to be a possible solution which Joshua pointed me to:

(let ((list_ '((x 23) (y 6) z)))

  (let
    ((symbols_(loop for item_ in list_
                    collect (if (listp item_) (car item_)  item_)))
     (values_ (loop for item_ in list_
                    collect (if (listp item_) (cadr item_)  nil))))

    (progv symbols_ values_
      (format t "x ~s, y ~s, z ~s~%" x y z))))

evaluates to:

;Compiler warnings :
;   In an anonymous lambda form: Undeclared free variable X
;   In an anonymous lambda form: Undeclared free variable Y
;   In an anonymous lambda form: Undeclared free variable Z
x 23, y 6, z NIL

I could also easily rearrange my build-bindings functions to return the two lists needed.

One problem is, that the compiler spits warnings if the variables have never been declared special.

And the other problem that, if the dynamically bound variables are also used in a surrounding lexical binding, they a shadowed by the lexical binding - again if they have never been declared special:

(let ((x 47) (y 11) (z 0))

  (let ((list_ '((x 23) (y 6) z)))

    (let
      ((symbols_(loop for item_ in list_
                      collect (if (listp item_) (car item_)  item_)))
       (values_ (loop for item_ in list_
                      collect (if (listp item_) (cadr item_)  nil))))

      (progv symbols_ values_
        (format t "x ~s, y ~s, z ~s~%" x y z)))))

evaluates to:

x 47, y 11, z 0

A better way could be:

(let ((x 47) (y 11) (z 0))

  (locally
    (declare (special x y))

    (let ((list_ '((x 23) (y 6) z)))

      (let
        ((symbols_(loop for item_ in list_
                        collect (if (listp item_) (car item_)  item_)))
         (values_ (loop for item_ in list_
                        collect (if (listp item_) (cadr item_)  nil))))

        (progv symbols_ values_
          (format t "x ~s, y ~s, z ~s~%" x y z))))))

evaluates to:

;Compiler warnings about unused lexical variables skipped
x 23, y 6, z NIL

I can't see at the moment whether there are other problems with the dynamic progv bindings.

But the whole enchilada of a progv wrapped in locally with all the symbols declared as special cries for a macro again - which is again not possible due to same reasons let-list doesn't work :(

The possiblilty would be a kind of macro-lambda-list destructuring-hook which I'm not aware of.

I have to look into the implementation of destructuring-bind since that macro does kind of what I'd like to do. Perhaps that will enlight me ;)

Answer 1

So a first (incorrect) attempt would look something like this:

(defun build-bindings ()
  '((first 1) middle (last "three")))

(defmacro let-list (bindings &body body)
  `(let ,bindings
     ,@body))

Then you could try doing something like:

(let-list (build-bindings)
  (print first))

That won't work, of course, because the macro expansion leaves the form (build-bindings) in the resulting let, in a position where it won't be evaluated:

CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
                                  (print first))))
(LET (BUILD-BINDINGS)
  (PRINT FIRST))

Evaluation during Macroexpansion time

The issue is that you want the result of build-bindings at macroexpansion time, and that's before the code as a whole is run. Now, in this example, build-bindings can be run at macroexpansion time, because it's not doing anything with any arguments (remember I asked in a comment what the arguments are?). That means that you could actually eval it in the macroexpansion:

(defmacro let-list (bindings &body body)
  `(let ,(eval bindings)
     ,@body))

CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
                                  (print first))))
(LET ((FIRST 1) MIDDLE (LAST "three"))
  (PRINT FIRST))

Now that will work, insofar as it will bind first, middle, and last to 1, nil, and "three", respectively. However, if build-bindings actually needed some arguments that weren't available at macroexpansion time, you'd be out of luck. First, it can take arguments that are available at macroexpansion time (e.g., constants):

(defun build-bindings (a b &rest cs)
  `((first ',a) (middle ',b) (last ',cs)))

CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 1 2 3 4 5)
                                  (print first))))
(LET ((FIRST '1) (MIDDLE '2) (LAST '(3 4 5)))
  (PRINT FIRST))

You could also have some of the variables appear in there:

(defun build-bindings (x ex y why)
  `((,x ,ex) (,y ,why)))

CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 'a 'ay 'b 'bee)
                                  (print first))))
(LET ((A AY) (B BEE))
  (PRINT FIRST))

What you can't do, though, is have the variable names be determined from values that don't exist until runtime. E.g., you can't do something like:

(let ((var1 'a)
      (var2 'b))
  (let-list (build-bindings var1 'ay var2 'bee)
    (print first))

because (let-list (build-bindings …) …) is macroexpanded before any of this code is actually executed. That means that you'd be trying to evaluate (build-bindings var1 'ay var2 'bee) when var1 and var2 aren't bound to any values.

Common Lisp does all its macroexpansion first, and then evaluates code. That means that values that aren't available until runtime are not available at macroexpansion time.

Compilation (and Macroexpansion) at Runtime

Now, even though I said that Common Lisp does all its macroexpansion first, and then evaluates code, the code above actually uses eval at macroexpansion to get some extra evaluation earlier. We can do things in the other direction too; we can use compile at runtime. That means that we can generate a lambda function and compile it based on code (e.g., variable names) provided at runtime. We can actually do this without using a macro:

(defun %dynamic-lambda (bindings body)
  (flet ((to-list (x) (if (listp x) x (list x))))
    (let* ((bindings (mapcar #'to-list bindings))
           (vars (mapcar #'first bindings))
           (vals (mapcar #'second bindings)))
      (apply (compile nil `(lambda ,vars ,@body)) vals))))

CL-USER> (%dynamic-lambda '((first 1) middle (last "three")) 
                          '((list first middle last)))
;=> (1 NIL "three")

This compiles a lambda expression that is created at runtime from a body and a list of bindings. It's not hard to write a macro that takes some fo the quoting hassle out of the picture:

(defmacro let-list (bindings &body body)
  `(%dynamic-lambda ,bindings ',body))

CL-USER> (let-list '((first 1) middle (last "three")) 
           (list first middle last))
;=> (1 NIL "three")

CL-USER> (macroexpand-1 '(let-list (build-bindings)
                          (list first middle last)))
;=> (%DYNAMIC-LAMBDA (BUILD-BINDINGS) '((LIST FIRST MIDDLE LAST)))

CL-USER> (flet ((build-bindings ()
                  '((first 1) middle (last "three"))))
           (let-list (build-bindings)
             (list first middle last)))
;=> (1 NIL "three")

This gives you genuine lexical variables from a binding list created at runtime. Of course, because the compilation is happening at runtime, you lose access to the lexical environment. That means that the body that you're compiling into a function cannot access the "surrounding" lexical scope. E.g.:

CL-USER> (let ((x 3))
           (let-list '((y 4))
             (list x y)))
; Evaluation aborted on #<UNBOUND-VARIABLE X {1005B6C2B3}>.

Using PROGV and special variables

If you don't need lexical variables, but can use special (i.e., dynamically scoped) variables instead, you can establish bindings at runtime using progv. That would look something like:

(progv '(a b c) '(1 2 3)
  (list c b a))
;;=> (3 2 1)

You'll probably get some warnings with that if run it, because when the form is compiled, there's no way to know that a, b, and c are supposed to be special variables. You can use locally to add some special declarations, though:

(progv '(a b c) '(1 2 3)
  (locally
      (declare (special a b c))
    (list c b a)))
;;=> (3 2 1)

Of course, if you're doing this, then you have to know the variables in advance which is exactly what you were trying to avoid in the first place. However, if you're willing to know the names of the variables in advance (and your comments seem like you might be okay with that), then you can actually use lexical variables.

Lexical variables with values computed at run time

If you're willing to state what the variables will be, but still want to compute their values dynamically at run time, you can do that relatively easily. First, lets write the direct version (with no macro):

;; Declare three lexical variables, a, b, and c.
(let (a b c)
  ;; Iterate through a list of bindings (as for LET)
  ;; and based on the name in the binding, assign the
  ;; corresponding value to the lexical variable that
  ;; is identified by the same symbol in the source:
  (dolist (binding '((c 3) (a 1) b))
    (destructuring-bind (var &optional value)
        (if (listp binding) binding (list binding))
      (ecase var
        (a (setf a value))
        (b (setf b value))
        (c (setf c value)))))
  ;; Do something with the lexical variables:
  (list a b c))
;;=> (1 NIL 3)

Now, it's not too hard to write a macrofied version of this. This version isn't perfect, (e.g., there could be hygiene issues with names, and declarations in the body won't work (because the body is being spliced in after some stuff). It's a start, though:

(defmacro computed-let (variables bindings &body body)
  (let ((assign (gensym (string '#:assign-))))
    `(let ,variables
       (flet ((,assign (binding)
                (destructuring-bind (variable &optional value)
                    (if (listp binding) binding (list binding))
                  (ecase variable
                    ,@(mapcar (lambda (variable)
                                `(,variable (setf ,variable value)))
                              variables)))))
         (map nil #',assign ,bindings))
       ,@body)))

(computed-let (a b c) '((a 1) b (c 3))
  (list a b c))
;;=> (1 NIL 3)

One way of making this cleaner would be to avoid the assignment altogether, and the computed values to provide the values for the binding directly:

(defmacro computed-let (variables bindings &body body)
  (let ((values (gensym (string '#:values-)))
        (variable (gensym (string '#:variable-))))
    `(apply #'(lambda ,variables ,@body)
            (let ((,values (mapcar #'to-list ,bindings)))
              (mapcar (lambda (,variable)
                        (second (find ,variable ,values :key 'first)))
                      ',variables)))))

This version creates a lambda function where the arguments are the specified variables and the body is the provided body (so the declarations in the body are in an appropriate place), and then applies it to a list of values extracted from the result of the computed bindings.

Using LAMBDA or DESTRUCTURING-BIND

since I'm doing some "destructuring" of the arguments (in a bit a different way), I know which arguments must be present or have which default values in case of missing optional and key arguments. So in the first step I get a list of values and a flag whether an optional or key argument was present or defaulted. In the second step I would like to bind those values and/or present/default flag to local variables to do some work with them

This is actually starting to sound like you can do what you need to by using a lambda function or destructuring-bind with keyword arguments. First, note that you can use any symbol as a keyword argument indicator. E.g.:

(apply (lambda (&key
                    ((b bee) 'default-bee b?)
                    ((c see) 'default-see c?))
           (list bee b? see c?))
   '(b 42))
;;=> (42 T DEFAULT-SEE NIL)

(destructuring-bind (&key ((b bee) 'default-bee b?)
                          ((c see) 'default-see c?))
    '(b 42)
  (list bee b? see c?))
;;=> (42 T DEFAULT-SEE NIL)

So, if you just make your function return bindings as a list of keyword arguments, then in the destructuring or function application you can automatically bind corresponding variables, assign default values, and check whether non-default values were provided.

Answer 2

Acting a bit indirectly:

a solution that works for combining optional with key arguments or rest/body with key arguments

Have you considered the not-entirely-uncommon paradigm of using a sub-list for the keywords?

e.g.

 (defmacro something (&key (first 1) second) &body body) ... )

or, a practical use from Alexandria:

 (defmacro with-output-to-file ((stream-name file-name
                                 &rest args
                                 &key (direction nil direction-p)
                                 &allow-other-keys)
                                &body body)