I have code like this:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(eval (cons 'name x) (interaction-environment))))))
(define x (map (macron lambda)
'(((x) (display x)) ((a b) (+ a b)))))
(let ((square (car x))
(sum (cadr x)))
(display (square 10))
(newline)
(display (sum 1 2 3))
(newline))
the code is working it use macro as value by wrapping it with lambda. My question is how can I put inside syntax-rule macro literal symbol 'name instead of (cons 'lambda ...) so the output code is:
(lambda (x)
(eval (cons 'name x) (interaction-environment)))
so it work with code like this:
(define (name x)
(display x)
(newline))
(for-each (macron lambda) ;; lambda can be anything
'((1) (2) (3)))
and it print all the numbers.
I know that I can change the name in pattern into something else, but I want to know more about syntax-rules and it's edge cases. So is it possible to have name if I use it as input pattern?
I'm looking for answers with R7RS, that have more of this type of edge cases covered.
All macros happens in compile time so runtime stuff might not exist. That means that you should think of it as syntax sugar and use it as susch. eg.
(for-each (macron something) '((1) (2) (3)))
Should then have an expansion based on that. Your current expansion is that it turns into this:
(for-each (lambda (x)
(eval (cons 'someting x) (interaction-environment))
'((1) (2) (3)))
For something being a macro this will apply the macro in runtime. It is bad. It also removes the need for the macro in the first place. You could do this instead:
(define (macron-proc name)
(lambda (x)
(eval (cons name x) (interaction-environment))))
(for-each (macron-proc 'something) '((1) (2) (3)))
I made a programming language that had passable macros:
(define xor (flambda (a b) `(if ,a (not ,b) ,b)))
(define (fold comb init lst)
(if (null? lst)
init
(fold comb (comb (car lst) init) (cdr lst))))
(fold xor #f '(#t #t)) ; ==> #f
It's not a very good approach if you are targeting an efficient compiled end product. The first macros were indeed like this and they removed it in LISP 1.5 before Common Lisp. Scheme avoided macros for many years and opted for syntax-rules in R4RS as an optional feature. R6RS is the only version that has full power macros.
With a procedure instead of macros this is actually the same as the following code with the bad eval removed:
(for-each (lambda (x)
(apply something x))
'((1) (2) (3)))
Which means you can implement macron much easier:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(apply name x)))))
But from looking at this now you don't need a macro at all. This is partial application.
(define (partial proc arg)
(lambda (lst)
(apply proc arh lst)))
(map (partial + 3) '((1 2) (3 4) (4 5)))
; ==> (6 10 12)
There is actually a SRFI-26 called cut/cute which allows us to do something similar where it wraps it in a lambda:
(map (cut apply + 3 <>) '((1 2) (3 4) (4 5)))
The syntax-rules are the macros with the least power. You cannot do anything unhygienic and you cannot make new identifiers based on other ones. Eg. it' impossible to implement a racket style struct where you can do (struct complex [real imag]) and have the macro create complex?, complex-real, and complex-imag as procedures. You need to do as SRFI-57 does and require th euser to specify all the names such that you don't need to concatenate to new identifiers.
Right now R7RS-small only has syntax-rules. I think it was a mistake not to have a more powerful macro as an alternative since now the R7RS-large cannot be implemented with R7RS-small.
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)
I'm just starting to learn the concept of macro functions.
My teacher has asked us to create a macro function that would function exactly the same way as incf.
Here is an example he has given us for pop
(defmacro mypop (nom)
(list 'prog1 (list 'car nom) (list 'setq nom (list 'cdr nom))) )
Here is the regular function I'm trying to turn into a macro:
(defun iincf (elem &optional num )
(cond
((not num) (setq elem (+ 1 elem)))
(t (setq elem (+ num elem))) ) )
Here is my attempt at turning it into a macro :
(defmacro myincf (elem &optional num )
(list 'cond
((list 'not num) (list 'setq elem (list '+ 1 elem)))
(t (list 'setq elem (list '+ num elem))) ) )
However, I get this error and I don't know why:
*** - system::%expand-form: (list 'not num) should be a lambda expression
Also, I'm not sure whether my function would actually change the value of the variable at the top level.
So here are my 2 questions:
Why do I get this error?
Is the function I'm trying to turn into a macro fine? (if successfully turning it into a macro function, would it do what I intend to?)
PS: I know this exercise would probably infringe many common rules in lisp, but this is just for practice. Thanks! :)
The reason for the error is that your syntax is invalid:
((list ...) ...)
(t (list ...))
The first element should be a function name or a lambda expression, so you would need to change it to something like
(list (list ...) ...)
(list t (list ...))
Although the macro isn't a very good one yet. First of all, the backquote syntax would make the code much more readable. It allows you to write a template where only the specified forms are evaluated. For example, the given MYPOP macro would look like
(defmacro mypop (nom)
`(prog1 (car ,nom)
(setq ,nom (cdr ,nom))))
Only the forms with a comma before them are evaluated. Same with your macro:
(defmacro myincf (elem &optional num)
`(cond
((not ,num) (setq ,elem (+ 1 ,elem)))
(t (setq ,elem (+ ,num ,elem)))))
The COND shouldn't really be part of the expansion though. It should be evaluated during macroexpansion, and only the SETQ form from one of the branches returned.
(defmacro myincf (elem &optional num)
(cond
((not num) `(setq ,elem (+ 1 ,elem)))
(t `(setq ,elem (+ ,num ,elem)))))
The only difference between the two branches is that the first one defaults to 1 for NUM. A simpler way to achieve the same would be to give NUM a default value.
(defmacro myincf (elem &optional (num 1))
`(setq ,elem (+ ,num ,elem)))
Of course, the standard INCF is a bit more complex, since it works for all sorts of places (not just variables) and ensures that the subforms of the place are evaluated only once. However, since the MYPOP example doesn't handle those, I don't think you have to either.
If you want to, a simple way to define such a macro would be
(define-modify-macro myincf (&optional (num 1)) +)
Or you could do the same manually with something like
(defmacro myincf (place &optional (num 1) &environment env)
(multiple-value-bind (dummies vals store setter getter)
(get-setf-expansion place env)
`(let* (,#(mapcar #'list dummies vals)
(,(first store) (+ ,getter ,num)))
,setter)))
But using DEFINE-MODIFY-MACRO would be preferrable in a real program (shorter code, less bugs). You could read about GET-SETF-EXPANSION and DEFINE-MODIFY-MACRO if you're interested.
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)
Is there a case where gensym's feature of appending unique numbers to the prefix comes in handy? I don't get why there is gensym when
(let ((str "batman"))
(eq (make-symbol str)
(make-symbol str)))
always returns nil.
GENSYM for example makes debugging generated code slightly easier.
Example:
See this expansion of a LOOP macro. You can see which symbols are the same by looking at their names, even though they are not interned in a package. There are two uninterned temp variables. Different names now make the use clear.
CL-USER 4 > (pprint (macroexpand '(loop for i in '(1 2 3) sum i)))
(BLOCK NIL
(MACROLET ((LOOP-FINISH () '(GO #:|end-loop-1103|)))
(LET ((I NIL) (#:|tail-1106| '(1 2 3)) (#:|by-1107| 'SYSTEM:CDR$CONS))
(LET ((#:|accumulator-1104| 0))
(DECLARE (TYPE NUMBER #:|accumulator-1104|))
(TAGBODY
#:|begin-loop-1102| NIL
(PROGN
(WHEN (OR (ENDP #:|tail-1106|)) (GO #:|end-loop-1103|))
(LET ((#:|temp-1109| (FUNCALL #:|by-1107| #:|tail-1106|))
(#:|temp-1108| (SYSTEM:CAR$CONS #:|tail-1106|)))
(SETQ I #:|temp-1108|)
(SETQ #:|tail-1106| #:|temp-1109|)))
(INCF #:|accumulator-1104| I)
(GO #:|begin-loop-1102|)
#:|end-loop-1103| (RETURN-FROM NIL #:|accumulator-1104|))))))