How to mutate global variable passed to and mutated inside function? - lisp

I'm wondering how to permanently alter the value of a global variable from inside a function, without using the variable's name inside the function, i.e.:
(defvar *test1* 5)
(defun inctest (x) (incf x))
(inctest *test1*) ;after it runs, *test1* is still 5, not 6
According to this:
if the object passed to a function is mutable and you change it in the function, the changes will be visible to the caller since both the caller and the callee will be referencing the same object.
Is that not what I'm doing above?

If you want inctest to be a function, pass it the name of the global variable.
(defun inctest (x) (incf (symbol-value x)))
(inctest '*test1*)

You are not doing what the quote says, i.e. mutating the object passed to your function. You are mutating the parameter x, i.e. a local variable of your function that holds a copy of the object.
To do what the quote says, you need an object that is actually mutable which is not the case for a number. If you use a mutable object like e.g. a list, it works:
(defvar *test2* (list 5))
(defun inctest2 (x) (incf (car x)))
(inctest2 *test2*)
*test2* ; => (6)

In portable Common Lisp there is no explicit concept of "pointer" and all parameters are passed by value. To be able pass a function the ability to modify a variable you need to provide a way to reach the variable.
If the variable is a global then you can use the name of the variable (a symbol) and then use symbol-value to read/write the variable:
(defvar *test1* 42)
(defun inctest (varname)
(incf (symbol-value varname)))
(inctest '*test1*) ;; Note we're passing the NAME of the variable
if instead the variable is local you could for example provide a closure that when called without parameters returns the current value and that when called with a parameter instead it will set the new value of the variable:
(defun inctest (accessor)
(funcall accessor (1+ (funcall accessor))))
(let ((x 42))
(inctest (lambda (&optional (value nil value-passed))
(if value-passed
(setf x value)
x)))
(print x))
You can also write a small helper for building an accessor:
(defmacro accessor (name)
(let ((value (gensym))
(value-passed (gensym)))
`(lambda (&optional (,value nil ,value-passed))
(if ,value-passed
(setf ,name ,value)
,name))))
after which the code becomes
(let ((x 42))
(inctest (accessor x))
(print x))

No, it changes a copy that you have provided.
To change the variable itself, change it in the body of the function using its name:
(incf *test1*)
EDIT: in case you'd accept the macro, here it is, piping hot from my slime:
(defmacro my-incf (variable-name)
`(incf ,variable-name))

Related

Assigning values to global variables in Lisp

I am new to Lisp and I am trying to understand how variables and assigning variables work. I am trying to check if a given number is 5 or not. If it is, it is supposed to change it to 10 and print it. If not it just tells you that it is not 5 but my code below is not working.
(print "Give me a number")
(setq *x* (read))
(defun check(*x*)
(if (= *x* 5) (setq *x* 10) (format t "~d is not 5" *x*))
)
check(*x*)
print(*x*)
check(*x*) and print(*x*) isn't Lisp syntax. Replace that with (check *x*) and (print *x*)
Your function operates with some *x*, but it isn't your global *x*, but local variable*x* from argument list. Don't name function arguments same as global variables. Check this example:
(defparameter a 8)
(defun add (a)
(setf a (+ a 2))
(print a))
(add a)
(print a)
Returned values are 10 and then 8. Compare it with:
(defparameter *a* 8)
(defun add (a)
(setf *a* (+ *a* 2))
(print *a*))
(add *a*)
(print *a*)
Returned values are 10 and 10.
Don't use setf or setq for creating variable, these functions are only for setting new value. Use defparameter or defvar instead.
This code assigns value to global variable:
(print "Give me a number")
(defparameter *x* (read *query-io*))
(defun check ()
(if (= *x* 5)
(setf *x* 10)
(format t "~d is not 5" *x*)))
(check)
(print *x*)
You can also do this task without global variables.
(print "Give me a number")
(defun check (n)
(if (= n 5)
(setf n 10)
(format t "~d is not 5" n))
(print n))
(check (read *query-io*))
If I compile a file with this definition in SBCL:
(print "Give me a number")
(setq *x* (read))
(defun check(*x*)
(if (= *x* 5) (setq *x* 10) (format t "~d is not 5" *x*))
)
There are two warnings:
warning: undefined variable: *X*
This is located at the global setq, because setq does not declare global variables. So the compiler does not know any global variable named *x*.
Then, inside the function:
style-warning:
using the lexical binding of the symbol (*X*), not the
dynamic binding, even though the name follows
the usual naming convention (names like *FOO*) for special variables
--> PROGN SB-IMPL::%DEFUN SB-IMPL::%DEFUN SB-INT:NAMED-LAMBDA
==>
#'(SB-INT:NAMED-LAMBDA AAAB::CHECK
(*X*)
(DECLARE (SB-C::TOP-LEVEL-FORM))
(BLOCK CHECK
(IF (= *X* 5)
(SETQ *X* 10)
(FORMAT T "~d is not 5" *X*))))
This is pretty self-explanatory, but here the binding is lexical.
This is however not a property of defun, this is because there is no declared special variable named *x*.
If instead, you use defvar or defparameter, there is no warning (e.g. (defvar *x* 0)). The same goes if you only declare the variable as special: (declaim (special *x*)), before you define the function that binds it.
Inside the function, assuming *x* is declared as a special variable, the bindings works as a let, which means you can use special variables as function parameters. In your case this does not change much because you only set the current binding with the inner setq (the parameter shadows the global binding), so in effect this is a lot like a lexical variable.
But you can use a special variable to rebind dynamically a parameter:
(defun foo (*a*) ...)
This is the same as:
(defun foo (a)
(let ((*a* a))
...))

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

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 ;)
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.
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)

