eval-let macro help?

I don't have a ton of experience with CL, so please bear with me

As a helper to another macro I'm writing, I need a macro that is exactly like let, but evaluates its first argument (which should evaluate to a let list) and then drops it into a simple let expression.

This was my first attempt:

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

but then

CL-USER> (let ((foo '((bar 5))))
           (eval-let foo
             (* bar bar)))

Fails because "foo" is undefined at macroexpansion time.

Then I tried this (not sure if this is proper use of eval-when or not...):

(defmacro eval-let (evals-to-let-list &body body)
  `(let ,(eval-when (:execute) (eval evals-to-let-list))
     ,@body))

But the same thing happens.

Help!

Thanks a lot,

_Nick_

When writing macros, always start with the macroexpanded code, then develop a macro to output that based on your source form.

What do you want the expansion of (eval-let foo (* bar bar)) to look like?

nuntius wrote:When writing macros, always start with the macroexpanded code, then develop a macro to output that based on your source form.

What do you want the expansion of (eval-let foo (* bar bar)) to look like?

Well, in the case of

(let ((foo '((bar 5))))                                                                                                            
  (eval-let foo                                                                                                                    
    (* bar bar)))

I would want the eval-let to expand to

(let ((bar 5))
  (* bar bar))

I guess I just don't know how to eval lexically inside a macro...

Does that make sense?

You are probably doing something the wrong way, this macro is "dirty". To be able to do this, you would need to construct the form and evaluate during runtime, not macroexpansion time:

cl-user> (defmacro eval-let (vars &body body)
           `(eval `(let ,,vars ,',@body)))
eval-let
cl-user> (macroexpand-1 '(eval-let foo (do-something bar)))
(eval
 `(let (sb-impl::backq-comma foo)
    (do-something bar)))
t
cl-user> (let ((foo '((bar nil))))
           (eval-let foo
             (not bar)))
t

Not only your code will remain uncompiled (which might or not be a problem), but issues with bindings will occur:

cl-user> (let ((foo '((bar nil)))
               (baz 10))
           (eval-let foo
             (list (not bar) (+ baz 1))))

;; Causes the following error

The variable baz is unbound.
   [Condition of type unbound-variable]

Restarts:
 0: [retry] Retry SLIME REPL evaluation request.
 1: [abort] Return to SLIME's top level.
 2: [terminate-thread] Terminate this thread (#<thread "repl-thread" running {1003CAED51}>)

If you could post what you are trying to do, we could give you better ideas.

gugamilare wrote:If you could post what you are trying to do, we could give you better ideas.

I have been reading Norvig's PAIP, and wanted to write some macros to better integrate pattern matching in to CL. Basically, I started with something based on http://norvig.com/paip/patmatch.lisp and since then, this is pretty much what I have:

(defun alist->let-list (alist)
  "((foo . bar) (baz . bang)) -> ((foo bar) (baz bang))"
  (mapcar #'(lambda (cons-cell)
              (list (car cons-cell)
                    `',(cdr cons-cell)))
          alist))

(defmacro let-match ((pattern input) &body body)
  (let ((alist (pat-match pattern (eval input))))
    `(let ,(alist->let-list alist)
       (if (quote ,alist)
           (values ,@body t)
         (values nil nil)))))

And let-match works at the top level:

CL-USER> (let-match ((?H . ?T) '(1 2 3 4))
           (list ?H ?T))
(1 (2 3 4))
T

However, it fails when I use it inside of a function definition:

CL-USER> (defun wont-work (lst)
           (let-match ((1 2 ?foo) lst) 
             (list ?foo)))
WONT-WORK
CL-USER> (wont-work '(1 2 5))
Execution of a form compiled with errors.
Form:
  (LET-MATCH ((1 2 ?FOO) LST) (LIST ?FOO))
Compile-time error:
  (in macroexpansion of (LET-MATCH ((1 2 ?FOO) LST) (LIST ?FOO)))
(hint: For more precise location, try *BREAK-ON-SIGNALS*.)
The variable LST is unbound.
   [Condition of type SB-INT:COMPILED-PROGRAM-ERROR]

Restarts:
 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [ABORT] Return to SLIME's top level.
 2: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" RUNNING {AFA10A9}>)

When I would expect a return value of (5).

After let-match, I want to next implement cond-match, and finally defun-match.

(Edit: formatting)

Common Lisp is a language designed to be efficiently compiled, which puts constraints on the evaluation model. For one thing, there is relatively strict separation between macroexpansion time and runtime, for another, EVAL happens in null lexical environment, which allows lexical environments to be discarded after compilation. What you are trying to do goes against both of those constraints, and even if it were possible, it would completely destroy performance and make debugging any code involved very hard.

It is possible to integrate pattern matching in CL, and in fact it has been done multiple times (cl-unification,fare-matcher, toadstool). The way to do it is not to mess with EVAL, but to construct the environment at compile time based on the pattern, and then select it on runtime. Right now you are doing both at compile time, which obviously won't work on non-literal data.

A general tip is to avoid using eval (unless you need it, like when implementing a REPL or creating code on the fly). In the case of let-match, instead of evaluating the argument, you should leave it to the macro expansion. During the macroexpansion, you have no idea how the list you are trying to match will look like, that can only be viewed during runtime.

As I can see, this is a little tricky macro indeed. One possible solution is first to extract the variables from the given pattern using, e.g., alexandria's flatten:

cl-user> (alexandria:flatten '(?H . ?T))
(?h ?t)

;; flatten's code:
(defun flatten (tree)
  "Traverses the tree in order, collecting non-null leaves into a list."
  (let (list)
    (labels ((traverse (subtree)
               (when subtree
                 (if (consp subtree)
                     (progn
                       (traverse (car subtree))
                       (traverse (cdr subtree)))
                     (push subtree list)))))
      (traverse tree))
    (nreverse list)))

Then, make sure the macro to expand this:

(let-match ((?H . ?T) '(1 2 3 4))
           (list ?H ?T))

into something like this:

(let ((alist (pat-match '(?H . ?T) '(1 2 3 4))))
  (let ((?H (cdr (assoc '?H alist)))
        (?T (cdr (assoc '?T alist))))
    (list ?H ?T)))

That will work

(alist will be a gensym, of course)

gugamilare wrote:Then, make sure the macro to expand this:

(let-match ((?H . ?T) '(1 2 3 4))
           (list ?H ?T))

into something like this:

(let ((alist (pat-match '(?H . ?T) '(1 2 3 4))))
  (let ((?H (cdr (assoc '?H alist)))
        (?T (cdr (assoc '?T alist))))
    (list ?H ?T)))

That will work

(alist will be a gensym, of course)

Aha! Thanks a lot that makes a ton more sense to me.

Thanks for the help everyone!

If anyone is still interested, I successfully got it working, and this is what I ended up with:

;; ... snip ...

(defun extract-variables (pattern)
  (remove-if-not #'variable? (flatten pattern)))

(defun make-let-list (variables alist)
  (mapcar #'(lambda (var)
              `(,var (cdr (assoc ',var ,alist))))
          variables))

(defmacro let-match ((pattern input) &body body)
  (let ((alist (gensym "ALIST")))
    `(let ((,alist (pat-match ',pattern ,input)))
       (let ,(make-let-list (extract-variables pattern) alist)
         (if ,alist
             (values ,@body t)
           (values nil nil))))))

Thanks again for all the help!

Congratulations, your code looks Lispy

I got "cond-match" and "defun-match" working too! Having so much fun with Lisp!

(defun clause-pattern (clause)
  (car clause))

(defun clause-body (clause)
  (cdr clause))

(defun expand-clauses (form clauses)
  (if (null clauses)
      nil
    (let ((first (car clauses))
          (rest (cdr clauses)))
      `(multiple-value-bind (ret-val match?) (let-match (,(clause-pattern first) ,form)
                                               ,@(clause-body first))
         (if match?
             ret-val
           ,(expand-clauses form rest))))))

(defmacro cond-match (form &body clauses)
  (expand-clauses form clauses))

(defmacro defun-match (name &rest clauses)
  `(defun ,name (&rest args)
     (cond-match args
       ,@clauses)))

If anyone is interested, I have thrown the whole of the code up on github: http://github.com/fitzgen/cl-pattern-ma ... ching.lisp