How do I structure this lisp macro? - macros

I'm working through l99 for lisp to learn lisp.
This is from here, and I wish to apply macros just for practice, to write all the ((x) (x (evaluate-boolean left bindings) (evaluate-boolean right bindings)))s with a macro.
(defun evaluate-boolean (expression bindings)
"Evaluates the boolean expression. Returns t or nil
expression := variable
| constant
| '(' operator expression expression ')'
| '(' not expression ')'
.
constant := 'true' | 'fail' .
variable := symbol .
operator := 'and' | 'or' | 'nand' | 'nor' | 'xor' | 'impl' | 'equ' .
bindings is a list of pairs (variable . constant)
"
(cond ((eq expression 'true) t)
((eq expression 'fail) nil)
((symbolp expression)
(let ((pair (assoc expression bindings)))
(if pair
(progn
(assert (member (cdr pair) '(true fail)))
(eql 'true (cdr pair)))
(error "No variable named ~A in the bindings." expression))))
((atom expression) (error "Invalid atom ~A in the expression." expression))
(t (case (length expression)
((2) (destructuring-bind (op subexpression) expression
(case op
((not) (not (evaluate-boolean subexpression bindings)))
(otherwise (error "Invalid operator ~A in ~A" op expression)))))
((3) (destructuring-bind (op left right) expression
(case op
((and) (and (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((or) (or (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((nand) (nand (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((nor) (nor (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((xor) (xor (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((impl) (impl (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
((equ) (equ (evaluate-boolean left bindings) (evaluate-boolean right bindings)))
(otherwise (error "Invalid operator ~A" op)))))
(otherwise (error "Invalid expression ~A" expression))))))
I've tried a few things, but they all seem to give errors reporting missing variables.
How would I implement macros
as a defmacro, or
using macrolet, within the evaluate-boolean function?
I usually test stuff out with defun or defmacro first, then replace that with flet. Any advice on this?

Since you didn't say what you tried I don't know what you did wrong, but I guess you probably tried to replace the individual cases inside the CASE with macro calls? That doesn't work because the outer macro (CASE) is expanded before the inner ones, so an inner macro can't be used to generate syntax for an outer macro (unless the outer macro is specifically written to allow that, which is not the case here).
So the solution is to write a macro that generates the whole CASE for you. Something like:
(macrolet ((ops-case (op-sym (&rest ops))
`(case ,op-sym
,#(loop for op in ops
collect `((,op) (,op (evaluate-boolean left bindings)
(evaluate-boolean right bindings))))
(otherwise (error "Invalid operator ~A" ,op-sym)))))
(ops-case op (and or nand nor xor impl equ)))
Although I'm not convinced this is really a good idea. One off macros like this tend to make your code harder to understand, and this doesn't significantly shorten the code either. Usually you would want to use macros to abstract patterns that appear multiple times in your code.
A more generic approach might be something like this:
(defmacro ecase-template (keyform template &body cases)
`(ecase ,keyform
,#(loop for case in cases
collect (sublis `((_ . ,case)) template))))
This generates a case expression by substituting underscores in a tempate with a value from the case. For example:
CL-USER> (macroexpand-1 '(ecase-template op
((_) (_ (evaluate-boolean left bindings)
(evaluate-boolean right bindings)))
and or nand nor xor impl equ))
(ECASE OP
((AND)
(AND (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((OR)
(OR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((NAND)
(NAND (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((NOR)
(NOR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((XOR)
(XOR (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((IMPL)
(IMPL (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS)))
((EQU)
(EQU (EVALUATE-BOOLEAN LEFT BINDINGS) (EVALUATE-BOOLEAN RIGHT BINDINGS))))

This might not be quite what you are after, but CLOS is just fantastic for this kind of dispatch-on-symbol evaluation.
Here is a (very minimally-tested) implementation of your evaluator using a pair of generic functions (which are, of course, really eval and apply for your little language) together with a macro which lets you define 'direct' methods for the apply generic function. A 'direct' method is one which translates trivially to a form involving an operator with the same name in the subtrate language (this basically covers all the big nested case in your code).
(There are some cases where it works slightly differently than your code: for instance once it's found a variable binding it just punts back into the evaluator with its value, rather than having any additional special case cleverness.)
(defgeneric evaluate-boolean (expression bindings)
(:documentation
"Evaluates the boolean expression. Returns t or nil
expression := variable
| constant
| '(' operator expression expression ')'
| '(' not expression ')'
.
constant := 'true' | 'fail' .
variable := symbol .
operator := 'and' | 'or' | 'nand' | 'nor' | 'xor' | 'impl' | 'equ' .
bindings is a list of pairs (variable . constant)
")
(:method ((expression (eql 'true)) bindings)
(declare (ignore bindings))
t)
(:method ((expression (eql 'false)) bindings)
(declare (ignore bindings))
nil)
(:method ((expression symbol) bindings)
(let ((binding (assoc expression bindings)))
(if binding
(evaluate-boolean (cdr binding) bindings)
(error "no binding for ~A" expression))))
(:method ((expression cons) bindings)
(apply-boolean-operator (car expression) (cdr expression) bindings))
(:method (expression bindings)
(error "malformed expression ~A" expression)))
(defgeneric apply-boolean-operator (op args bindings)
(:documentation "apply an operator to some arguments with some bindings")
(:method (op args bindings)
(error "unknown operator ~A" op)))
(defmacro define-direct-boolean-operator (op-name arg-names)
(unless (and (symbolp op-name) (list arg-names) (every #'symbolp arg-names))
;; not even worth trying
(error "mutant boolean operator definition"))
`(defmethod apply-boolean-operator ((op (eql ',op-name))
args bindings)
;; this smells unhygenic but I think it is actually fine
(let ((la (length args))
(lr ,(length arg-names)))
(unless (= la lr)
(error "~A wanted ~D argument~P but got ~D" op lr lr la)))
(destructuring-bind ,arg-names args
(,op-name ,#(mapcar (lambda (a)
`(evaluate-boolean ,a bindings))
arg-names)))))
(define-direct-boolean-operator not (x))
(define-direct-boolean-operator and (x y))
(define-direct-boolean-operator or (x y))
(define-direct-boolean-operator nand (x y))
(define-direct-boolean-operator xor (x y))
(define-direct-boolean-operator impl (x y))
(define-direct-boolean-operator equ (x y))

Related

Lisp - Passing unquoted list to macro

I'm currently experimenting with macro's in Lisp and I would like to write a macro which can handle syntax as follows:
(my-macro (args1) (args2))
The macro should take two lists which would then be available within my macro to do further processing. The catch, however, is that the lists are unquoted to mimic the syntax of some real Lisp/CLOS functions. Is this possible?
Currently I get the following error when attempting to do something like this:
Undefined function ARGS1 called with arguments ().
Thanks in advance!
I think you need to show what you have tried to do. Here is an example of a (silly) macro which has an argument pattern pretty much what yours is:
(defmacro stupid-let ((&rest vars) (&rest values) &body forms)
;; Like LET but with a terrible syntax
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
Then
> (macroexpand '(stupid-let (a b c) (1 2 3) (+ a b c)))
(let ((a 1) (b 2) (c 3)) (+ a b c))
The above macro depends on defmacro's arglist-destructuring, but you don't have to do that:
(defun proper-list-p (l)
;; elaborate version with an occurs check, quadratic.
(labels ((plp (tail tails)
(if (member tail tails)
nil
(typecase tail
(null t)
(cons (plp (rest tail) (cons tail tails)))
(t nil)))))
(plp l '())))
(defmacro stupid-let (vars values &body forms)
;; Like LET but with a terrible syntax
(unless (and (proper-list-p vars) (proper-list-p values))
(error "need lists of variables and values"))
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
As a slightly more useful example, here is a macro which is a bit like the CLOS with-slots / with-accessors macros:
(defmacro with-mindless-accessors ((&rest accessor-specifications) thing
&body forms)
"Use SYMBOL-MACROLET to define mindless accessors for THING.
Each accessor specification is either a symbol which names the symbol
macro and the accessor, or a list (macroname accessorname) which binds
macroname to a symbol macro which calls accessornam. THING is
evaluated once only."
(multiple-value-bind (accessors functions)
(loop for accessor-specification in accessor-specifications
if (symbolp accessor-specification)
collect accessor-specification into acs
and collect accessor-specification into fns
else if (and (proper-list-p accessor-specification)
(= (length accessor-specification) 2)
(every #'symbolp accessor-specification))
collect (first accessor-specification) into acs
and collect (second accessor-specification) into fns
else do (error "bad accessor specification ~A" accessor-specification)
end
finally (return (values acs fns)))
(let ((thingn (make-symbol "THING")))
`(let ((,thingn ,thing))
(symbol-macrolet ,(loop for accessor in accessors
for function in functions
collect `(,accessor (,function ,thingn)))
,#forms)))))
So now we can write this somewhat useless code:
> (with-mindless-accessors (car cdr) (cons 1 2)
(setf cdr 3)
(+ car cdr))
4
And this:
> (let ((l (list 1 2)))
(with-mindless-accessors (second) l
(setf second 4)
l))
(1 4)

My lisp macro stops working in latest guile

I have macro that I've written in 2010, it was for managing structures like in Common Lips using Alists (here is whole file including functions https://jcubic.pl/struct.txt).
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym)))
`(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(begin
(define (,(make-name name) ,#names)
(map cons ',fields (list ,#names)))
,#(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,#(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,(make-predicate name) ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))))))
It was working fine. I've recently updated this macro for my LIPS in JavaScript (it's based on scheme) and when I call it, it was returning false and wanted to know if this is how it would work in guile. But it turns out it don't work in guile at all. It shows this error:
While compiling expression: ERROR: Syntax error: unknown location:
definition in expression context, where definitions are not allowed,
in form (define (make-point #{ g746}# #{ g747}#) (map cons (quote (x
y)) (list #{ g746}# #{ g747}#))
Why I've got this error and how to fix it, so it work in guile again? I was long ago I don't remember how I was testing this code but opening guile using load function or copy paste the code into interpreter all give same error.
I'm using guile 2.0.14 on GNU/Linux.
PS: I prefer to use lisp macros IMO they are superior to weird scheme hygienic macros.
It looks like modern guile scheme does not see the begin in the if as a valid option to start a new definition context. This is perhaps a bug or better alignment of the scheme spec donough. But the following example code shows the technique to fix your code for more recent guile (you might need to create define-values as it is a more recent addition to guile. P.S. using lisps macros in guile is a clludge and it will get you into trouble if you plan to scheme a lot, the macros is like the parens, if you get used to it will feel natural.
Here is the code,
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let* ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym))
(sname (make-name name))
(predname (make-predicate name))
(getnames (map (lambda (f) (make-getter name f)) fields))
(setnames (map (lambda (f) (make-setter name f)) fields)))
`(define-values (,sname ,predname ,#getnames ,#setnames)
(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(let ()
(define (,sname ,#names)
(map cons ',fields (list ,#names)))
,#(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,#(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,predname ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))
(values ,sname ,predname ,#getnames ,#setnames))))))
Here is a version of define-values (look at the code after #' to see what it does)
(define-syntax define-values
(lambda (x)
(syntax-case x ()
((_ (f ...) code ...)
(with-syntax (((ff ...) (generate-temporaries #'(f ...))))
#'(begin
(define f #f)
...
(call-with-values (lambda () code ...)
(lambda (ff ...)
(set! f ff)
...))))))))

Any good way to declare unused variables in destructuring-bind?

I can't figure, is there any way to put something like _ in erlang, for "unused value" in destructuring-bind?
For example there we have something like that:
(destructuring-bind ((_SNIPPET
(_TITLE . title)
(_DESCRIPTION . description)
_RESOURCE-ID (_VIDEO-ID . video-id)))) entry
(declare (ignore
_SNIPPET _TITLE _DESCRIPTION _RESOURCE-ID _VIDEO-ID))
(list video-id title description)))
It'll be great not to put specific variable for every unused value, and write something like that:
(destructuring-bind ((_
(_ . title)
(_ . description)
(_ (_ . video-id)))) entry
(list video-id title description)))
Is there any way to get such behavior with standart destructuring-bind or any other standart macros? Or I have to use some ML-like pattern matching library, and if so - which one?
It's not possible with DESTRUCTURING-BIND (you can't use a variable more than once, some compiler will complain). You can enumerate the variables, _1, _2, ... But then you have to ignore each of them.
LOOP can do it:
CL-USER 23 > (loop for ((a b nil c) nil d) in '(((1 2 3 4) 5 6)
((1 2 3 4) 5 6))
collect (list a b c d))
((1 2 4 6) (1 2 4 6))
NIL is used as the wildcard variable.
You can reuse the LOOP macro:
(defmacro match-bind (pattern object &body body)
`(loop with ,pattern = ,object
while nil
finally (return (progn ,#body))))
CL-USER 37 > (match-bind ((a b nil c) nil d)
'((1 2 3 4) 5 6)
(list a b c d))
(1 2 4 6)
You can use some LET-MATCH from some library. For example: https://github.com/schani/clickr/blob/master/let-match.lisp
There are probably more fancy versions.
There's nothing built into the language for this. Rainer Joswig's answer points out that loop can do some destructuring, but it doesn't do nearly as much. In an earlier version of this answer, I suggested traversing the destructuring lambda list and collecting a list of all the symbols that begin with _ and adding a declaration to the form to ignore those variables. A safer version replaces each one with a fresh variable (so that there are no repeated variables), and ignores them all. Thus something like
(destructuring-bind (_a (_b c)) object
c)
would expand into
(destructuring-bind (#:g1 (#:g2 c)) object
(declare (ignore #:g1 #:g2))
c)
This approach will work OK if you're only using the "data-directed" described in 3.4.4.1.1 Data-directed Destructuring by Lambda Lists. However, if you're using "lambda-list-directed" approach described in 3.4.4.1.2 Lambda-list-directed Destructuring by Lambda Lists, where you can use lambda-list keywords like &optional, &key, etc., then things are much more complicated, because you shouldn't replace variables in some parts of those. For instance, if you have
&optional (_x '_default-x)
then it might be OK to replace _x with something, but not _default-x, because the latter isn't a pattern. But, in Lisp, code is data, so we can still write a macro that maps over the destructuring-lambda-list and replaces only in locations that are patterns. Here's somewhat hairy code that does just that. This takes a function and a destructuring lambda list, and calls the function for each pattern variable in the lambda list, along with the type of the argument (whole, required, optional, etc.).
(defun map-dll (fn list)
(let ((result '())
(orig list)
(keywords '(&allow-other-keys &aux &body
&key &optional &rest &whole)))
(labels ((save (x)
(push x result))
(handle (type parameter)
(etypecase parameter
(list (map-dll fn parameter))
(symbol (funcall fn type parameter)))))
(macrolet ((parse-keyword ((&rest symbols) &body body)
`(progn
(when (and (not (atom list))
(member (first list) ',symbols))
(save (pop list))
,#body)))
(doparameters ((var) &body body)
`(do () ((or (atom list) (member (first list) keywords)))
(save (let ((,var (pop list)))
,#body)))))
(parse-keyword (&whole)
(save (handle :whole (pop list))))
(doparameters (required)
(handle :required required))
(parse-keyword (&optional)
(doparameters (opt)
(if (symbolp opt)
(handle :optional opt)
(list* (handle :optional (first opt)) (rest opt)))))
(when (and (atom list) (not (null list))) ; turn (... . REST)
(setq list (list '&rest list))) ; into (... &rest REST)
(parse-keyword (&rest &body)
(save (handle :rest (pop list))))
(parse-keyword (&key)
(doparameters (key)
(if (symbolp key)
(handle :key key)
(destructuring-bind (keyspec . more) key
(if (symbolp keyspec)
(list* (handle :key keyspec) more)
(destructuring-bind (keyword var) keyspec
(list* (list keyword (handle :key var)) more)))))))
(parse-keyword (&allow-other-keys))
(parse-keyword (&aux)
(doparameters (aux) aux))
(unless (null list)
(error "Bad destructuring lambda list: ~A." orig))
(nreverse result)))))
Using this, it's pretty easy to write a destructuring-bind* that replaces each pattern variable beginning with _ with a fresh variable that will be ignored in the body.
(defmacro destructuring-bind* (lambda-list object &body body)
(let* ((ignores '())
(lambda-list (map-dll (lambda (type var)
(declare (ignore type))
(if (and (> (length (symbol-name var)) 0)
(char= #\_ (char (symbol-name var) 0)))
(let ((var (gensym)))
(push var ignores)
var)
var))
lambda-list)))
`(destructuring-bind ,lambda-list ,object
(declare (ignore ,#(nreverse ignores)))
,#body)))
Now we should look at the expansions it produces:
(macroexpand-1
'(destructuring-bind* (&whole (a _ . b)
c _ d
&optional e (f '_f)
&key g _h
&aux (_i '_j))
object
(list a b c d e f g)))
;=>
(DESTRUCTURING-BIND
(&WHOLE (A #:G1041 &REST B) C #:G1042 D
&OPTIONAL E (F '_F)
&KEY G #:G1043
&AUX (_I '_J))
OBJECT
(DECLARE (IGNORE #:G1041 #:G1042 #:G1043))
(LIST A B C D E F G))
We haven't replaced anywhere we shouldn't (init forms, aux variables, etc.), but we've taken care of the places that we should. We can see this work in your example too:
(macroexpand-1
'(destructuring-bind* ((_ (_ . title)
(_ . description)
_
(_ . video-id)))
entry
(list video-id title description)))
;=>
(DESTRUCTURING-BIND ((#:G1044 (#:G1045 &REST TITLE)
(#:G1046 &REST DESCRIPTION)
#:G1047
(#:G1048 &REST VIDEO-ID)))
ENTRY
(DECLARE (IGNORE #:G1044 #:G1045 #:G1046 #:G1047 #:G1048))
(LIST VIDEO-ID TITLE DESCRIPTION))

Lisp - "case" macro implementation

I'm wondering how the case macro works, but just expanding it is not enough. How does it generate the cond statement without knowing how many arguments there are? Does it use a loop or something? And if so then why does it not show up when i run macroexpand.
I need to write something that works in a similar way, that's why I ask.
Yes you would need to use iteration - one of loop, do, mapcar &c (or recursion).
Take a look at, e.g., CLISP's implementation of case:
(defun case-expand (whole-form form-name test keyform clauses)
(let ((var (gensym (string-concat (symbol-name form-name) "-KEY-"))))
`(let ((,var ,keyform))
(cond
,#(maplist
#'(lambda (remaining-clauses)
(let ((clause (first remaining-clauses))
(remaining-clauses (rest remaining-clauses)))
(unless (consp clause)
(error-of-type 'source-program-error
:form whole-form
:detail clause
(TEXT "~S: missing key list")
form-name))
(let ((keys (first clause)))
`(,(cond ((or (eq keys 'T) (eq keys 'OTHERWISE))
(if remaining-clauses
(error-of-type 'source-program-error
:form whole-form
:detail clause
(TEXT "~S: the ~S clause must be the last one")
form-name keys)
't))
((listp keys)
`(or ,#(mapcar #'(lambda (key)
`(,test ,var ',key))
keys)))
(t `(,test ,var ',keys)))
,#(rest clause)))))
clauses)))))
(defmacro case (&whole whole-form
keyform &body clauses)
(case-expand whole-form 'case 'eql keyform clauses))

Function name and dynamic binding in Common Lisp

I'm reading Peter Norvig's Paradigms of AI. In chapter 6.2, the author uses code like below (not the original code, I picked out the troubling part):
Code Snippet:
(progv '(op arg) '(1+ 1)
(eval '(op arg)))
As the author's original intent, this code should return 2, but in sbcl 1.1.1, the interpreter is apparently not looking up op in the environment, throwing out op: undefined function.
Is this implementation specific? Since the code must have been tested on some other lisp.
p.s Original code
You probably mean
(progv '(op arg) '(1+ 1)
(eval '(funcall op arg)))
Edit(2013-08-21):
PAIP was written in pre-ANSI-Common-Lisp era, so it's possible the code
there contains a few noncompliances wrt the standard. We can make
the examples work with the following revision:
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
(and (eval (reduce (lambda (code binding)
(destructuring-bind (var . val) binding
(subst val var code)))
bindings :initial-value (second (first pattern))))
(pat-match (rest pattern) input bindings)))
;; CL-USER> (pat-match '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z))) '(3 + 4 is 7))
;; ((?Z . 7) (?Y . 4) (?OP . +) (?X . 3) (T . T))
;; CL-USER> (pat-match '(?x ?op ?y (?if (?op ?x ?y))) '(3 > 4))
;; NIL
Elements in first positions are not looked up as values, but as functions and there is no concept of dynamic binding in the function namespace.
I'd say after a quick look that the original code was designed to evaluate in a context like
(progv '(x y) '(12 34)
(eval '(> (+ x y) 99)))
i.e. evaluating a formula providing substitution for variables, not for function names.
The other answers so far are right, in that the actual form being evaluated is not the variables being bound by progv (simply (op arg)), but none have mentioned what is being evaluated. In fact, the comments in the code you linked to provide a (very) short explanation (this is the only code in that file that uses progv):
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
;; *** fix, rjf 10/1/92 (used to eval binding values)
(and (progv (mapcar #'car bindings)
(mapcar #'cdr bindings)
(eval (second (first pattern))))
(pat-match (rest pattern) input bindings)))
The idea is that a call to match-if gets called like
(match-if '((?if code) . rest) input ((v1 val1) (v2 val2) ...))
and eval is called with (second (first pattern)), which the value of code. However, eval is called within the progv that binds v1, v2, &c., to the corresponding val1, val2, &c., so that if any of those variables appear free in code, then they are bound when code is evaluated.
Problem
The problem that I see here is that, by the code we can't tell if the value is to be saved as the variable's symbol-value or symbol-function. Thus when you put a + as a value to some corresponding variable, say v, then it'll always be saved as the symbol-value of var, not it's symbol-function.
Therefore when you'll try to use it as, say (v 1 2) , it won't work. Because there is no function named v in the functions' namespace(see this).
So, what to do?
A probable solution can be explicit checking for the value that is to be bound to a variable. If the value is a function, then it should be bound to the variable's function value. This checking can be done via fboundp.
So, we can make a macro functioner and a modified version of match-if. functioner checks if the value is a function, and sets it aptly. match-if does the dynamic local bindings, and allows other code in the scope of the bound variables.
(defmacro functioner (var val)
`(if (and (symbolp ',val)
(fboundp ',val))
(setf (symbol-function ',var) #',val)
(setf ,var ,val)))
(defun match-if (pattern input bindings)
(eval `(and (let ,(mapcar #'(lambda (x) (list (car x))) bindings)
(declare (special ,# (mapcar #'car bindings)))
(loop for i in ',bindings
do (eval `(functioner ,(first i) ,(rest i))))
(eval (second (first ',pattern))))
(pat-match (rest ',pattern) ',input ',bindings))))