Unquoting without eval

I store some macros in quoted form (because in fact they produce lambdas with tricky lexical environment and I prefer store and serialize them as lists). So now I'm trying:
(defun play (s)
(funcall (macroexpand s)))
Macroexpand evaluates quoted lambda, so funcall can't run it. How to unquote result of macroexpand without eval? Because in my case it would cause indefensible security hole.
MORE INFO:
What I get look like this (in simplest case):
FUNCALL: #1=#'(LAMBDA (#:G6008) (SYMBOL-MACROLET NIL T)) is not a function name; try using a symbol instead
and symbol-macrolet is what actually builds up "tricky lexical environment" inside lambda.
Macroexpand evaluates quoted lambda, so funcall can't run it. How to
unquote result of macroexpand without eval? Because in my case it
would cause indefensible security hole.
I think that Sylwester's comment about the XY problem is probably right here; it sounds like you're trying to do something that might be done better in a different way. That said, if you have a list that's a lambda expression, you can use coerce to get a function object instead of using eval. That is, you can do this:
CL-USER> (funcall '(lambda () 42))
; Error, like you've been having
CL-USER> (funcall (coerce '(lambda () 42) 'function))
42 ; turned the list (lambda () 42) into a function and called it
This is described in the documentation for coerce; when the "output" type is function, this is what happens with the object argument:
If the result-type is function, and object is any function name that
is fbound but that is globally defined neither as a macro name nor as
a special operator, then the result is the functional value of object.
If the result-type is function, and object is a lambda expression,
then the result is a closure of object in the null lexical
environment.
Thus, if you have a function that returns list of the form (lambda ...), you can use coerce and funcall with its result. This includes macroexpansions, although you may want to use macroexpand-1 rather than macroexpand, because lambda is already a macro, so if you expand too far, (lambda () ...) turns into (function (lambda () ...)).
CL-USER> (defmacro my-constantly (value)
`(lambda () ,value))
MY-CONSTANTLY
CL-USER> (macroexpand-1 '(my-constantly 36))
(LAMBDA () 36)
T
CL-USER> (funcall (coerce (macroexpand-1 '(my-constantly 36)) 'function))
36
If you try that with the plain macroexpand, though, there's a problem. Consider yourself warned:
CL-USER> (macroexpand '(my-constantly 36))
#'(LAMBDA () 36) ; not a list, but a function
T
CL-USER> (funcall (coerce (macroexpand '(my-constantly 36)) 'function))
; Error. :(
I think this is a case where you will find that the REPL is your friend. To get you started:
cl-user> (defmacro foo () #'(lambda () :hi))
foo
cl-user> (foo)
#<Compiled-function (:internal foo) (Non-Global) #x3020014F82FF>
cl-user> (funcall *)
:hi
cl-user> (macroexpand '(foo))
#<Compiled-function (:internal foo) (Non-Global) #x3020014F82FF>
t
cl-user> (funcall *)
:hi
cl-user>
I'll note in passing that the lambda form that appears in your example takes an argument, while your funcall doesn't provide one.
There are several issues with this. First I think this is a XY problem so if you show more of your problem I guess we might find a solution for it.
It has nothing with unquoting since when evaluation a quoted expression it's not longer quoted, but it's turn into data representation of the original quoted expression. You must eval data if you want to run it.
With eval you won't get the current lexical scope. So since you mention eval and lexical environment in the same post makes me thing you won't get what you want.
Now it's no problem making a list of functions, like this:
(list (lambda (x) (+ x x))
This is not quoted since I use list and teh lambda is evaluated to a closure. If it was assigned to variable x you could call it with (funcall (car x) 10)) ; ==> 20
EDIT
I actually made the same error message with this code:
(defmacro test () '#'(lambda (x) x))
(macroexpand '(test)) ; ==> #'(lambda (x) x) ; t
(funcall (macroexpand '(test)) 5) ; ==>
*** - funcall: #'(lambda (x) x) is not a function name; try using a symbol
instead
It doesn't work since you cannot call a lambda unevaluated. You need to call the closure (function) which is the result of the evaluation of the lambda form. If you would instead not quote it you'll have that evaluation in the macro:
(defmacro test () #'(lambda (x) x))
(macroexpand '(test)) ; ==> #<function :lambda (x) x> ;
(funcall (macroexpand '(test)) 5) ; ==> 5
Actually I cannot see why you would need to make this a macro. Lets make it a function instead.
(defun test () #'(lambda (x) x))
(funcall (test) 5 ) ; ==> 5
Even if this was more comples in most cases you would do with a closure.

define variable with defparameter with name determined at runtime

I would like to initiate dynamically a hash table with defmethod or defun using one of the arguments to create the name. For instance:
(defun foo (arg)
(let ((NAME (read-from-string (format nil "\*~S\*" arg))))
(defparameter NAME (make-hash-table))))
Of course, foo create hash table with the symbol NAME, instead of the value of NAME in let. What can I do to get the value of NAME to create this hash table?
General Remarks
It is almost always wrong to create global variables in functions.
It is also almost always wrong to create new symbols using read-from-string instead of intern.
Use a Macro
What you probably want is
(defmacro def-ht (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
`(defparameter ,var (make-hash-table))))
(def-ht foo)
Use a Function
You might be able to do it in a function too - by inspecting the macroexpansion of a defparameter form and placing the needed stuff in the function:
(defun make-ht-var (name)
(let ((var (intern (concatenate 'string "*" (symbol-name name) "*")
(symbol-package name))))
(setf (symbol-value var) (make-hash-table))
(proclaim (list var 'special))))
(make-ht-var 'foo)
Note that the argument to the function is quoted, but the argument to the macro is not.
You need to use a macro instead of a function. DEFPARAMETER will bind value of MAKE-HASH-TABLE to the symbol NAME because it evaluates at macro-expansion time which occurs earlier than run-time, which is when the function FOO binds the lexical value of NAME.
Look up the CL evaluation model for a deeper understanding.
(defmacro foo (arg)
(let ((name (read-from-string (format nil "*~S*" arg))))
`(defparameter ,name (make-hash-table))))
(foo "my-hash")
=> <hash-table 0x121>
*my-hash*
=> <hash-table 0x121>

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))))