I'm trying to fully understand the limitations of compile-time macros.
Here is a macro (I'm fully aware that this is not a best-practice macro):
(defmacro emit (language file &body body)
(print language)
(print file)
(print body)
(with-open-file (str file :direction :output :if-exists :supersede)
(princ (cond ((eq language 'html)
(cl-who:with-html-output-to-string (s nil :prologue t :indent t) body))
((eq language 'javascript)
(parenscript:ps body))
((eq language 'json)
(remove #\; (parenscript:ps body))))
str)))
I compile the macro:
; processing (DEFMACRO EMIT ...)
PROGRAM>
I compile this form:
PROGRAM> (compile nil (lambda () (emit json "~/file" (ps:create "hi" "hello") (ps:create "yo" "howdy"))))
JSON
"~/file"
((PARENSCRIPT:CREATE "hi" "hello") (PARENSCRIPT:CREATE "yo" "howdy"))
#<FUNCTION (LAMBDA ()) {5367482B}>
NIL
NIL
PROGRAM>
The compile-time print output is what I expect.
However, if I look at ~/file:
body
It appears that ((PARENSCRIPT:CREATE "hi" "hello") (PARENSCRIPT:CREATE "yo" "howdy")) was never substituted in for the parameter body, and thus never processed.
Why is this?
& what would be the best literature to read on this subject?
Why should it substitute? You never substituted anything.
A macro defines a macro substitution function, which is applied to the actual form in the code to produce another form which is then compiled. When you apply your macro definition to those parameters, it will at macroexpansion time do all kinds of things (write a file etc.) before returning what princ returned, which is exactly its first argument, and this returned form is then compiled. I don't think that is what you want.
It seems that what you actually want to do is to expand to a form that interprets the body in one of a variety of ways, indicated by the first argument.
What you need to do is to return the new form, so that
(emit 'html "foo.html"
(:html (:head) (:body "whatever")))
expands to
(with-open-file (str "foo.html" :direction :output :etc :etc)
(cl-who:with-html-output (str)
(:html (:head) (:body "whatever")))
For that, we have a template syntax: the backtick.
`(foo ,bar baz)
means the same as
(list 'foo bar 'baz)
but makes the structure of transformed code a bit clearer. There is also ,# to splice things into a list.
`(foo ,#bar)
means the same as
(list* 'foo bar)
i. e. the contents of bar, when they are a list, are spliced into the list. This is especially useful for bodies such as in your macro.
(defmacro emit (language file &body body)
`(with-open-file (str ,file :direction :output :if-exists :supersede)
(princ (cond ((eq ,language 'html)
(cl-who:with-html-output-to-string (s nil :prologue t :indent t)
,#body))
((eq ,language 'javascript)
(parenscript:ps ,#body))
((eq ,language 'json)
(remove #\; (parenscript:ps ,#body))))
str)))
Note where I introduced the backtick to create a template and commata to put outer arguments into it. Note also that the arguments are forms.
This has a few problems: there are hardcoded symbols that the user of the macro has no way of knowing. In one case (str) they have to pay attention not to shadow it, in the other (s) they have to know it in order to write to it. For this, we use either generated symbols (for str so that there is no conflict possible) or let the user say what they want to name it (for s). Also, this cond can be simplified to a case:
(defmacro emit (language file var &body body)
(let ((str (gensym "str")))
`(with-open-file (,str ,file
:direction :output
:if-exists :supersede)
(princ (case ,language
('html
(cl-who:with-html-output-to-string (,var nil
:prologue t
:indent t)
,#body))
('javascript
(parenscript:ps ,#body))
('json
(remove #\; (parenscript:ps ,#body))))
,str)))
However, you might want to determine the output code already at macro expansion time.
(defmacro emit (language file var &body body)
(let ((str (gensym "str")))
`(with-open-file (,str ,file
:direction :output
:if-exists :supersede)
(princ ,(case language
('html
`(cl-who:with-html-output-to-string (,var nil
:prologue t
:indent t)
,#body))
('javascript
`(parenscript:ps ,#body))
('json
`(remove #\; (parenscript:ps ,#body))))
,str)))
Here, you can see that the case form is already evaluated at macro expansion time, and an inner template is then used to create the inner form.
This is all completely untested, so removing the little errors is left as an exercise ^^.
One book that has a lot of things to say about macro writing is »On Lisp« by Paul Graham. The freely available »Practical Common Lisp« by Peter Seibel also has a chapter about it, and there are also some recipes in »Common Lisp Recipes« by Edi Weitz.
parenscript:ps is a macro, not a function: its body is literal parenscript and is not evaluated but compiled, from Parenscript to JavaSctipt. This is easy to check:
> (parenscript:ps body)
"body;"
I don't have any advice on what you should read: this macro looks so utterly confused I can't really understand what the underlying intent was. A macro in CL is a function which whose argument is source code in some language L1 and which returns source code in some language L2, where L2 is usually a subset of L1. I can't work out, though, if this is just the normal case of someone thinking they need a macro when they need a function, or if it's some other confusion.
Related
I'm learning common lisp. I have written a version of the once-only macro, which suffers from an unusual variable capture problem.
My macro is this:
(defmacro my-once-only (names &body body)
(let ((syms (mapcar #'(lambda (x) (gensym))
names)))
``(let (,,#(mapcar #'(lambda (sym name) ``(,',sym ,,name))
syms names))
,(let (,#(mapcar #'(lambda (name sym) `(,name ',sym))
names syms))
,#body))))
The canonical version of only-once is this:
(defmacro once-only ((&rest names) &body body)
(let ((gensyms (loop for n in names collect (gensym))))
`(let (,#(loop for g in gensyms collect `(,g (gensym))))
`(let (,,#(loop for g in gensyms for n in names collect ``(,,g ,,n)))
,(let (,#(loop for n in names for g in gensyms collect `(,n ,g)))
,#body)))))
The difference, as far as I can tell, is that the canonical version generates new symbols for every expansion of the macro using only-once. For example:
CL-USER> (macroexpand-1 '(once-only (foo) foo))
(LET ((#:G824 (GENSYM)))
`(LET (,`(,#:G824 ,FOO))
,(LET ((FOO #:G824))
FOO)))
T
CL-USER> (macroexpand-1 '(my-once-only (foo) foo))
`(LET (,`(,'#:G825 ,FOO))
,(LET ((FOO '#:G825))
FOO))
T
The variable my macro uses to store the value of foo is the same for every expansion of this form, in this case it would be #:G825. This is akin to defining a macro like the following:
(defmacro identity-except-for-bar (foo)
`(let ((bar 2))
,foo))
This macro captures bar, and this capture manifests when bar is passed to it, like so:
CL-USER> (let ((bar 1))
(identity-except-for-bar bar))
2
However, I cannot think of any way to pass #:G825 to a macro that uses my-only-once so that it breaks like this, because the symbols gensym returns are unique, and I cannot create a second copy of it outside of the macro. I assume that capturing it is unwanted, otherwise the canonical version wouldn't bother adding the additional layer of gensym. How could capturing a symbol like #:G826 be a problem? Please provide an example where this capture manifests.
We can demonstrate a behavioral difference between my-once-only and once-only:
Let's store our test form in a variable.
(defvar *form* '(lexalias a 0 (lexalias b (1+ a) (list a b))))
This test form exercises a macro called lexalias, which we will define in two ways. First with once-only:
(defmacro lexalias (var value &body body)
(once-only (value)
`(symbol-macrolet ((,var ,value))
,#body)))
(eval *form*) -> (0 1)
Then with my-once-only:
(defmacro lexalias (var value &body body)
(my-once-only (value)
`(symbol-macrolet ((,var ,value))
,#body)))
(eval *form*) -> (1 1)
Oops! The problem is that under my-once-only, both a and b end up being symbol-macrolet aliases for exactly the same gensym; the returned expression (list a b) ends up being something like (list #:g0025 #:g0025).
If you're writing a macro-writing helper that implements once-only evaluation, you have no idea how the symbol is going to be used by the code which calls the macro, whose author uses your once-only tool. There are two big unknowns: the nature of the macro and of its use.
As you can see, if you don't make fresh gensyms, it will not work correctly in all conceivable scenarios.
I tried to wrap a lisp expression by another lisp expression. I guess, a macro should do it, but I don't get the trick. Can someone help me, who knows how to do it?
My actual aim is to write a macro which wraps a batch of with-open-file expressions around some macro-body code.
(I want to write a script/program, which opens one or two input files, process them line by line, but also outputs the processing result in several different independent output files. For that I would love to have the with-open-file macro calls piled up around the code which processes and writes to the independent output files - all opened for the macro-body code).
Since the with-open-file requires a symbol (handler) for the input or output stream and the path variable to the output (or input) file, and some additional information (direction of the file etc.), I want to put them into lists.
;; Output file-paths:
(defparameter *paths* '("~/out1.lisp" "~/out2.lisp" "~/out3.lisp"))
;; stream handlers (symbols for the output streams)
(defparameter *handlers* '(out1 out2 out3))
;; code which I would love to execute in the body
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)
How I would love the macro to be called:
(with-open-files (*handlers* *paths* '(:direction :output :if-exists :append))
;; the third macro argument should be what should be passed to the
;; individual `with-open-file` calls
;; and it might be without `quote`-ing or with `quote`-ing
;; - is there by the way a good-practice for such cases? -
;; - is it recommended to have `quote`-ing? Or how would you do that? -
;; and then follows the code which should be in the macro body:
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))
To what the macro call should expand:
(with-open-file (out1 "~/out1.lisp" :direction :output :if-exists :append)
(with-open-file (out2 "~/out2.lisp" :direction :output :if-exists :append)
(with-open-file (out3 "~/out3.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3))))
As one step, I thought I have to make an s-expression wrap another s-expression.
My first question was: How to wrap an s-expression by another s-expression? But I just couldn't manage it already at this point.
All I could do was to write a function which just spills out an un-executed expression. How to write a macro which does the same but also executes the code after expanding it in this way?
(defun wrap (s-expr-1 s-expr-2)
(append s-expr-1 (list s-expr-2)))
(wrap '(func1 arg1) '(func2 arg2))
;; => (FUNC1 ARG1 (FUNC2 ARG2))
(wrap '(with-open-files (out1 "~/out1.lisp" :direction :output :if-exists :append))
'(with-open-files (out2 "~/out2.lisp" :direction :output :if-exists :append)
(print "something1" out1)
(print "something2" out2)
(print "something3" out3)))
Which gives:
(WITH-OPEN-FILES (OUT1 "~/out1.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(WITH-OPEN-FILES (OUT2 "~/out2.lisp" :DIRECTION :OUTPUT :IF-EXISTS :APPEND)
(PRINT "something1" OUT1)
(PRINT "something2" OUT2)
(PRINT "something3" OUT3)))
In this way, applying wrap function successively, looping over the input-lists, I could build the code maybe ...
However, these functions would generate only code but don't execute it.
And I would be forced at the end to use the eval function to evaluate the built code ... (But somehow I know this shouldn't be done like this. And I just didn't really understood how to write macros which do such things ... Actually, macros are there for solving exactly such problems ... )
With the execution, I just came into big trouble. And since one cannot call funcall or apply on macros (instead of function-names) I don't see an obvious solution. Did someone had experience with such kind of situations?
And when accomplished wrapping an s-expression in a macro by another s-expression and let it be evaluated, the next question would be, how to process the list to let the code to expand to the desired code and then be evaluated? I just tried hours and didn't came far.
I need help from someone who has experience to write such kind of macros ...
Please note that in Lisp, "handler" is normally a function, not a symbol. Your naming is confusing.
Static
If you are generating code, you should use macros, not functions.
This assumes that you know at compile time what files and stream
variable you will use:
The simplest approach is to use recursion:
(defmacro with-open-files ((streams file-names &rest options &key &allow-other-keys) &body body)
(if (and streams file-names)
`(with-open-file (,(pop streams) ,(pop file-names) ,#options)
(with-open-files (,streams ,file-names ,#options)
,#body))
`(progn ,#body)))
Test:
(macroexpand-1
'(with-open-files ((a b c) ("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES ((B C) ("g" "h") :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A) (PRINT "b" B) (PRINT "c" C)))
(macroexpand-1
'(with-open-files ((a) ("f") :direction :output :if-exists :supersede)
(print "a" a)))
==>
(WITH-OPEN-FILE (A "f" :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(WITH-OPEN-FILES (NIL NIL :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE)
(PRINT "a" A)))
(macroexpand-1
'(with-open-files (nil nil :direction :output :if-exists :supersede)
(print nil)))
==>
(PROGN (PRINT NIL))
Dynamic
If you do not know at compile time what the streams and files are, e.g.,
they are stored in the *handler* variable, you cannot use the simple
macro above - you will have to roll your own using
progv for binding and
gensym to avoid variable
capture. Note how the let inside backtick avoids multiple
evaluation (i.e., arguments streams, file-names and options are to
be evaluated once, not multiple times):
(defmacro with-open-files-d ((streams file-names &rest options &key &allow-other-keys) &body body)
(let ((sv (gensym "STREAM-VARIABLES-"))
(so (gensym "STREAM-OBJECTS-"))
(ab (gensym "ABORT-"))
(op (gensym "OPTIONS-")))
`(let* ((,sv ,streams)
(,ab t)
(,op (list ,#options))
(,so (mapcar (lambda (fn) (apply #'open fn ,op)) ,file-names)))
(progv ,sv ,so
(unwind-protect (multiple-value-prog1 (progn ,#body) (setq ,ab nil))
(dolist (s ,so)
(when s
(close s :abort ,ab))))))))
(macroexpand-1
'(with-open-files-d ('(a b c) '("f" "g" "h") :direction :output :if-exists :supersede)
(print "a" a)
(print "b" b)
(print "c" c)))
==>
(LET* ((#:STREAM-VARIABLES-372 '(A B C))
(#:ABORT-374 T)
(#:OPTIONS-375 (LIST :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE))
(#:STREAM-OBJECTS-373
(MAPCAR (LAMBDA (FN) (APPLY #'OPEN FN #:OPTIONS-375)) '("f" "g" "h"))))
(PROGV
#:STREAM-VARIABLES-372
#:STREAM-OBJECTS-373
(UNWIND-PROTECT
(MULTIPLE-VALUE-PROG1 (PROGN (PRINT "a" A) (PRINT "b" B) (PRINT "c" C))
(SETQ #:ABORT-374 NIL))
(DOLIST (S #:STREAM-OBJECTS-373)
(WHEN S
(CLOSE S :ABORT #:ABORT-374))))))
Here both stream variables and file list are evaluated at run time.
Important
An important practical note here is that the static version is more robust in that it guarantees that all streams are closed, while the dynamic version will fail to close remaining streams if, say, the first close raises an exception (this can be fixed, but it is not trivial: we cannot just ignore-errors because they should in fact be reported, but which error should be reported? &c &c).
Another observation is that if your list of stream variables is not known at compile time, the code in the body that uses them will not be compiled correctly (the variables will be compiled with dynamic binding &c) indicated by undefined-variable compile-time warnings.
Basically, the dynamic version is an exercise in macrology, while the static version is what you should use in practice.
Your specific case
If I understood your requirements correctly, you can do something like
this (untested!):
(defun process-A-line (line stream)
do something with line,
stream is an open output stream)
(defun process-file (input-file processors)
"Read input-file line by line, calling processors,
which is a list of lists (handler destination ...):
handler is a function like process-A-line,
destination is a file name and the rest is open options."
(with-open-file (inf input-file)
(let ((proc-fd (mapcar (lambda (p)
(cons (first p)
(apply #'open (rest p))))
processors))
(abort-p t))
(unwind-protect
(loop for line = (read-line inf nil nil)
while line
do (dolist (p-f proc-fd)
(funcall (car p-f) line (cdr p-f)))
finally (setq abort-p nil))
(dolist (p-f proc-fd)
(close (cdr p-f) :abort abort-p))))))
I'm writing a toy interpreter for a Lisp language, in which I have the following CL code:
(defun mal-list (&rest args)
(make-mal :type 'list
:value args))
(register-fun '|list| #'mal-list)
(defun mal-list? (arg)
(eq (mal-type arg) 'list))
(register-fun '|list?| #'mal-list?)
However, I'd rather simply write something like this:
(defmal list (&rest args)
(make-mal :type 'list
:value args))
(defmal list? (arg)
(eq (mal-type arg) 'list))
I tried to write a macro to do this, but I had problems with the symbols with the bars (I'm pretty confused as to what this is!). This is what I tried:
(defmacro defmal (name args &body body )
(let ((funsym (intern (format nil "~{~a~}" `(mal- ,name)))))
`(register-fun `|,name| (defun ,funsym ,args ,#body))))
which didn't work out, because `|,name| literaly meant |,name|, and not |list|
I'm guessing this is an XY problem, but I'm not sure how to approach this otherwise.
The |...| syntax is just one of the ways that the Lisp printer can print symbols that have characters in their name that need to be escaped (and that the reader can read symbols with those kinds of characters in their names):
(print (intern "foo"))
;=> |foo|
There are other ways, too, including escaping individual characters:
(print '|FOO|)
;=> FOO
(print '\f\o\o)
;=> |foo|
What you're trying to do is simply create a symbol whose name includes lower case letters. That's easy enough, as shown above. Part of your issue, though, is that you're getting as input a symbol whose name is full of capital letters, so you'll need to downcase first:
CL-USER> (symbol-name 'FOO)
;=> "FOO"
CL-USER> (intern (symbol-name 'FOO))
;=> FOO
CL-USER> (string-downcase (symbol-name 'FOO))
;=> "foo"
CL-USER> (intern (string-downcase (symbol-name 'FOO)))
;=> |foo|
In fact, because string-downcase takes string designators, not just strings, you can pass the symbol in directly:
CL-USER> (intern (string-downcase 'BaR))
;=> |bar|
So, after all that string processing, we can move to the macro.
It sounds like you're looking for something like this:
(defmacro defmal (name lambda-list &body body)
(let ((mal-name (intern (concatenate 'string "MAL-" (symbol-name name))))
(mal-norm (intern (string-downcase name))))
`(progn
(defun ,mal-name ,lambda-list
,#body)
(register-function ',mal-norm #',mal-name))))
CL-USER> (pprint (macroexpand-1 '(defmal list? (arg)
(eq (mal-type arg) 'list))))
(PROGN
(DEFUN MAL-LIST? (ARG) (EQ (MAL-TYPE ARG) 'LIST))
(REGISTER-FUNCTION '|list?| #'MAL-LIST?))
It's generally a good idea to avoid using format in generating symbol names, because the specific output can change, depending on other variables. E.g.:
(loop for case in '(:upcase :downcase :capitalize)
collect (let ((*print-case* case))
(format nil "~a" 'foo)))
;=> ("FOO" "foo" "Foo")
Instead, you can use concatenate with a string (or the symbol name of a symbol). Because the reader can also have different settings for case sensitivity, sometimes I'll even do (but not everyone likes this):
(concatenate 'string (symbol-name '#:mal-) (symbol-name name))
This way, if the reader does anything unusual (e.g., preserves case, so that the symbol name of mal- is "mal-), you can preserve it in your own generated symbol, too.
In addition to Joshua's detailed answer, consider using a function from the Alexandria library:
format-symbol is like format, but inside with-standard-io-syntax. Here, t stands for the current package and name is downcased:
(format-symbol t "mal-~(~A~)" name)
=> |mal-list|
symbolicate concatenates and interns in current package:
(symbolicate '#:mal- name)
You can end-up with either |MAL-LIST| or |mal-list| if your current readtable preserves case or not. For completeness, note that readtable-case can be set to the following values: :upcase, :downcase, :preserve or :invert (this one I find quite interesting).
Code that requires break statements or continue statements in other languages can be done with block & return-from or catch & throw in Common Lisp and Emacs Lisp. Then there is code that requires redo statements, or at least best written with redo. And redo statements don't have to be about loops. How can I do redo in Lisp?
If there was a redo equivalent in Lisp, I think it would work like this: special form with-redo which takes a symbol and forms, and redo which takes a symbol. The form (with-redo 'foo BODY-FORMS...) may contain (redo 'foo) in its BODY-FORMS, and (redo 'foo) transfers control back to the beginning of BODY-FORMS.
In Common Lisp:
(tagbody
start
(do-something)
(go start))
(dotimes (i some-list)
redo
(when (some-condition-p)
(go redo))
(some-more))
Rainer's answer illustrates the use of tagbody which is probably the easiest way to implement this kind of construct (a particular kind of goto, or unconditional jump). I thought it'd be nice to point out that if you don't want to use an explicit tagbody, or an implicit tagbody provided by one of the standard constructs, you can also create a with-redo just as you suggested. The only difference in this implementation is that we won't quote the tag, since they're not evaluted in tagbody, and being consistent with the other constructs is nice too.
(defmacro with-redo (name &body body)
`(macrolet ((redo (name)
`(go ,name)))
(tagbody
,name
,#body)))
CL-USER> (let ((x 0))
(with-redo beginning
(print (incf x))
(when (< x 3)
(redo beginning))))
1
2
3
; => NIL
Now this is actually a leaky abstraction, since the body could define other labels for the implicit tagbody, and could use go instead of redo, and so on. This might be desirable; lots of the built in iteration constructs (e.g., do, do*) use an implicit tagbody, so it might be OK. But, since you're also adding your own control flow operator, redo, you might want to make sure that it can only be used with tags defined by with-redo. In fact, while Perl's redo can be used with or without a label, Ruby's redo doesn't appear to allow a label. The label-less cases allow behavior of jumping back to the innermost enclosing loop (or, in our case, the innermost with-redo). We can address the leaky abstraction, as well as the ability to nest redos at the same time.
(defmacro with-redo (&body body)
`(macrolet ((redo () `(go #1=#:hidden-label)))
(tagbody
#1#
((lambda () ,#body)))))
Here we've defined a tag for use with with-redo that other things shouldn't know about (and can't find out unless they macroexpand some with-redo forms, and we've wrapped the body in a lambda function, which means that, e.g., a symbol in the body is a form to be evaluated, not a tag for tagbody. Here's an example showing that redo jumps back to the nearest lexically enclosing with-redo:
CL-USER> (let ((i 0) (j 0))
(with-redo
(with-redo
(print (list i j))
(when (< j 2)
(incf j)
(redo)))
(when (< i 2)
(incf i)
(redo))))
(0 0)
(0 1)
(0 2)
(1 2)
(2 2)
; => NIL
Of course, since you can define with-redo on your own, you can make the decisions about which design you want to adopt. Perhaps you like the idea of redo taking no arguments (and disguising a go with a secret label, but with-redo still being an implicit tagbody so that you can define other tags and jump to them with go; you can adapt the code here to do just that, too.
Some notes on implementation
This this answer has generated a few comments, I wanted to make a couple more notes about the implementation. Implementing with-redo with labels is pretty straightfoward, and I think that all the answers posted address it; the label-less case is a bit tricker.
First, the use of a local macrolet is a convenience that will get us warnings with redo is used outside of some lexically enclosing with-redo. E.g., in SBCL:
CL-USER> (defun redo-without-with-redo ()
(redo))
; in: DEFUN REDO-WITHOUT-WITH-REDO
; (REDO)
;
; caught STYLE-WARNING:
; undefined function: REDO
Second, the use of #1=#:hidden-label and #1# means that the go tag for redoing is an uninterned symbol (which lessens the likelihood that the abstraction leaks), but also is the same symbol across expansions of with-redo. In the following snippet tag1 and tag2 are the go-tags from two different expansions of with-redo.
(let* ((exp1 (macroexpand-1 '(with-redo 1 2 3)))
(exp2 (macroexpand-1 '(with-redo a b c))))
(destructuring-bind (ml bndgs (tb tag1 &rest rest)) exp1 ; tag1 is the go-tag
(destructuring-bind (ml bndgs (tb tag2 &rest rest)) exp2
(eq tag1 tag2))))
; => T
An alternative implementation of with-redo that uses a fresh gensym for each macroexpansion does not have this guarantee. For instance, consider with-redo-gensym:
(defmacro with-redo-gensym (&body body)
(let ((tag (gensym "REDO-TAG-")))
`(macrolet ((redo () `(go ,tag)))
(tagbody
,tag
((lambda () ,#body))))))
(let* ((exp1 (macroexpand-1 '(with-redo-gensym 1 2 3)))
(exp2 (macroexpand-1 '(with-redo-gensym a b c))))
(destructuring-bind (ml bndgs (tb tag1 &rest rest)) exp1
(destructuring-bind (ml bndgs (tb tag2 &rest rest)) exp2
(eq tag1 tag2))))
; => NIL
Now, it's worth asking whether this makes a practical difference, and if so, in which cases, and is it a difference for the better or the worse? Quite frankly, I'm not entirely sure.
If you were performing some complicated code manipulation after the inner macroexpansion of an (with-redo ...) form, form1, so that (redo) has already been turned into (go #1#), it means that moving the (go #1#) into the body of another (with-redo ...) form, form2, it will still have the effect of restarting an iteration in form2. In my mind, this makes it more like a return that could be transported from a block b1 into a different block b2, with the only difference it now returns from b2 instead of b1. I think that this is desirable, since we're trying to treat label-less with-redo and redo as primitive control structures.
Update: Emacs 24.4 (soon to be released) has tagbody. cl-lib that comes with Emacs 24.4 includes cl-tagbody.
For a dialect of Lisp which doesn't have tagbody, one can still implement redo as long as the dialect has a catch/throw equivalent.
For Emacs Lisp:
;; with-redo version 0.1
(defmacro with-redo (tag &rest body)
"Eval BODY allowing jumps using `throw'.
TAG is evalled to get the tag to use; it must not be nil.
Then the BODY is executed.
Within BODY, a call to `throw' with the same TAG and a non-nil VALUE causes a jump to the beginning of BODY.
A call to `throw' with the same TAG and nil as VALUE exits BODY and this `with-redo'.
If no throw happens, `with-redo' returns the value of the last BODY form."
(declare (indent 1))
(let ((ret (make-symbol "retval")))
`(let (,ret)
(while
(catch ,tag
(setq ,ret (progn ,#body))
nil))
,ret)))
(defun redo (symbol)
(throw symbol t))
Example of use (all examples are in Emacs Lisp):
(with-redo 'question
(let ((name (read-string "What is your name? ")))
(when (equal name "")
(message "Zero length input. Please try again.")
(beep)
(sit-for 1)
(redo 'question))
name))
Same example written as a mid-test loop instead:
(require 'cl-lib)
(let (name)
(cl-loop do
(setq name (read-string "What is your name? "))
while
(equal name "")
do
(message "Zero length input. Please try again.")
(beep)
(sit-for 1))
name)
Same example written as an infinite loop with a throw instead:
(let (name)
(catch 'question
(while t
(setq name (read-string "What is your name? "))
(unless (equal name "")
(throw 'question name))
(message "Zero length input. Please try again.")
(beep)
(sit-for 1))))
Implementing with-lex-redo-anon and lex-redo, where (lex-redo) causes a jump to the beginning of body of the textually/lexically innermost with-lex-redo-anon form:
;; with-lex-redo-anon version 0.1
(require 'cl-lib)
(defmacro with-lex-redo-anon (&rest body)
"Use with `(lex-redo)'."
(let ((tag (make-symbol "lex-redo-tag"))
(ret (make-symbol "retval")))
`(cl-macrolet ((lex-redo () '(cl-return-from ,tag t)))
(let (,ret)
(while
(cl-block ,tag
(setq ,ret (progn ,#body))
nil))
,ret))))
Example test:
(let ((i 0) (j 0))
(with-lex-redo-anon
(with-lex-redo-anon
(print (list i j))
(when (< j 2)
(incf j)
(lex-redo)))
(when (< i 2)
(incf i)
(lex-redo))))
Same output as in another answer.
One of the exercises in Paul Grahams ANSI Common Lisp book is this: Define a macro that takes a list of variables and a body of code, and ensures that the variables revert to their original values after the body of code is evaluated.
The problem I'm having with this exercise is how to save the symbol-names of the input variables. Below I have a start where I only save the values that the symbols are bound to.
(defmacro save-run (varlist &body body)
`(let ((valuelist (list ,#varlist)))
(format t "valuelist: ~A" valuelist)))
(let ((a 5)(b 6))
(values '(a b))
(save-run (a b)
(setf a 7)
(setf b 8)))
[507]> valuelist: (5 6)
Edit: Here's a solution where the variables are saved and then restored (using tips from finnw below). But shadowing the variables as in Vatine's answer is probably more elegant.
(defmacro save-run (varlist &body body)
`(let ((valuelist (list ,#varlist)))
,#body
(multiple-value-setq ,varlist (values-list valuelist))))
To get the list of symbols, all you need to do is quote the contents of VARLIST:
(defmacro save-run (varlist &body body)
`(let ((namelist ',varlist)
(valuelist (list ,#varlist)))
(format t "namelist: ~A~%" namelist)
(format t "valuelist: ~A~%" valuelist)))
I suspect this will not be useful in the final defnition however. There is not much you can do with the list of symbols at run-time. Instead, look for a good place to insert the list in the macro expansion.
Also you might want to use a GENSYM instead of the hard-coded variable name VALUELIST:
(defmacro save-run (varlist &body body)
(let ((valuelist (gensym)))
`(let ((,valuelist (list ,#varlist)))
,#body
(setf (values ,#varlist) (values-list ,valuelist)))))
Personally, I'd introduce another binding layer for the variables we want to save.
You have the list of variables in varlist so something like this may work:
(defmacro save-run (varlist &body body)
`(let ,(loop for var in varlist
collect (list var var))
,#body))
I really liked Vatine's approach. Here is an implementation that expands to the same code, but uses mapcar instead of the loop macro:
(defmacro save-run (varlist &body body)
`(let ,(mapcar #'list varlist varlist)
,#body))