In Common Lisp, I can get a function to pass around with the #' syntax, like this:
(let ((x #'+))
(funcall x 1 2))
But suppose I want to set a function so I don't have to use funcall for it. Does Common Lisp have a local function name table, or just the global one that is assigned to with defun?
Is there a way to assign to a function symbol other than defun? Or more generally: is there a way I can do something similar to this nonworking example:
(setf #'x #'+)
(x 1 2)
You can define a local function using
flet and labels:
(flet ((f (x) (1+ (* 2 x))))
(f 7))
==> 15
You can also set function definition of a symbol using fdefinition:
(setf (fdefinition 'f) #'+)
(f 1 2 3)
==> 6
Note that let binds the
value cell of the symbol while flet bind the function cell.
When the symbol appears in the "function" position, the "function"
cell is used, while when it appears in the "value" position, the "value"
cell is used:
(setf (symbol-function 'x) #'car)
(setf (symbol-value 'x) #'cdr)
(x '(1 . 2))
==> 1
(funcall x '(1 . 2))
==> 2
Similarly,
(flet ((x (o) (car o)))
(let ((x #'cdr))
(cons (x '(1 . 2))
(funcall x '(1 . 2)))))
==> (1 . 2)
This is the difference between Lisp-1 and Lisp-2.
Finally, note that CLISP is just one implementation of the language ANSI Common Lisp.
One option for getting this kind of behavior is to write a macro to do it.
(defmacro flet* (assignments &body body)
(let ((assignments (mapcar
(lambda (assn)
(list (first assn) '(&rest args)
(list 'apply (second assn) 'args)))
assignments)))
`(flet ,assignments ,#body)))
This macro translates flet* into flet + apply like this:
(flet* ((x #'+)
(y #'*))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
Becomes:
(flet ((x (&rest args) (apply #'+ args))
(y (&rest args) (apply #'* args)))
(pprint (x 1 2))
(pprint (y 3 4))
(pprint (x (y 2 3) 4)))
Related
I am trying to do the exercises on this tutorial about CLOS using SBCL and Slime (Emacs).
I have this class, instance, and function to set values for the slots:
(defclass point ()
(x y z))
(defvar my-point
(make-instance 'point))
(defun with-slots-set-point-values (point a b c)
(with-slots (x y z) point (setf x a y b z c)))
Using the REPL, it works fine:
CL-USER> (with-slots-set-point-values my-point 111 222 333)
333
CL-USER> (describe my-point)
#<POINT {1003747793}>
[standard-object]
Slots with :INSTANCE allocation:
X = 111
Y = 222
Z = 333
; No value
Now, the exercises indicates that using the symbol-macrolet I need to implement my version of with-slots.
I have a partial implementation of my with-slots (I still need to insert add the operation):
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) (slot-value object var)) slot-list)))
It works when calling it:
CL-USER> (partial-my-with-slots '(x y z) my-point)
((X 111) (Y 222) (Z 333))
Since this use of symbol-macrolet works:
CL-USER> (symbol-macrolet ((x 111) (y 222) (z 333))
(+ x y z))
666
I tried doing:
CL-USER> (symbol-macrolet (partial-my-with-slots '(x y z) my-point)
(+ x y z))
But, for some reason that I do not know, Slime throws the error:
malformed symbol/expansion pair: PARTIAL-MY-WITH-SLOTS
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Why does this happen? How can I fix this?
You can't write with-slots as a function which is called at run time. Instead it needs to be a function which takes source code as an argument and returns other source code. In particular if given this argument
(my-with-slots (x ...) <something> <form> ...)
It should return this result:
(let ((<invisible-variable> <something))
(symbol-macrolet ((x (slot-value <invisible-variable>)) ...)
<form> ...))
You need <invisible-variable> so you evaluate <object-form> only once.
Well, here is a function which does most of that:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
`(let ((<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value <invisible-variable>
',slot-name)))
slot-names)
,#forms))))
And you can check this:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((<invisible-variable> a))
(symbol-macrolet ((x (slot-value <invisible-variable> 'x))
(y (slot-value <invisible-variable> 'y)))
(list x y)))
So that's almost right, except the invisible variable really needs to be invisible:
(defun mws-expander (form)
(destructuring-bind (mws (&rest slot-names) object-form &rest forms) form
(declare (ignore mws))
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable>
',slot-name)))
slot-names)
,#forms)))))
And now:
> (mws-expander '(my-with-slots (x y) a (list x y)))
(let ((#:g1509 a))
(symbol-macrolet ((x (slot-value #:g1509 'x))
(y (slot-value #:g1509 'y)))
(list x y)))
Well, a function which takes source code as an argument and returns other source code is a macro. So, finally, we need to install this function as a macroexpander, arranging to ignore the second argument that macro functions get:
(setf (macro-function 'mws)
(lambda (form environment)
(declare (ignore environment))
(mws-expander form)))
And now:
> (macroexpand '(mws (x y) a (list x y)))
(let ((#:g1434 a))
(symbol-macrolet ((x (slot-value #:g1434 'x)) (y (slot-value #:g1434 'y)))
(list x y)))
This would be more conventionally written using defmacro, of course:
(defmacro mws ((&rest slot-names) object-form &rest forms)
(let ((<invisible-variable> (gensym)))
`(let ((,<invisible-variable> ,object-form))
(symbol-macrolet ,(mapcar (lambda (slot-name)
`(,slot-name (slot-value ,<invisible-variable> ',slot-name)))
slot-names)
,#forms))))
However the two definitions are equivalent (modulo needing some eval-whenery to make the first work properly with the compiler).
You need to return expressions that will call slot-value when substituted into the macro expansion, rather than calling the function immediately. Backquote is useful for this.
(defun partial-my-with-slots (slot-list object)
(mapcar #'(lambda (alpha beta) (list alpha beta))
slot-list
(mapcar #'(lambda (var) `(slot-value ,object ',var)) slot-list)))
> (partial-my-with-slots '(x y z) 'my-point)
((x (slot-value my-point 'x)) (y (slot-value my-point 'y)) (z (slot-value my-point 'z)))
You use this in your with-slots macro like this:
(defmacro my-with-slots ((&rest slot-names) instance-form &body body)
`(symbol-macrolet ,(partial-my-with-slots slot-names instance-form)
,#body))
> (macroexpand '(my-with-slots (x y z) point (setf x a y b z c)))
(SYMBOL-MACROLET ((X (SLOT-VALUE POINT 'X))
(Y (SLOT-VALUE POINT 'Y))
(Z (SLOT-VALUE POINT 'Z)))
(SETF X A
Y B
Z C))
So using common lisp, I want to be able to do something of the sorts of:
(defmacro foo (count &rest someExpression)
`(do
((,count 0 (+ ,count 1)))
((= ,count 5) T)
`(eval ,someExpression)
)
)
(foo (print 1) temp)
With the result of it printing 1 5 times. I do not want to simply call (print 1) directly, but by passing the expression through a macro parameter and calling it via the macro. In other words, the macro foo should handle any expression(s) as input and run it. This case does not seem to work.
Edited to clarify an explicit script and intended function.
Starting with your recent version, which is at least a reasonable candidate for a macro unlike the older one:
(defmacro foo (someExpression count-var)
`(do ((,count-var 0 (+ ,count 1)))
((= ,count-var 5) T)
`(eval (,someExpression))))
Well what is the expansion of (foo (print 1) c)?
(foo (print 1) x)
-> (do ((x 0 (+ x 1))) ((= x 5) t)
`(eval (,someexpression)))
Well, that's a disaster: what is that nested backquote doing? Let's just remove it:
(defmacro foo (someExpression count-var)
`(do ((,count-var 0 (+ ,count 1)))
((= ,count-var 5) T)
(eval (,someExpression))))
(foo (print 1) x)
-> (do ((x 0 (+ x 1))) ((= x 5) t)
(eval ((print 1))))
That's less disastrous, but the eval form is entirely bogus. We can make that 'work' by changing it to be at least syntactically legal:
(defmacro foo (someExpression count)
`(do ((,count 0 (+ ,count 1)))
((= ,count 5) T)
(eval ,someExpression)))
And now
(foo (print 1) x)
-> (do ((x 0 (+ x 1))) ((= x 5) t)
(eval (print 1)))
And this will 'work' but it will work purely by coincidence: because (print 1) returns 1 and the value of 1 is 1.
(foo (print 'foo) x)
-> (do ((x 0 (+ x 1))) ((= x 5) t)
(eval (print 'foo)))
and that's a run-time error.
But ... why are you using eval? eval is a terrible, terrible solution to almost any problem you can think of, unless the solution to the problem is called 'code injection attack', and in this case it's not just terrible: it's wrong. So we just remove it.
(defmacro foo (someExpression count)
`(do ((,count 0 (+ ,count 1)))
((= ,count 5) T)
,someExpression))
And now
(foo (print 'foo) x)
-> (do ((x 0 (+ x 1))) ((= x 5) t)
(print 'foo))
Which looks like the code transformation we want. So, finally:
> (foo (print 'foo) x)
foo
foo
foo
foo
foo
t
Which is, finally, fine. And this works:
> (foo (print x) x)
0
1
2
3
4
t
As with yet another edit to the question it probably is more useful to put the variable name first and allow a bunch of expressions:
(defmacro foo (count-var &body forms)
`(do ((,count-var 0 (+ ,count-var 1)))
((= ,count-var 5))
,#forms))
This will now allow multiple expressions in the body. And we could go further: we could allow it to specify the number of iterations and the return value`:
(defmacro foo ((count-var &optional (count 1) (value 'nil)) &body forms)
`(do ((,count-var 0 (1+ ,count-var)))
((= ,count-var ,count) ,value)
,#forms))
And now
> (foo (x 2)
(print x)
(print (* x 2)))
0
0
1
2
nil
Well, the name of this macro is dotimes of course.
I have a list of two element sublists which will change and grow in the course of the program. I want to write a macro which takes a key and generates a case dynamically like:
;; This is the List for saving CASE clauses
(setf l '((number 2) (symbol 3)))
;; and i want to have the following expansion
(typecase 'y
(number 2)
(symbol 3))
I could have a macro which only refers to the global l:
(defmacro m (x)
`(typecase ,x ,#l))
which would expand correctly
(m 'y) ;expands to (TYPECASE 'Y (number 2) (symbol 3))
But how can i write the macro with a parameter for the list l so that it would work with other lists as well?
;; A macro which should generate the case based on the above list
(defmacro m (x l)
`(typecase ,x ,#l))
This doesn't work since l in the arguments list i a symbol and a call to (m 'y l) will expand to (TYPECASE 'Y . L).
Wanting to adhere to typecase mechanism, my workaround was as follows:
(setf types-x '(((integer 0 *) 38)
((eql neli) "Neli in X")
(symbol 39))
)
(setf types-y '(((eql neli) "Neli in Y")
((array bit *) "A Bit Vector")))
(defmacro m (x types-id)
(case types-id
(:x `(typecase ,x ,#types-x))
(:y `(etypecase ,x ,#types-y))))
(m 'neli :x) ;"Neli in X"
(m 'neli :y) ;"Neli in Y"
(m 'foo :x) ;39
Any hints and comments is appreciated.
You don't need a macro for what you're trying to do: use a function.
For instance, given
(defvar *type-matches*
'((float 0)
(number 1)
(t 3)))
Then
(defun type-match (thing &optional (against *type-matches*))
(loop for (type val) in against
when (typep thing type)
return (values val type)
finally (return (values nil nil))))
Will match a thing against a type:
> (type-match 1.0)
0
float
> (type-match 1)
1
number
You want to keep the variables sorted by type, which you can do by, for instance:
(setf *type-matches* (sort *type-matches* #'subtypep :key #'car))
You want to keep the matches sorted of course.
If you want to delay the execution of the forms then you can do something like this (this also deals with sorting the types):
(defvar *type-matches*
'())
(defmacro define-type-match (type/spec &body forms)
;; define a type match, optionally in a specified list
(multiple-value-bind (type var)
(etypecase type/spec
(symbol (values type/spec '*type-matches*))
(cons (values (first type/spec) (second type/spec))))
(let ((foundn (gensym "FOUND")))
`(let ((,foundn (assoc ',type ,var :test #'equal)))
(if ,foundn
(setf (cdr ,foundn) (lambda () ,#forms))
(setf ,var (sort (acons ',type (lambda () ,#forms) ,var)
#'subtypep :key #'car)))
',type/spec))))
(defun type-match (thing &optional (against *type-matches*))
(loop for (type . f) in against
when (typep thing type)
return (values (funcall f) type)
finally (return (values nil nil))))
The actual problem that you face is that if you do
(setf l '((number 2) (symbol 3)))
already on toplevel, if you evaluate l, you don't come further than
((number 2) (symbol 3))
So if you use l in a macro as an argument, you can't come further
than this. But what you need is to evaluate this form (modified after adding a typecase and an evaluated x upfront) once more within the macro.
This is, why #tfb suggested to write a function which actually evaluates the matching of the types specified in l.
So, we could regard his type-match function as a mini-interpreter for the type specifications given in l.
If you do a simple (defmacro m (x l) `(typecase ,x ,#l))
you face exactly that problem:
(macroexpand-1 '(m 1 l))
;; (typecase 1 . l)
but what we need is that l once more evaluated.
(defmacro m (x l)
`(typecase ,x ,#(eval l)))
Which would give the actually desired result:
(macroexpand-1 '(m 1 l))
;; (TYPECASE 1 (NUMBER 2) (SYMBOL 3)) ;
;; T
;; and thus:
(m 1 l) ;; 2
So far, it seems to work. But somewhere in the backhead it becomes itchy, because we know from books and community: "Don't use eval!! Eval in the code is evil!"
Trying around, you will find out when it will bite you very soon:
# try this in a new session:
(defmacro m (x l) `(typecase ,x ,#(eval l)))
;; m
;; define `l` after definition of the macro works:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m 1 l)
;; 2 ;; so our `eval` can handle definitions of `l` after macro was stated
(m '(1 2) l)
;; NIL
;; even redefining `l` works!
(setf l '((number 2) (symbol 3) (list 4)))
;; ((NUMBER 2) (SYMBOL 3) (LIST 4))
(m 1 l)
;; 2
(m '(1 2) l)
;; 4 ;; and it can handle re-definitions of `l` correctly.
;; however:
(let ((l '((number 2) (symbol 3)))) (m '(1 2) l))
;; 4 !!! this is clearly wrong! Expected is NIL!
;; so our `eval` in the macro cannot handle scoping correctly
;; which is a no-go for usage!
;; but after re-defining `l` globally to:
(setf l '((number 2) (symbol 3)))
;; ((NUMBER 2) (SYMBOL 3))
(m '(1 2) l)
;; NIL ;; it behaves correctly
(let ((lst '((number 2) (symbol 3) (list 4)))) (m '(1 2) lst))
;; *** - EVAL: variable LST has no value
;; so it becomes clear: `m` is looking in the scoping
;; where it was defined - the global scope (the parent scope of `m` when `m` was defined or within the scope of `m`).
So the conclusion is:
The given macro with eval is NOT working correctly!!
Since it cannot handle local scoping.
So #tfb's answer - writing a mini-evaluator-function for l is the probably only way to handle this in a proper, safe, correct way.
Update
It seems to me that doing:
(defmacro m (x l)
`(typecase ,x ,#l))
(defun m-fun (x l)
(eval `(m ,x ,l)))
(m-fun ''y l) ;; 3
(m-fun 'y l) ;; error since y unknown
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun ''(1 2) l)) ;; => 4 since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''(1 2) l)) ;; => NIL since it is a list
(let ((l '((number 2) (symbol 3))))
(m-fun ''y l)) ;; => 3 since it is a symbol
(let ((n 12))
(m-fun n l)) ;; => 2 since it is a number
;; to improve `m-fun`, one could define
(defun m-fun (x l)
(eval `(m ',x ,l)))
;; then, one has not to do the strangely looking double quote
;; ''y but just one quote 'y.
(let ((l '((number 2) (symbol 3) (list 4))))
(m-fun '(1 2) l)) ;; => 4 since it is a list
;; etc.
at least hides the eval within a function.
And one does not have to use backquote in the main code.
Macro expansion happens at compile time, not run time, thus if the case clause list changes over the course of the program, the macro expansion will not change to reflect it.
If you want to dynamically select an unevaluated but changeable value, you can use assoc in the expansion instead of case:
(defmacro m (x l)
`(second (assoc ,x ,l)))
Sample expansion:
(m x l)
->
(SECOND (ASSOC X L))
Output of (assoc x l) with the value of l in your question and x = 'x:
(let ((x 'x))
(m x l))
->
2
However if you did decide to do it this way, you could simplify things and replace the macro with a function:
(defun m (x l)
(second (assoc x l)))
UPDATE FOR QUESTION EDIT:
Replace assoc as follows:
(defun m (x l)
(second (assoc-if (lambda (type)
(typep x type))
l)))
The map! procedure should modify the existing list to have the values of the operator applied to the original values.
For example:
(define a '(1 2 3 4 5))
(define double (lambda (x) (* x 2)))
(map! double a)
returns
done
Then when a is evaluated, a should return
(2 4 6 8 10)
map! procedure must do that work.
(define (map! operator given-list)
(if (null? given-list) 'done
(<the procedure that does the modification>)))
My guess1:
(map (lambda (x) (set! x (operator x))) given-list)
(map! double a)
returns:
'(#<void> #<void> #<void> #<void> #<void>)
My guess2:
(cons (operator (car given-list)) (map! double (cdr given-list)))
(map! double a)
returns:
'(2 4 6 8 10 . done)
My guess3:
(set! given-list (map operator given-list))
(map! double a)
returns:
'(2 4 6 8 10)
My guess4:
(let ((element (car given-list)))
(set! element (operator given-list) (map! operator (cdr given-list)))
(map! double a)
returns:
'done
but, when "a" is evaluated, it still says:
'(1 2 3 4 5)
What do I have to do for this?????
You cannot use set! for this. You need to use set-car! on the cons cell you're changing. Here's how you might write it:
(define (map! f lst)
(let loop ((rest lst))
(unless (null? rest)
(set-car! rest (f (car rest)))
(loop (cdr rest)))))
If you have SRFI 1, it's even easier (if we ignore for a moment that SRFI 1 already defines map! ;-)):
(define (map! f lst)
(pair-for-each (lambda (pair)
(set-car! pair (f (car pair))))
lst))
The function "greaterthan", (< NUM1 NUM2), allows only for returning t/nil for comparing 2 values.
I would like to test (var1 > var2 < var3 < var4), is there any way to do that using only one function in lisp? If not, what is the best procedure?
The best procedure is not to bother: (and (< var2 var1) (< var2 var3) (< var3 var4)) is not harder to read that your ..>..<..<.. chain.
It makes sense to test for the ascending order:
(require 'cl)
(defun cl-< (&rest args)
(every '< args (cdr args))
These days I don't hesitate to (require 'cl) anymore, but if you do,
here is another variant:
(defun cl-< (arg &rest more-args)
(or (null more-args)
(and (< arg (first more-args))
(apply #'cl-< more-args))))
The following is a macro implementation for variadic <
(defmacro << (x y &rest args)
(if args
(if (or (symbolp y)
(numberp y))
`(and (< ,x ,y) (<< ,y ,#args))
(let ((ys (make-symbol "y")))
`(let (,ys)
(and (< ,x (setq ,ys ,y))
(<< ,ys ,#args)))))
`(< ,x ,y)))
for simple cases just expands to (and ...) chains
(<< x y z) ==> (and (< x y) (< y z))
where the expression is not a number and not a symbol expands to a more complex form to avoid multiple evaluations in presence of side effects
(<< (f x) (g y) (h z)) ==> (let ((gy)) (and (< (f x) (setq gy (g y)))
(< gy (h z))))
for example
(setq foo (list))
nil
(defun call (x) (push x foo) x)
call
(<< (call 1) (call 2) (call 5) (call 4) (call 0))
nil
foo
(4 5 2 1)
every function has been called once, except for 0 that didn't need to be called because of short circuiting (I'm not 100% sure if short circuiting is a really good idea or not... #'< in Common Lisp is a regular function with all arguments all evaluated exactly once in left-to-right order without short circuiting).
(defun << (arg1 arg2 arg3 arg4)
(when (and (< arg1 arg2) (< arg2 arg3) (< arg3 arg4)))
)
(<< 1 2 3 4)
Probably possible to extend with any amount of arguments, but such a general form would seem useful.
(defmacro << (&rest args)
(let ((first (car args))
(min (gensym))
(max (gensym))
(forms '(t)) iterator)
(setq args (reverse (cdr args))
iterator args)
`(let ((,min ,first) ,max)
,(or
(while iterator
(push `(setq ,min ,max) forms)
(push `(< ,min ,max) forms)
(push `(setq ,max ,(car iterator)) forms)
(setq iterator (cdr iterator))) `(and ,#forms)))))
(macroexpand '(<< 10 20 30 (+ 30 3) (* 10 4)))
(let ((G99730 10) G99731)
(and (setq G99731 20)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 30)
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (+ 30 3))
(< G99730 G99731)
(setq G99730 G99731)
(setq G99731 (* 10 4))
(< G99730 G99731)
(setq G99730 G99731) t))
This is the idea similar to 6502's, but it may create less code, in a less trivial situation, but it will create more code in a trivial situation.