I'm trying to define a macro that'll take a struct's name, a key, and the name of a hash table in the struct and define functions to access and modify the value under the key in the hash.
(defmacro make-hash-accessor (struct-name key hash)
(let ((key-accessor (gensym))
(hash-accessor (gensym)))
`(let ((,key-accessor (accessor-name ,struct-name ,key))
(,hash-accessor (accessor-name ,struct-name ,hash)))
(setf (fdefinition ,key-accessor) ; reads
(lambda (instance)
(gethash ',key
(funcall ,hash-accessor instance))))
(setf (fdefinition '(setf ,key-accessor)) ; modifies
(lambda (instance to-value)
(setf (gethash ',key
(funcall ,hash-accessor instance))
to-value))))))
;; Returns the symbol that would be the name of an accessor for a struct's slot
(defmacro accessor-name (struct-name slot)
`(intern
(concatenate 'string (symbol-name ',struct-name) "-" (symbol-name ',slot))))
To test this I have:
(defstruct tester
(hash (make-hash-table)))
(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)
When I run
(make-hash-accessor tester x hash)
then
(tester-x too)
it returns 3 T, as it should, but
(setf (tester-x too) 5)
gives the error:
The function (COMMON-LISP:SETF COMMON-LISP-USER::TESTER-X) is undefined.
[Condition of type UNDEFINED-FUNCTION]
(macroexpand-1 '(make-hash-accessor tester x hash)) expands to
(LET ((#:G690 (ACCESSOR-NAME TESTER X)) (#:G691 (ACCESSOR-NAME TESTER HASH)))
(SETF (FDEFINITION #:G690)
(LAMBDA (INSTANCE) (GETHASH 'X (FUNCALL #:G691 INSTANCE))))
(SETF (FDEFINITION '(SETF #:G690))
(LAMBDA (INSTANCE TO-VALUE)
(SETF (GETHASH 'X (FUNCALL #:G691 INSTANCE)) TO-VALUE))))
T
I'm using SBCL. What am I doing wrong?
You should use defun whenever possible.
Specifically, here instead of defmacro for accessor-name and instead of (setf fdefinition) for your accessors:
(defmacro define-hash-accessor (struct-name key hash)
(flet ((concat-symbols (s1 s2)
(intern (concatenate 'string (symbol-name s1) "-" (symbol-name s2)))))
(let ((hash-key (concat-symbols struct-name key))
(get-hash (concat-symbols struct-name hash)))
`(progn
(defun ,hash-key (instance)
(gethash ',key (,get-hash instance)))
(defun (setf ,hash-key) (to-value instance)
(setf (gethash ',key (,get-hash instance)) to-value))
',hash-key))))
(defstruct tester
(hash (make-hash-table)))
(defvar too (make-tester))
(setf (gethash 'x (tester-hash too)) 3)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 3)))
(define-hash-accessor tester x hash)
==> tester-x
(tester-x too)
==> 7; T
(setf (tester-x too) 5)
too
==> #S(TESTER :HASH #S(HASH-TABLE :TEST FASTHASH-EQL (X . 5)))
Note that I use a more conventional name for the macro: since it defines accessorts, it is common to name it define-... (cf. define-condition, defpackage).
make-... is usually used for functions returning objects (cf. make-package).
See also Is defun or setf preferred for creating function definitions in common lisp and why?
Remember, style is important, both in indentation and in naming variables, functions, and macros.
Related
I am trying to do the following: separate a function that gets values from some user input from the function that uses it.
I have tried the following code for the proof of concept initially (that worked):
(defun initialiser (bindings)
(cl-loop for (var) in bindings do
(set var (read-from-minibuffer "Input value: "))))
That i have tested with:
(let ((name))
(initialiser '((name)))
(message "name is %S" name))
The idea was to pass bindings to the function that handles input in the form like ((name "Name") (address "Post address") (code "County code")) or something similar, and in there assign the input.
After testing above i have come up with the following macro to do things:
(defmacro initialise-and-execute (bindings initialiser &rest callback-actions)
(let ((unwrapped-bindings (map 'list (lambda (binding) (car binding)) bindings)))
`(let ,unwrapped-bindings
(,initialiser (quote ,bindings)
(lambda () ,#callback-actions)))))
However, in the "real" scenario the assignments must happen in callbacks, like:
(defun initialiser(bindings)
(cl-loop for (var) in bindings collect
(lambda () (set var (read-from-minibuffer "Input value: ")))
into callbacks
return callbacks))
This fails to work. Code i have used to test was:
(defvar callbacks nil)
(let ((name))
(setq callbacks (initialiser '((name)))))
(funcall (car callbacks))
Edit: changed the code the following way:
(defmacro initialise-and-execute (bindings initialiser &rest callback-actions)
(let ((unwrapped-bindings (map 'list (lambda (binding) (car binding)) bindings)))
`(lexical-let ,unwrapped-bindings
(,initialiser
(quote ,(map 'list
(lambda (binding) (list (cadr binding)
`(lambda (val) (setq ,(car binding) val))))
bindings))
(lambda () ,#callback-actions)))))
What it must do: generate number of lambdas that share the same lexical environment - one that uses captured variables and the rest that modify them.
However, what i get is, regrettably, something else. Symbols used in callback-actions do not resolve into the values set.
For completeness, here is how i tested it:
(defun init-values (bindings callback)
(loop for (desc setter) in bindings
for idx = 0 then (incf idx)
do (print (format "Setting %s" desc))
(funcall setter idx))
(funcall callback))
(initialise-and-execute
((name "Name")
(surname "Surname"))
init-values
(message "name is %S" name))
Here, lambdas were not generated in a loop and values in the context of a lexical binding were assigned with setq.
To set the function value, use fset, not set.
(defun initialiser(bindings)
(cl-loop for (var) in bindings collect
(lambda () (fset var (read-from-minibuffer "Input value: ")))
into callbacks
return callbacks))
There are possible issues:
in a LOOP the VAR is possibly assigned on each iteration, not bound (that's in Common Lisp). so your callbacks set all the same VAR value.
in a lexical bound Lisp (new in GNU Emacs Lisp) one can't set the variable values with SET
Examples:
ELISP> (mapcar #'funcall
(cl-loop for i in '(1 2 3 4)
collect (lambda () i)))
(4 4 4 4)
all closures have the same value of i
ELISP> (let ((a 'foobar))
(set 'a 42)
a)
foobar
SET had no effect on the local variable
In Common Lisp I might write something like:
(defun initializer (bindings)
(loop for (what setter) in bindings
for new-value = (progn
(format t "Enter ~a: " what)
(finish-output)
(read-line))
do (funcall setter new-value)))
(defmacro call-with-bindings (name-sym-list fn)
(let ((value-sym (gensym "v")))
`(,fn
(list ,#(loop for (name sym) in name-sym-list
collect `(list ,name ,`(lambda (,value-sym)
(setf ,sym ,value-sym))))))))
CL-USER > (let (name age)
(call-with-bindings (("name" name) ("age" age))
initializer)
(format t "name is ~S~%" name)
(values name age))
Enter name: Lara
Enter age: 42
name is "Lara"
"Lara"
"42"
Where we can look at the macro expansion:
CL-USER > (pprint (macroexpand-1
'(call-with-bindings (("name" name) ("age" age))
initializer)))
(INITIALIZER (LIST (LIST "name"
(LAMBDA (#:|v1669|)
(SETF NAME #:|v1669|)))
(LIST "age"
(LAMBDA (#:|v1669|)
(SETF AGE #:|v1669|)))))
After some experimenting, i have been able to do it. The key was realising that lexical-let apparently had some restrictions on how the lambda should be placed for them to have the same closure context. After i have managed to generate set of closures that referred to the same variables, the rest was easy.
Here is the final code:
(defmacro make-lamba-set (bindings &rest callback-actions)
"Make set of closures with shared context
BINDINGS are a list of form (SYMBOL NAME), where SYMBOL is not defined yet
CALLBACK-ACTIONS are forms that use symbols from bindings
Return created captures a as a list of forms:
(do-callback-actions (set-symbol NAME) ...)"
(let ((unwrapped-bindings (map 'list
(lambda (binding)
(car binding))
bindings)))
`(lexical-let ,unwrapped-bindings
(list (lambda () ,#callback-actions)
,#(map 'list
(lambda (binding)
`(list
(lambda (val)
(setq ,(car binding) val))
,(cadr binding)))
bindings)))))
(defmacro initialise-and-execute (bindings initialiser &rest callback-actions)
"BINGINGS have form of ((BINDING-SYMBOL PROMPT) ...)
INITIALISER somehow assigns values to all of BINDING-SYMBOL
then it calls CALLBACK-ACTIONS with values of BINDING-SYMBOL set"
`(let ((closure-parts (make-lamba-set ,bindings ,#callback-actions)))
(,initialiser (cdr closure-parts)
(car closure-parts))))
Here is how i tested it:
(defun init-values (bindings callback)
(loop for (setter desc) in bindings
for idx = 0 then (incf idx)
do (message "Setting %s" desc)
(funcall setter idx))
(funcall callback))
(initialise-and-execute ((name "Name")
(surname "Surname"))
init-values
(insert (format "Name is %S and surname is %S"
name
surname)))
That gave me expected output of:
Name is 0 and surname is 1
contextualization: I've been doing a university project in which I have to write a parser for regular expressions and build the corresponding epsilon-NFA. I have to do this in Prolog and Lisp.
I don't know if questions like this are allowed, if not I apologize.
I heard some of my classmates talking about how they used the function gensym for that, I asked them what it did and even checked up online but I literally can't understand what this function does neither why or when is best to use it.
In particular, I'm more intrested in what it does in Lisp.
Thank you all.
GENSYM creates unique symbols. Each call creates a new symbol. The symbol usually has a name which includes a number, which is counted up. The name is also unique (the symbol itself is already unique) with a number, so that a human reader can identify different uninterned symbols in the source code.
CL-USER 39 > (gensym)
#:G1083
CL-USER 40 > (gensym)
#:G1084
CL-USER 41 > (gensym)
#:G1085
CL-USER 42 > (gensym)
#:G1086
gensym is often used in Lisp macros for code generation, when the macro needs to create new identifiers, which then don't clash with existing identifiers.
Example: we are going to double the result of a Lisp form and we are making sure that the Lisp form itself will be computed only once. We do that by saving the value in a local variable. The identifier for the local variable will be computed by gensym.
CL-USER 43 > (defmacro double-it (it)
(let ((new-identifier (gensym)))
`(let ((,new-identifier ,it))
(+ ,new-identifier ,new-identifier))))
DOUBLE-IT
CL-USER 44 > (macroexpand-1 '(double-it (cos 1.4)))
(LET ((#:G1091 (COS 1.4)))
(+ #:G1091 #:G1091))
T
CL-USER 45 > (double-it (cos 1.4))
0.33993432
a little clarification of the existing answers (as the op is not yet aware of the typical common lisp macros workflow):
consider the macro double-it, proposed by mr. Joswig. Why would we bother creating this whole bunch of let? when it can be simply:
(defmacro double-it (it)
`(+ ,it ,it))
and ok, it seems to be working:
CL-USER> (double-it 1)
;;=> 2
but look at this, we want to increment x and double it
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 5
;; WHAT? it should be 4!
the reason can be seen in macro expansion:
(let ((x 1))
(+ (setq x (+ 1 x)) (setq x (+ 1 x))))
you see, as the macro doesn't evaluate form, just splices it into generated code, it leads to incf being executed twice.
the simple solution is to bind it somewhere, and then double the result:
(defmacro double-it (it)
`(let ((x ,it))
(+ x x)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 4
;; NICE!
it seems to be ok now. really it expands like this:
(let ((x 1))
(let ((x (setq x (+ 1 x))))
(+ x x)))
ok, so what about the gensym thing?
let's say, you want to print some message, before doubling your value:
(defmacro double-it (it)
`(let* ((v "DOUBLING IT")
(val ,it))
(princ v)
(+ val val)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> DOUBLING IT
;;=> 4
;; still ok!
but what if you accidentally name value v instead of x:
CL-USER> (let ((v 1))
(double-it (incf v)))
;;Value of V in (+ 1 V) is "DOUBLING IT", not a NUMBER.
;; [Condition of type SIMPLE-TYPE-ERROR]
It throws this weird error! Look at the expansion:
(let ((v 1))
(let* ((v "DOUBLING IT") (val (setq v (+ 1 v))))
(princ v)
(+ val val)))
it shadows the v from the outer scope with string, and when you are trying to add 1, well it obviously can't. Too bad.
another example, say you want to call the function twice, and return 2 results as a list:
(defmacro two-funcalls (f v)
`(let ((x ,f))
(list (funcall x ,v) (funcall x ,v))))
CL-USER> (let ((y 10))
(two-funcalls (lambda (z) z) y))
;;=> (10 10)
;; OK
CL-USER> (let ((x 10))
(two-funcalls (lambda (z) z) x))
;; (#<FUNCTION (LAMBDA (Z)) {52D2D4AB}> #<FUNCTION (LAMBDA (Z)) {52D2D4AB}>)
;; NOT OK!
this class of bugs is very nasty, since you can't easily say what's happened.
What is the solution? Obviously not to name the value v inside macro. You need to generate some sophisticated name that no one would reproduce in their code, like my-super-unique-value-identifier-2019-12-27. This would probably save you, but still you can't really be sure. That's why gensym is there:
(defmacro two-funcalls (f v)
(let ((fname (gensym)))
`(let ((,fname ,f))
(list (funcall ,fname ,v) (funcall ,fname ,v)))))
expanding to:
(let ((y 10))
(let ((#:g654 (lambda (z) z)))
(list (funcall #:g654 y) (funcall #:g654 y))))
you just generate the var name for the generated code, it is guaranteed to be unique (meaning no two gensym calls would generate the same name for the runtime session),
(loop repeat 3 collect (gensym))
;;=> (#:G645 #:G646 #:G647)
it still can potentially be clashed with user var somehow, but everybody knows about the naming and doesn't call the var #:GXXXX, so you can consider it to be impossible. You can further secure it, adding prefix
(loop repeat 3 collect (gensym "MY_GUID"))
;;=> (#:MY_GUID651 #:MY_GUID652 #:MY_GUID653)
GENSYM will generate a new symbol at each call. It will be garanteed, that the symbol did not exist before it will be generated and that it will never be generated again. You may specify a symbols prefix, if you like:
CL-USER> (gensym)
#:G736
CL-USER> (gensym "SOMETHING")
#:SOMETHING737
The most common use of GENSYM is generating names for items to avoid name clashes in macro expansion.
Another common purpose is the generaton of symbols for the construction of graphs, if the only thing demand you have is to attach a property list to them, while the name of the node is not of interest.
I think, the task of NFA-generation could make good use of the second purpose.
This is a note to some of the other answers, which I think are fine. While gensym is the traditional way of making new symbols, in fact there is another way which works perfectly well and is often better I find: make-symbol:
make-symbol creates and returns a fresh, uninterned symbol whose name is the given name. The new-symbol is neither bound nor fbound and has a null property list.
So, the nice thing about make-symbol is it makes a symbol with the name you asked for, exactly, without any weird numerical suffix. This can be helpful when writing macros because it makes the macroexpansion more readable. Consider this simple list-collection macro:
(defmacro collecting (&body forms)
(let ((resultsn (make-symbol "RESULTS"))
(rtailn (make-symbol "RTAIL")))
`(let ((,resultsn '())
(,rtailn nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null ,rtailn)
(setf ,resultsn new
,rtailn new)
(setf (cdr ,rtailn) new
,rtailn new)))
it))
,#forms
,resultsn))))
This needs two bindings which the body can't refer to, for the results, and the last cons of the results. It also introduces a function in a way which is intentionally 'unhygienic': inside collecting, collect means 'collect something'.
So now
> (collecting (collect 1) (collect 2) 3)
(1 2)
as we want, and we can look at the macroexpansion to see that the introduced bindings have names which make some kind of sense:
> (macroexpand '(collecting (collect 1)))
(let ((#:results 'nil) (#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #:rtail)
(setf #:results new #:rtail new)
(setf (cdr #:rtail) new #:rtail new)))
it))
(collect 1)
#:results))
t
And we can persuade the Lisp printer to tell us that in fact all these uninterned symbols are the same:
> (let ((*print-circle* t))
(pprint (macroexpand '(collecting (collect 1)))))
(let ((#2=#:results 'nil) (#1=#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #1#)
(setf #2# new #1# new)
(setf (cdr #1#) new #1# new)))
it))
(collect 1)
#2#))
So, for writing macros I generally find make-symbol more useful than gensym. For writing things where I just need a symbol as an object, such as naming a node in some structure, then gensym is probably more useful. Finally note that gensym can be implemented in terms of make-symbol:
(defun my-gensym (&optional (thing "G"))
;; I think this is GENSYM
(check-type thing (or string (integer 0)))
(let ((prefix (typecase thing
(string thing)
(t "G")))
(count (typecase thing
((integer 0) thing)
(t (prog1 *gensym-counter*
(incf *gensym-counter*))))))
(make-symbol (format nil "~A~D" prefix count))))
(This may be buggy.)
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 wonder if it is possible to dynamically build COND clauses from a loop like (pseudo code):
(defvar current-state 1)
(defmacro mymacro ()
(cond
`(loop (state . callback) in possible-states
do ((eq current-state ,state)
(funcall ,callback)))))
The LOOP would build the clauses from a list and generate something like:
(cond
((eq current-state 1)
(funcall func-1))
((eq current-state 2)
(funcall func-2))
((eq current-state 3)
(funcall func-3)))
Macros are expanded at compile time, so your possible-states variable has to be a compile-time constant. If this is not the case (or if you are not absolutely clear on what I mean above), you should not use a macro here.
Use a function instead:
(funcall (cdr (find current-state possible-states :key #'car :test #'eq)))
or
(funcall (cdr (assoc current-state possible-states :test #'eq)))
or, better yet, make your possible-states a hash
table rather than an association
list:
(funcall (gethash current-state possible-states))
However, if your possible-states is a compile time constant, you
can, indeed, use a macro, except that you probably want to use
case instead of
cond:
(defmacro state-dispatch (state)
`(case ,state
,#(mapcar (lambda (cell)
`((,(car cell)) (,(cdr cell))))
possible-states)))
(defparameter possible-states '((1 . foo) (2 . bar)))
(macroexpand-1 '(state-dispatch mystate))
==> (CASE MYSTATE ((1) (FOO)) ((2) (BAR))) ; T
Note that from the speed point of view, the gethash version is probably identical to the macro version (at the very least it is not slower).
I would like to create a function that allows to:
(incf vara varb varc vard)
Instead of
(incf vara)
(incf varb)
(incf varc)
(incf vard)
What I do not understand is how to be able to send more arguments, how to define that in a function?
(defun inc (&rest arg)
(interactive)
(mapcar 'incf arg)
)
This increases the argument, but ofcourse does not save them back into the variables.
How to go about this?
If you want to be able to write this form as (my-incf a b c) without quoting the variable names a, b, and c, make it a macro rather than a function:
(defmacro incf+ (&rest vars)
`(progn
,#(mapcar (lambda (var) `(incf ,var)) vars)))
Check that it expands into the right code using macroexpand:
(macroexpand '(incf+ var1 var2 var3))
;; => (progn (incf var1) (incf var2) (incf var3))
Because variables in Emacs Lisp have dynamic scope by default, you can accomplish almost the same thing with a function which takes quoted variable names as arguments. But the macro version has the advantage that, since it expands into code in the place when it was called, it will work with lexically bound variables as well. symbol-value only works with dynamically bound variables.
You can test this by putting the following in a file and loading it (in Emacs 24 or higher):
;; -*- lexical-binding: t -*-
(defun incf+fun (&rest vars)
(mapc #'(lambda (var) (incf (symbol-value var))) vars))
(defun incf-macro-test ()
(let ((a 5) (b 7) (c 11))
(incf+ a b c)
(list a b c)))
(defun incf-function-test ()
(let ((a 5) (b 7) (c 11))
(incf+fun 'a 'b 'c)
(list a b c)))
Evaluating (incf-macro-test) will return (6 8 12), but (incf-function-test) will enter the debugger with a (void-variable a) error.
It should work:
(require 'cl)
(setq a 1)
(setq b 2)
(defun inc (&rest arg)
(interactive)
(mapc (lambda (x) (incf (symbol-value x))) arg))
(inc 'a 'b)
(message "%s %s" a b) => (2 3)
You have to quote each argument otherwise (inc a b) becomes (inc 1 2) before executing inc.