Macro that generates macro form wrapped in let bound variables

I've been trying to write a macro that generates, among other things, a compiler macro of the same name. This is the minimal code I'm stuck with:

 (defmacro definline (name lambda-list &body body)
  `(define-compiler-macro ,name ,lambda-list
     `(let ,,(mapcar (lambda (v) ``(,',v ,,v)) lambda-list)
        ,,@body)))

What I want is something like this:

(definline foobar (a b) (print "foobar") (+ a b))
;; Expands to
(define-compiler-macro foobar (a b)
  `(let ((a ,a) (b ,b))
     (print "foobar") (+ a b)))

But I can't figure out how to generate the let bindings ((a ,a) (b ,b)). The issue I haven't been able to wrap my head around is how to generate the compiler macro form such that the contents of the lambda bindings are unquoted in the expansion. I understand how to do this manually but I'm not sure how to do this generically for an arbitrary lambda list.

Edit:

After some more fiddling I came up with this. Which works. But, well, it's hideous.

(defmacro definline (name lambda-list &body body)
  (read-from-string
   (format nil "(define-compiler-macro ~S (~{~S~^ ~})
                    `(let (~{(~S ,~S)~})
                       ~{~S~}))"
           name lambda-list (loop for l in lambda-list nconc (list l l)) body)))

The approach using format doesn't work at all if some of the I/O related variables are modified. Using format to generate symbol names is generally pretty brittle and non-portable. This is a tough problem to solve though, and it might be easier to approach it with list construction rather than backquotes alone. For instance, in this case we could have:

(defmacro definline (name variables &body body)
  (list 'define-compiler-macro name variables
        `(list* 'let (list ,@(mapcar (lambda (variable)
                                       `(list (quote ,variable) ,variable))
                              variables))
                ',body)))

This works such that:

CL-USER> (pprint (macroexpand-1 '(definline foobar (a b) 
                         (print "foobar")
                         (+ a b))))

(DEFINE-COMPILER-MACRO FOOBAR
    (A B)
  (LIST* 'LET (LIST (LIST 'A A) (LIST 'B B)) '((PRINT "foobar") (+ A B))))

which, unless I'm misreading something, should have the same results as:

(define-compiler-macro foobar (a b)
  `(let ((a ,a) (b ,b))
     (print "foobar")
     (+ a b)))

I don't think that it's necessarily possible to generate the latter form using backquotes alone. The problem is that since the specification doesn't define exactly how backquote is implemented, it's not as simple as something like

(define-compiler-macro foobar (a b)
  (backquote (let ((a (unquote a))
                   (b (unquote b)))
               (print "foobar")
               (+ a b)))

If your implementation does implement it in such a way, then you could write an expansion that generates that type of output. Unless you get such a guarantee from your implementation, I don't think there's a way to get the "comma variable" that you need to inject into the layer higher up. It's hard to make this point clearly, but you might look at this attempt:

(defmacro definline (name variables &body body)
  `(define-compiler-macro ,name ,variables
     `(let ,',(mapcar (lambda (variable)
                        `(,variable (unquote ,variable)))
                      variables)
        ,@',body)))

That will produce results like:

(DEFINE-COMPILER-MACRO FOOBAR
    (A B)
  '(LET ((A (UNQUOTE A)) (B (UNQUOTE B)))
     (PRINT "foobar")
     (+ A B)))

Notice that SBCL is already smart enough to replace the backquote with a normal quote, since there's nothing that needs to be unquoted inside. The mapcar that generates the form that gets spliced in can't generate code with commas in it, because it's not specified how those commas are implemented, and, according to 2.4.7 Comma, "comma is invalid if used other than inside the body of a backquote expression". I think that means that your best option is something like:

(defmacro definline (name variables &body body)
  `(define-compiler-macro ,name ,variables
     `(let ,(mapcar 'list 
                    ',variables
                    (list ,@variables))
        ,@',body)))

The expansion of this is going to be different under different implementations, but in SBCL it's:

(DEFINE-COMPILER-MACRO FOOBAR (A B)
  `(LET (SB-IMPL::BACKQ-COMMA (MAPCAR 'LIST '(A B) (LIST A B)))
     (PRINT "foobar")
     (+ A B)))

In CCL you get:

(DEFINE-COMPILER-MACRO FOOBAR (A B)
  (LIST* 'LET
         (LIST* (MAPCAR 'LIST '(A B) (LIST A B))
                '((PRINT "foobar") (+ A B)))))

In CLISP:

(DEFINE-COMPILER-MACRO FOOBAR (A B)
 (CONS 'LET
  (CONS (MAPCAR 'LIST '(A B) (LIST A B)) '((PRINT "foobar") (+ A B)))))

Recommended topics

Hot tags