I'm trying to generate the following html code using cl-who:
<html>
<body>
<div id="cnt_1"></div>
<div id="cnt_2"></div>
<div id="cnt_3"></div>
</body>
</html>
And here's the code that I thought would work:
(with-html-output-to-string (*standard-output* nil)
(:html
(:body
(do ((cnt 1 (+ cnt 1)))
((> cnt 3))
(htm (:div :id (format t "cnt_~A" cnt)))))))
But instead I get the following output:
<html><body><divcnt_1></div><divcnt_2></div><divcnt_3></div></body></html>
Seems like :id does not work with function calls. Does it mean that I can't use format in cl-who? What should I use instead?
That's because you don't want to write directly in the stream.
CL-USER> (with-html-output-to-string (s) (:div :id "test"))
"<div id='test'></div>"
CL-USER> (with-html-output-to-string (s)
(:html
(:body
(do ((cnt 1 (+ cnt 1)))
((> cnt 3))
(htm (:div :id (format nil "cnt_~A" cnt)))))))
"<html><body><div id='cnt_1'></div><div id='cnt_2'></div><div id='cnt_3'></div></body></html>"
By the way, if you want to write directly in the stream use CL-WHO:FMT.
Related
I have a macro with-voice:
(defmacro with-voice (tag body)
`(format nil "<span class=\"~a\">~%~a~%</span>" ',tag ,body))
which emits some text surrounded by a tag with some class. I know there are great libraries like CL-WHO - but I just need something tiny...
CL-USER> (with-voice narrator "foo")
"<span class=\"NARRATOR\">
foo
</span>"
which is is the desired outcome
I would like to be able to do this from a string
(let ((s (read-from-string "(with-voice narrator \"foo\")")))
(print (eval s)))
This works:
CL-USER> (let ((s (read-from-string "(with-voice narrator \"foo\")")))
(print (eval s)))
"<span class=\"NARRATOR\">
foo
</span>"
"<span class=\"NARRATOR\">
foo
</span>
but it has the dreaded eval. I've tried to get this working using macros and lambdas, but I can't get it working.
I'd be grateful for some help
thanks!
You could funcall the symbol you expect in a certain position of the read form:
(destructuring-bind (operator class text)
(read-from-string "(with-voice narrator \"foo\")")
(funcall operator class text))
Or even just expect those forms to be funcallable:
(apply #'funcall (read-from-string "(with-voice narrator \"foo\")"))
If you have more different shapes of data, you might want to match those, e. g. using optima, or using dispatch by eql specializer. This can also help with validation if the read input might contain harmful intent.
I'm wondering if there is a way to add hyperlinks to noweb references,
i.e., in the following org-mode snippet:
#+name: list-all
#+begin_src sh
ls -a
#+end_src
and we come here
#+begin_src sh :noweb no-export :tangle myscript.sh
echo "Hello world"
<<list-all>>
#+end_src
When exporting to html or latex,
I would like to have the <<list-all>> to be a link to the code block
being referenced by it.
I have noticed that this is the case in some noweb implementations
other than org-modes' one. I've checked the documentation and I don't
seem to find anything about this.
This would be an invaluable feature to have.
I'm not able to put the links within the src block (for that you probably need to add a filter to org-export-filter-src-block-functions: the filter, however, needs to work with the exported format).
However, I am happy with this solution I implemented after having read this reddit post.
Example
Let's say you have this org file:
#+name: first-fragment
#+begin_src python
x=1
#+end_src
Some text.
#+name: second-fragment
#+begin_src python
y=2
#+end_src
Some text.
#+name: to-be-tangled
#+begin_src python :noweb no-export :tangle program.py
<<first-fragment>>
<<second-fragment>>
print(f'{x} and {y}')
#+end_src
Then I can export it to html with this elisp code:
(require 'ox-html)
(load (concat default-directory "htmlize.el"))
(require 'htmlize)
(setq make-backup-files nil
org-html-doctype "html5"
org-html-html5-fancy t
org-html-style-default ""
org-html-htmlize-output-type 'css
org-html-validation-link nil
org-html-postamble t
org-html-postamble-format '(("en" "")))
(defun first-group-match (regex string)
"Return the substring matching the first group in REGEX,
together with the ending point in STRING.
The result is a cons cell (MATCH . POSITION).
"
(save-match-data
(if (string-match regex string)
(cons (substring string (match-beginning 1) (match-end 1)) (match-end 1))
nil)
)
)
(defun all-string-matches (regex string)
"Return a list of all group matches."
(if (< (length string) 5)
nil
(let* ((match (first-group-match regex string))
(name (car match))
(end-name (if name (cdr match) -1))
(next (all-string-matches regex
(substring string end-name))))
(if name
(cons name next)
next))))
(defun get-noweb-links (block)
"Get all the <<>> references as a list."
(cl-loop for name in
(all-string-matches "<<\\([^<>\n]+\\)>>" (org-element-property :value block))
collect
(format "[[%s][%s]]" name name)))
(defun append-refs (block refs)
"Append to BLOCK a line with REFS."
(let ((begin (org-element-property :begin block))
(end (org-element-property :end block))
(string (format "\n/This code refers to: %s/\n\n" refs)))
(goto-char (+ added-characters (org-element-property :end block)))
(insert string)
(setq added-characters (+ added-characters (length string)))))
(defun add-references (_)
"Add a line with referenced blocks to all src blocks that contains noweb links."
(let ((src-blocks (org-element-map (org-element-parse-buffer) 'src-block
(lambda (b) b))))
(cl-loop for b in src-blocks do
(when (string-match "<<[^<>\n]+>>" (org-element-property :value b))
(append-refs b (string-join (get-noweb-links b) ", "))))))
(setq added-characters 0)
(add-hook 'org-export-before-parsing-functions 'add-references)
(dolist (file command-line-args-left)
(with-current-buffer
(find-file-literally file)
(org-html-export-to-html)))
Resulting in this:
<!DOCTYPE html>
<html lang="en">
<head>
<!-- 2022-12-10 sab 10:32 -->
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<title></title>
<meta name="author" content="eMMe" />
<meta name="generator" content="Org Mode" />
</head>
<body>
<div id="content" class="content">
<div class="org-src-container">
<pre class="src src-python" id="org121b865"><span class="org-variable-name">x</span><span class="org-operator">=</span>1
</pre>
</div>
<p>
Some text.
</p>
<div class="org-src-container">
<pre class="src src-python" id="orga7322c4"><span class="org-variable-name">y</span><span class="org-operator">=</span>2
</pre>
</div>
<p>
Some text.
</p>
<div class="org-src-container">
<pre class="src src-python" id="orgcde0461"><span class="org-operator"><<</span>first<span class="org-operator">-</span>fragment<span class="org-operator">>></span>
<span class="org-operator"><<</span>second<span class="org-operator">-</span>fragment<span class="org-operator">>></span>
<span class="org-builtin">print</span>(f<span class="org-string">'</span>{x}<span class="org-string"> and </span>{y}<span class="org-string">'</span>)
</pre>
</div>
<p>
<i>This code refers to: first-fragment, second-fragment</i>
</p>
</div>
</body>
</html>
So I have a loop to just repeat the little text game I have made about dota, but when the function 'play' is called within a loop it doesn't return the result of my cond function, it just takes an input and then moves on to the next loop.
;;;;learn the invoker combo's
(defparameter *invoker-combo* '((cold-snap (3 0 0) 'QQQ);all of the possible invoker combo's
(ghost-walk (2 1 0) 'QQW)
(Ice-Wall (2 0 1) 'QQE)
(EMP (0 3 0) 'WWW)
(Tornado (1 2 0) 'QWW)
(Alacrity (0 2 1) 'WWE)
(Sun-Strike (0 0 3) 'EEE)
(Forge-Spirit (1 0 2) 'QEE)
(Chaos-Meteor (0 1 2) 'WEE)
(Deafening-Blast (1 1 1) 'QWE)))
(defun rand-combo (invoker-combo);returns a random combo
(nth (random (length invoker-combo))invoker-combo))
(defun count-letters (input);converts the keyboard strokes into numbers to be compared as it doesn't matter what order they are in, just that there is the correct quantity of them e.g QQE could also be written QEQ.
(append
(list (count #\Q input)
(count #\W input)
(count #\E input))))
(defun try-for-combo (rand-combo);takes i-p and compares it with the value for the random combo
(print(car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))'Good-job)
((equal i-p "END")(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo)*invoker-combo*)))))))
(defun play ()
(try-for-combo (rand-combo *invoker-combo*)))
(defun loop-play (x)
(loop for i from 0 to x
:do (play)))
If I call the function 'play' I get the following o/p:
FORGE-SPIRIT asdf
("ASDF" WAS WRONG CORRECT IS 'QEE)
or
ALACRITY wwe
GOOD-JOB
But if I call the function 'loop-play' I get the following o/p:
Break 3 [7]> (loop-play 2)
SUN-STRIKE eee
ALACRITY wwe
TORNADO qww
NIL
Can someone explain to me why this is happening?
EDIT: feel free to change the title, I didn't really know what to put.
The indentation and formatting of the code is poor. Please make it easier for you and for us to read the code.
(defun try-for-combo (rand-combo);takes i-p and compares it with the value for the random combo
(print(car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))'Good-job) ; wrong indent level
((equal i-p "END")(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo)*invoker-combo*)))))))
lacks spaces between s-expressions
wrong indentation levels
structure of the code unclear
does not use built-in documentation features
some lines are too long
Better:
(defun try-for-combo (rand-combo)
"takes i-p and compares it with the value for the random combo" ; built in doc
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo)) ; indentation
'Good-job)
((equal i-p "END")
(list 'Thanks 'for 'playing))
(t
(list i-p 'was 'wrong 'correct 'is ; several lines
(caddr (assoc (car rand-combo)
*invoker-combo*)))))))
I would propose to use an editor which actually understands some Lisp formatting. like GNU Emacs / SLIME, Clozure CL's Hemlock, LispWorks' editor...
If you are unsure about formatting, you can also ask Lisp to do it. Clisp is not that good at formatting, but something like SBCL or CCL would do:
* (let ((*print-case* :downcase))
(pprint '(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))
'Good-job) ((equal i-p "END")
(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is
(caddr (assoc (car rand-combo)
*invoker-combo*)))))))))
And you get nicely formatted code:
(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line))) (try (count-letters i-p)))
(cond ((equal try (cadr rand-combo)) 'good-job)
((equal i-p "END") (list 'thanks 'for 'playing))
(t
(list i-p 'was 'wrong 'correct 'is
(caddr (assoc (car rand-combo) *invoker-combo*)))))))
Automatic indenting of Lisp code by the editor saves you a lot of work.
There are hints for manual indentation.
Your try-for-combo function doesn't actually output anything. Rather, it returns values.
In the REPL, if you evaluate a form, like (+ 1 2), it will always print the evaluation of that form at the end (in this case, 3). However, consider instead (+ 1 (print 2)). The print function actually outputs the argument to standard output, then returns the value itself. So this will show (on the repl)
2
3
The 2 is outputted first, because (print 2) itself prints 2. Then, the form (+ 1 (print 2)) is evaluates to the same things as (+ 1 2), or 3.
In your case, your try-for-combo function should look like:
(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(print
(cond
((equal try (cadr rand-combo)) 'Good-job)
((equal i-p "END") (list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo) *invoker-combo*))))))
nil))
This will print the result of that cond form, and return 'nil'.
That's just the difference between the output your program does and the output the Lisp system does for each evaluation:
print prints something (a newline and then its argument) and returns a value. The value is printed by the REPL. Thus we see output twice:
[3]> (print "3")
"3"
"3"
Next we do several call to print in a progn. The value of the progn form is printed by the REPL. The first three strings are printed by the code and the last string is printed because of the Lisp REPL printing the value:
[4]> (progn (print "1") (print "2") (print "3"))
"1"
"2"
"3"
"3"
I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))
For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.
I'm reading/working through Practical Common Lisp. I'm on the chapter about building a test framework in Lisp.
I have the function "test-+" implemented as below, and it works:
(defun test-+ ()
(check
(= (+ 1 2) 3)
(= (+ 5 6) 11)
(= (+ -1 -6) -7)))
Remember, I said, it works, which is why what follows is so baffling....
Here is some code that "test-+" refers to:
(defmacro check (&body forms)
`(combine-results
,#(loop for f in forms collect `(report-result ,f ',f))))
(defmacro combine-results (&body forms)
(with-gensyms (result)
`(let ((,result t))
,#(loop for f in forms collect `(unless ,f (setf ,result nil)))
,result)))
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defun report-result (value form)
(format t "~:[FAIL~;pass~] ... ~a~%" value form)
value)
Now, what I've been doing is using Slime to macro-expand these, step by step (using ctrl-c RET, which is mapped to macroexpand-1).
So, the "check" call of "test-+" expands to this:
(COMBINE-RESULTS
(REPORT-RESULT (= (+ 1 2) 3) '(= (+ 1 2) 3))
(REPORT-RESULT (= (+ 5 6) 11) '(= (+ 5 6) 11))
(REPORT-RESULT (= (+ -1 -6) -7) '(= (+ -1 -6) -7)))
And then that macro-expands to this:
(LET ((#:G2867 T))
(UNLESS (REPORT-RESULT (= (+ 1 2) 3) '(= (+ 1 2) 3)) (SETF #:G2867 NIL))
(UNLESS (REPORT-RESULT (= (+ 5 6) 11) '(= (+ 5 6) 11)) (SETF #:G2867 NIL))
(UNLESS (REPORT-RESULT (= (+ -1 -6) -7) '(= (+ -1 -6) -7))
(SETF #:G2867 NIL))
#:G2867)
And it is THAT code, directly above this sentence, which doesn't work. If I paste that into the REPL, I get the following error (I'm using Clozure Common Lisp):
Unbound variable: #:G2867 [Condition of type UNBOUND-VARIABLE]
Now, if I take that same code, replace the gensym with a variable name such as "x", it works just fine.
So, how can we explain the following surprises:
The "test-+" macro, which calls all of this, works fine.
The macro-expansion of the "combine-results" macro does not run.
If I remove the gensym from the macro-expansion of "combine-results", it
does work.
The only thing I can speculate is that you cannot use code the contains literal usages of gensyms. If so, why not, and how does one work around that? And if that is not the explanation, what is?
Thanks.
GENSYM creates uninterned symbols. When the macro runs normally, this isn't a problem, because the same uninterned symbol is being substituted throughout the expression.
But when you copy and paste the expression into the REPL, this doesn't happen. #: tells the reader to return an uninterned symbol. As a result, each occurrence of #:G2867 is a different symbol, and you get the unbound variable warning.
If you do (setq *print-circle* t) before doing the MACROEXPAND it will use #n= and #n# notation to link the identical symbols together.
The code, after being printed and read back, is no longer the same code. In particular, the two instances of #:G2867 in the printed representation would be read back as two separated symbols (albeit sharing the same name), while they should be the same in the original internal representation.
Try setting *PRINT-CIRCLE* to T to preserve the identity in the printed representation of the macro-expanded code.