I try to do a very simple thing in Lisp - to find a way to turn on a global valuable nodebug t and then some of debug format form would be silence. To do that, I found I cannot grasp the difference of the following:
(defparameter *nodebug* t)
(setf x 1)
;;; the basic function
(format t "x is ~a" x) ;;; generate -> x is 1
;;; try to use function not macro
(defun formatdf (stream string &rest allparm) ;;; later add (if ...
(format stream string allparm))
(formatdf t "x is ~a" x) ;;; generate -> x is (1)
;;; try to use macro
(defmacro formatdm (stream string &rest allparm) ;;; later add (if ...
(format stream string allparm))
(formatdm t "x is ~a" x) ;;; generate -> x is (X)
It seems the generated code (or the function one) is not the same as the original format form. What should be my next step?
(defmacro formatdm (stream string &rest allparm) ;;; later add (if ...
(format stream string allparm))
A macro should return source code, not execute. Here it is only useful to see what the value of allparm is at macro expansion time. It is a part of the source code: (x).
You need to return a list with the necessary instructions - here the code to call format.
This is a very good book about Lisp, which also should explain the basics of macros: http://www.cs.cmu.edu/~dst/LispBook/
The problem of your "function one" is that you pass &rest parameter to the format function as is. Passing x to formatdf results in the creating a list containing one parameter, that is bound to allparm.
So if you want to just print the first parameter you should write:
(formatdf t "x is ~a" (car x))
or fix format inside formatdf in the next way:
(apply #'format stream string allparm)
(defparameter nodebug t)
(setf x 1)
(format t "x is ~a" x) ;;; generate -> x is 1
;;; to generate the same and prepare for nodebug version, the following is needed:
;;; using defmacro
(defmacro formatdmadv (stream string &rest allparm)
`(format ,stream ,string ,#allparm))
(formatdmadv t "formatdmadv x is ~a" x) ;;; generate -> x is 1 <-- macro correct
;;; or using defun as suggested
(formatdf_car t "formatdf_car x is ~a" x) ;;; generate -> x is 1 <-- fun correct
(defun formatdf (stream string &rest allparm)
(apply #'format (list* stream string allparm)))
(formatdf t "formatdf using apply x is ~a" x) ;;; generate -> x is 1 <-- fun correct
;;; ---- the below is incorrect
(defun formatdf_err (stream string &rest allparm) (format stream string allparm))
(formatdf_err t "formatdf_err: x is ~a" x) ;;; generate -> x is (1)
(defun formatdf_car (stream string &rest allparm)
(format stream string (car allparm)))
(defmacro formatdm (stream string &rest allparm)
(format stream string allparm))
(formatdm t "formatdm x is ~a" x) ;;; generate -> x is (X)
;;; ----- test confirming the findings
(pprint (macroexpand-1 '(formatdm t "formatdm x is ~a" x)))
(pprint (macroexpand '(formatdm t "formatdm x is ~a" x)))
(pprint (macroexpand-1 '(formatdm t "formatdm b" c)))
;;; --- incorrect one and do not even generate the source code even
(pprint (macroexpand-1 '(formatdmadv t "formatdmadv x is ~a" x)))
(pprint (macroexpand '(formatdmadv t "formatdmadv x is ~a" x)))
(pprint (macroexpand-1 '(formatdmadv t "formatdmadv b" c)))
Related
Emacs-lisp is default using call-by-value, but I'm trying use its symbol mechanism to simulate call-by-reference.
For example,
(setq lexical-binding nil)
(defun cbr (x)
(message "cbr (symbol-name x) %s" (symbol-name x))
(message "cbr (symbol-value x) %s" (symbol-value x))
(set x 2))
(let ((a 1))
(cbr 'a)
a)
;; cbr (symbol-name x) a
;; cbr (symbol-value x) 1
;; 2
It works well, because the result of let expression is 2, so it is indeed the call-by-reference behavior.
However, if I change the name from a to x:
(let ((x 1))
(cbr 'x)
x)
;; cbr (symbol-name x) x
;; cbr (symbol-value x) x
;; 1
Now it doesn't work as expected anymore.
Why?
Notice that it even can not get the correct symbol-name in cbr.
I think I have known what happen.
The second program returns 1, because the symbol x is captured by cbr's param x. When the body of cbr is evaluated, there are two bindings in the environment: one is the let binding x = 1, the other is x = x which is created by cbr's application. The symbol x in the (set x 2) uses the later one.
A workaround of this question is:
(let ((gen-x (gensym)))
(set gen-x 1)
(cbr gen-x)
(symbol-value gen-x))
;; cbr (symbol-name x) g36
;; cbr (symbol-value x) 1
;; 2
What should be clear from this is that relying on dynamic scope and symbol-value is a disaster: you need gensyms all over the place. Relying on dynamic scope for anything is generally a disaster, except in the specific, rare but extremely useful, case where you actually want dynamic scope.
But solving this problem trivial, even in elisp, with lexical scope. Here is one simple approach:
(defmacro ref (form)
;; Construct a reference to a form
(unless lexical-binding
(error "doomed"))
(let ((<setting> (gensym)))
`(lambda (&rest ,<setting>) ;hack for &optional (v nil vp)
(cond
((null ,<setting>)
,form)
((null (cdr ,<setting>))
(setf ,form (car ,<setting>)))
(t
(error "mutant"))))))
(defun ref-value (ref)
(funcall ref))
(defun set-ref-value (ref value)
;; should be (setf ref-value), but elisp
(funcall ref value))
And now, for instance, given:
(defun outer (v)
(let ((x 1))
(princ (format "x is first %s\n" x))
(inner (ref x) v)
(princ (format "and x is now %s\n" x))
x))
(defun inner (ref v)
(princ (format " ref is first %s\n" (ref-value ref)))
(set-ref-value ref v)
(princ (format " and ref is now %s\n" (ref-value ref))))
Then
ELISP> (outer 4)
x is first 1
ref is first 1
and ref is now 4
and x is now 4
4 (#o4, #x4, ?\C-d)
I found myself calling lots of methods whose first argument is a complex object from a given class.
Whilst with-slots and with-accessors are useful, generic methods cannot be bound in this way. So I thought: if we could locally curry any functions, slots + accessors + generic functions + functions could all be addressed with the same construct.
Example of code I want to clean up:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(loop while (and (char/= #\" (peek scanner))
(not (at-end-p scanner)))
do
(if (char= #\Newline (peek scanner)) (incf (line scanner))
(advance scanner)))
(when (at-end-p scanner)
(clox.error::clox-error (line scanner) "Unterminated string.")
(return-from clox-string nil))
(advance scanner) ;; consume closing "
(add-token scanner 'STRING (subseq (source scanner)
(1+ (start scanner))
(1- (current scanner)))))
This would be cleaner (I'm imitating this in CL https://craftinginterpreters.com/scanning.html#reserved-words-and-identifiers but I often end up with more verbose and less readable code than in Java - specially when using this classes a lot). As in CL methods don't belong to classes you end up declaring such arguments over and over. This would be a bit better:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(let-curry scanner (peek at-end-p line source start current advance add-token)
(loop while (and (char/= #\" (peek))
(not (at-end-p)))
do
(if (char= #\Newline (peek)) (incf (line))
(advance)))
(when (at-end-p)
(clox.error::clox-error (line) "Unterminated string.")
(return-from clox-string nil))
(advance) ;; consume closing "
(add-token 'STRING (subseq (source)
(1+ (start))
(1- (current)))))
sketch of macro (not working):
;; Clearly not as I don't understand macros very well :) non-working code:
(defmacro let-curry (obj functions &body body)
"Locally curry all functions"
(let ((fn (gensym)))
`(flet (loop
for ,fn in ,functions
collect (list ,fn (&rest args)
(funcall ,fn ,obj args)))
,#body)))
EDIT (ADD): Notice that scanner is a class; start, source, line, etc., accessors to the slots with the same name; add-token a generic function of more than one argument, advance a generic method of one argument:
(defclass scanner ()
((source
:initarg :source
:accessor source)
...
(...)))
(defmethod advance ((scanner scanner)) ...)
(defmethod add-token ((scanner scanner) token-type) ...)
Simpler Example with error:
;; With
(defun add (x y) (+ x y))
(defun mul (x y) (* x y))
;; I want to have this:
(let-curry 1000 (add mul)
(print (add 3))
(print (mul 3)))
;; expanding to:
(flet ((add (y) (add 1000 y))
(mul (y) (mul 1000 y)))
(print (add 3))
(print (mul 3)))
;; but instead I'm getting:
Execution of a form compiled with errors.
Form:
(FLET (LOOP
FOR
#1=#:G777
IN
(ADD MUL
)
COLLECT
(LIST #1#
(&REST ARGS)
(FUNCALL #1# 1000 ARGS)))
(PRINT (ADD 3))
(PRINT (MUL 3)))
Compile-time error:
The FLET definition spec LOOP is malformed.
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Thanks! The basic question is: is it possible to make such macro work?
Your version didn't expand to what you wanted but:
(flet (loop for #:g8307 in (add mul) collect (list #:g8307 (&rest args) (funcall #:g8307 1000 args)))
(print (add 3)) (print (mul 3)))
Now the loop needs to be done at macro expansion time.
Here is a working version:
(defmacro let-curry (obj (&rest functions) &body body)
"Locally curry all functions"
`(flet ,(loop for fn in functions
collect `(,fn (&rest args)
(apply #',fn ,obj args)))
,#body))
;; test it using add and mul from OP
(macroexpand-1 '(let-curry 10 (add mul) (list (add 5) (mul 5))))
;; ==>
(flet ((add (&rest args) (apply #'add 10 args))
(mul (&rest args) (apply #'mul 10 args)))
(list (add 5) (mul 5)))
(let-curry 10 (add mul) (list (add 5) (mul 5)))
;; ==> (15 50)
Using gensym is only needed if you are in danger of shadowing/colliding something or to ensure evaluation order is least surprising, but in your case you actually want to shadow the original names with the curried version so it makes sense to just use the original name.
If you want to have more than one argument you should use apply
since you know the function is in the function namespace you need to call #'symbol instead of symbol.
I've done (&rest functions) instead of functions in the prototype that with bad usage (not a list) you get a compile time error and it is more preciese.
I'm trying to create a simple memo defun. How can I prevent evaluating of args form in this code?
(defmacro defun/memo (name args &rest body)
`(let ((memo (make-hash-table :test 'equalp)))
(defun ,name ,args
(if (gethash (loop for x in ,args collect x) memo)
(gethash (loop for x in ,args collect x) memo)
(let ((result (progn ,#body)))
(setf (gethash (loop for x in ,args collect x) memo) result)
result)))))
Error:
; in: DEFUN ADD
; (X Y)
;
; caught STYLE-WARNING:
; undefined function: X
;
; compilation unit finished
; Undefined function:
; X
(defmacro defun/memo (name args &rest body)
You generally declare body with &body body, not &rest body.
Variable capture
`(let ((memo (make-hash-table :test 'equalp)))
The memo symbol is going to end in the generated code. If body contains references to memo, for example a symbol that was lexically bound outside of a call to defun/memo, then it will use your variable. You should use a fresh symbol instead, generated inside the macro with gensym (outside of backquotes). For example, you could do the following to avoid evaluating expr twice:
(let ((var-expr (gensym)))
`(let ((,var-expr ,expr))
(+ ,var-expr ,var-expr)))
Loop
(if (gethash (loop for x in ,args collect x) memo)
(gethash (loop for x in ,args collect x) memo)
(let ((result (progn ,#body)))
(setf (gethash (loop for x in ,args collect x) memo) result)
result)))))
What is the following supposed to do?
(loop for x in ,args collect x)
Let's say you define a function with (defun/memo test (a b c) ...), you will inject the literal list of arguments in the above, which will result in code that contains:
(loop for x in (a b c) collect x)
As you saw, the code is now trying to call function a with arguments b and c.
What if you quoted args, in your macro?
(loop for x in ',args collect x)
Then, you would obtain:
(loop for x in '(a b c) collect x)
And now, you are just copying a literal list. When the above generated code is run, it will only build a fresh list (a b c). Is that what you need?
What you want is to take all the arguments of your function, i.e. the list of values you were given. The loop could be replaced by:
(list ,#args)
Which would expand as:
(list a b c)
And here you have all your values, in a list.
But Common Lisp already provides a way to get all arguments as a list:
(defun foo (&rest args)
;; args is bound to a list of values
)
Your generated function could do the same.
Gethash
Also, (if (gethash ...) (gethash ...) other) can be written (or (gethash ...) other). This has the benefits of evaluating the call to gethash only once.
More importantly (thanks #Sylwester), since you are writing a generic macro, you cannot know in advance if nil will be a possible returned value. Having a nil value would make the result recomputed each time, given how the if/or is written. You need to use the secondary return value from gethash to check if the element existed:
(multiple-value-bind (value exists-p) (gethash ...)
(if exists-p
value
(setf (gethash ...) ...)))
Also, if your cached function return multiple values, you may want to grab them all with multiple-value-list and returns them with values-list.
Setf
By the way, the following code:
(let ((result expr))
(setf place result)
result)
... has little reason not to be written as:
(setf place expr)
The return value of setf is required to be the new value. In some cases it could lead to bad style, but here that would be fine.
I'm trying to understand the following two snippets of code:
(defun make-adder1 (n) `(lambda (x) (+ ,n x)))
(defun make-adder2 (n) (lexical-let ((n n)) (lambda (x) (+ n x))))
These both seem to produce callables:
(funcall (make-adder1 3) 5) ;; returns 8
(funcall (make-adder2 3) 5) ;; returns 8
These both work. I have two main questions:
1) I don't understand the disparity in "quoting level" between the two approaches. In the first case, the lambda expression is quoted, which means the "symbol itself" is returned instead of the value. In the second case, it seems like the statement with the lambda will get evaluated, so the value of the lambda will be returned. Yet, these both work with funcall. When using funcall on a defun'ed function, it has to be quoted. Is lexical-let doing some kind of quoting automatically? Isn't this, kind of surprising?
2) Reading other posts on this topic, I'm given to understand that the first approach will break down under certain circumstances and deviate from what one would expect from working with lambdas and higher order functions in other languages, because elisp has dynamic scoping by default. Can someone give a concrete example of code that makes this difference apparent and explain it?
In the first example there is no variable n in the resulting function, which is just (lambda (x) (+ 3 x)). It does not need lexical binding because there is no free variable in the lambda, i.e., no variable that needs to be kept in a binding of a closure. If you don't need the variable n to be available, as a variable in uses of the function, i.e., if its value at function definition time (=3) is all you need, then the first example is all you need.
(fset 'ad1 (make-adder1 3))
(symbol-function 'ad1)
returns:
(lambda (x) (+ 3 x))
The second example creates what is, in effect, a function that creates and applies a complicated closure.
(fset 'ad2 (make-adder2 3))
(symbol-function 'ad2)
returns
(lambda (&rest --cl-rest--)
(apply (quote (closure ((--cl-n-- . --n--) (n . 3) t)
(G69710 x)
(+ (symbol-value G69710) x)))
(quote --n--)
--cl-rest--))
A third option is to use a lexical-binding file-local variable and use the most straightforward definition. This creates a simple closure.
;;; foo.el --- toto -*- lexical-binding: t -*-
(defun make-adder3 (n) (lambda (x) (+ n x)))
(fset 'ad3 (make-adder3 3))
(symbol-function 'ad3)
returns:
(closure ((n . 3) t) (x) (+ n x))
(symbol-function 'make-adder1)
returns:
(lambda (n)
(list (quote lambda)
(quote (x))
(cons (quote +) (cons n (quote (x))))))
(symbol-function 'make-adder2)
returns:
(closure (t)
(n)
(let ((--cl-n-- (make-symbol "--n--")))
(let* ((v --cl-n--)) (set v n))
(list (quote lambda)
(quote (&rest --cl-rest--))
(list (quote apply)
(list (quote quote)
(function
(lambda (G69709 x)
(+ (symbol-value G69709) x))))
(list (quote quote) --cl-n--)
(quote --cl-rest--)))))
(symbol-function 'make-adder3)
returns
(closure (t) (n) (function (lambda (x) (+ n x))))
When I compile the following code, SBCL complains that g!-unit-value and g!-unit are undefined. I'm not sure how to debug this. As far as I can tell, flatten is failing.
When flatten reaches the unquoted part of defunits, it seems like the entire part is being treated as an atom. Does that sound correct?
The following uses code from the book Let over Lambda:
Paul Graham Utilities
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (a args) (princ a s))))
(defun group (source n)
(if (zerop n) (error "zero length"))
(labels ((rec (source acc)
(let ((rest (nthcdr n source)))
(if (consp rest)
(rec rest (cons (subseq source 0 n) acc))
(nreverse (cons source acc))))))
(if source (rec source nil) nil)))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
Let Over Lambda Utilities - Chapter 3
(defmacro defmacro/g! (name args &rest body)
(let ((g!-symbols (remove-duplicates
(remove-if-not #'g!-symbol-p
(flatten body)))))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (g!-symbol)
`(,g!-symbol (gensym ,(subseq
(symbol-name g!-symbol)
2))))
g!-symbols)
,#body))))
(defun g!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro! (name args &rest body)
(let* ((o!-symbols (remove-if-not #'o!-symbol-p args))
(g!-symbols (mapcar #'o!-symbol-to-g!-symbol o!-symbols)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,#g!-symbols) (list ,#o!-symbols))
,(progn ,#body)))))
(defun o!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"O!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (o!-symbol)
(symb "G!" (subseq (symbol-name o!-symbol) 2)))
Let Over Lambda - Chapter 5
(defun defunits-chaining (u units prev)
(if (member u prev)
(error "~{ ~a~^ depends on~}"
(cons u prev)))
(let ((spec (find u units :key #'car)))
(if (null spec)
(error "Unknown unit ~a" u)
(let ((chain (second spec)))
(if (listp chain)
(* (car chain)
(defunits-chaining
(second chain)
units
(cons u prev)))
chain)))))
(defmacro! defunits (quantity base-unit &rest units)
`(defmacro ,(symb 'unit-of- quantity)
(,g!-unit-value ,g!-unit)
`(* ,,g!-unit-value
,(case ,g!-unit
((,base-unit) 1)
,#(mapcar (lambda (x)
`((,(car x))
,(defunits-chaining
(car x)
(cons
`(,base-unit 1)
(group units 2))
nil)))
(group units 2))))))
This is kind of tricky:
Problem: you assume that backquote/comma expressions are plain lists.
You need to ask yourself this question:
What is the representation of a backquote/comma expression?
Is it a list?
Actually the full representation is unspecified. See here: CLHS: Section 2.4.6.1 Notes about Backquote
We are using SBCL. See this:
* (setf *print-pretty* nil)
NIL
* '`(a ,b)
(SB-INT:QUASIQUOTE (A #S(SB-IMPL::COMMA :EXPR B :KIND 0)))
So a comma expression is represented by a structure of type SB-IMPL::COMMA. The SBCL developers thought that this representation helps when such backquote lists need to be printed by the pretty printer.
Since your flatten treats structures as atoms, it won't look inside...
But this is the specific representation of SBCL. Clozure CL does something else and LispWorks again does something else.
Clozure CL:
? '`(a ,b)
(LIST* 'A (LIST B))
LispWorks:
CL-USER 87 > '`(a ,b)
(SYSTEM::BQ-LIST (QUOTE A) B)
Debugging
Since you found out that somehow flatten was involved, the next debugging steps are:
First: trace the function flatten and see with which data it is called and what it returns.
Since we are not sure what the data actually is, one can INSPECT it.
A debugging example using SBCL:
* (defun flatten (x)
(inspect x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
STYLE-WARNING: redefining COMMON-LISP-USER::FLATTEN in DEFUN
FLATTEN
Above calls INSPECT on the argument data. In Common Lisp, the Inspector usually is something where one can interactively inspect data structures.
As an example we are calling flatten with a backquote expression:
* (flatten '`(a ,b))
The object is a proper list of length 2.
0. 0: SB-INT:QUASIQUOTE
1. 1: (A ,B)
We are in the interactive Inspector. The commands now available:
> help
help for INSPECT:
Q, E - Quit the inspector.
<integer> - Inspect the numbered slot.
R - Redisplay current inspected object.
U - Move upward/backward to previous inspected object.
?, H, Help - Show this help.
<other> - Evaluate the input as an expression.
Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
to the current inspected object, so that it can be referred to in
evaluated expressions.
So the command 1 walks into the data structure, here a list.
> 1
The object is a proper list of length 2.
0. 0: A
1. 1: ,B
Walk in further:
> 1
The object is a STRUCTURE-OBJECT of type SB-IMPL::COMMA.
0. EXPR: B
1. KIND: 0
Here the Inspector tells us that the object is a structure of a certain type. That's what we wanted to know.
We now leave the Inspector using the command q and the flatten function continues and returns a value:
> q
(SB-INT:QUASIQUOTE A ,B)
For anyone else who is trying to get defmacro! to work on SBCL, a temporary solution to this problem is to grope inside the unquote structure during the flatten procedure recursively flatten its contents:
(defun flatten (x)
(labels ((flatten-recursively (x flattening-list)
(cond ((null x) flattening-list)
((eq (type-of x) 'SB-IMPL::COMMA) (flatten-recursively (sb-impl::comma-expr x) flattening-list))
((atom x) (cons x flattening-list))
(t (flatten-recursively (car x) (flatten-recursively (cdr x) flattening-list))))))
(flatten-recursively x nil)))
But this is horribly platform dependant. If I find a better way, I'll post it.
In case anyone's still interested in this one, here are my three cents. My objection to the above modification of flatten is that it might be more naturally useful as it were originally, while the problem with representations of unquote is rather endemic to defmacro/g!. I came up with a not-too-pretty modification of defmacro/g! using features to decide what to do. Namely, when dealing with non-SBCL implementations (#-sbcl) we proceed as before, while in the case of SBCL (#+sbcl) we dig into the sb-impl::comma structure, use its expr attribute when necessary and use equalp in remove-duplicates, as we are now dealing with structures, not symbols. Here's the code:
(defmacro defmacro/g! (name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #-sbcl #'g!-symbol-p
#+sbcl #'(lambda (s)
(and (sb-impl::comma-p s)
(g!-symbol-p (sb-impl::comma-expr s))))
(flatten body))
:test #-sbcl #'eql #+sbcl #'equalp)))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (s)
`(#-sbcl ,s #+sbcl ,(sb-impl::comma-expr s)
(gensym ,(subseq
#-sbcl
(symbol-name s)
#+sbcl
(symbol-name (sb-impl::comma-expr s))
2))))
syms)
,#body))))
It works with SBCL. I have yet to test it thoroughly on other implementations.