Adding optional argument to macro - macros

I'm trying to add an option "message" attribute to the Clojure time macro. Basically I want to add an optional custom message to the output of time. I'm trying to find a bottleneck in my program and having some descriptive messages attached to time's output would be very helpful.
I've tried the following:
;optional argument
(defmacro time
"Evaluates expr and prints the time it took. Returns the value of
expr."
{:added "1.0"}
[expr & msg]
`(let [start# (. System (nanoTime))
ret# ~expr]
(prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs. " (first ~msg)))
ret#))
and
(defmacro time
"Evaluates expr and prints the time it took. Returns the value of
expr."
{:added "1.0"}
([expr] (time expr ""))
([expr msg]
`(let [start# (. System (nanoTime))
ret# ~expr]
(prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs. " ~msg))
ret#)))
Both throw exceptions. How do I make this work?

It throws an exception because msg is a list,
say you call it with,
(time (+ 1 1) "asd")
msg in the macro becomes a function call, ("asd") which fails. Just destructure msg,
[expr & [msg]]
and use
~msg
You can also test how macros are expanded with macroexpand,
(macroexpand '(time (+ 1 1) "asd"))
Also couple of points,
time is already in core
your version only accepts and times a single expression.
EDIT: time with optional message,
(defmacro time
"Evaluates expr and prints the time it took. Returns the value of
expr."
{:added "1.0"}
[expr & [msg]]
(let [msg (if (nil? msg) "" msg)]
`(let [start# (. System (nanoTime))
ret# ~expr]
(prn (str "Elapsed time: " (/ (double (- (. System (nanoTime)) start#)) 1000000.0) " msecs. " ~msg))
ret#)))
(time (+ 1 1))
"Elapsed time: 0.068 msecs. "
2
(time (+ 1 1) "asd")
"Elapsed time: 0.067 msecs. asd"
2

Related

Lisp - Functions passed into another function as arguments and called from within a Let

I am learning Lisp and, just for practice/education, am trying to define a function that will
ask the user to enter a number until they enter an integer > 0 [copied from Paul Graham's Ansi Common Lisp]
print that number and subtract 1 from it, repeat until the number hits 0, then return.
I am trying to do this via passing 2 functions into a higher-order function - one to get the number from the user, and another recursive [just for fun] function that prints the number while counting it down to 0.
Right now my higher-order function is not working correctly [I've tested the first 2 and they work fine] and I cannot figure out why. I am using SBCL in SLIME. My code for the 3 functions looks like this:
(defun ask-number ()
(format t "Please enter a number. ")
(let ((val (read))) ; so val is a single-item list containing the symbol 'read'?
(cond ; no here read is a function call
((numberp val)
(cond
((< val 0) (ask-number))
(T val)))
(t (ask-number))))))
(defun count-down (n)
(cond
((eql n 0) n)
(t
(progn
(format t "Number is: ~A ~%" n)
(let ((n (- n 1)))
(count-down n))))))
(defun landslide (f1 f2)
(let (x (f1))
(progn
(format t "x is: ~A ~%" x)
(f2 x)))))
but calling slime-eval-defun in landslide yields:
; SLIME 2.27; in: DEFUN LANDSLIDE
; (F1)
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
; (SB-INT:NAMED-LAMBDA LANDSLIDE
; (F1 F2)
; (BLOCK LANDSLIDE
; (LET (X (F1))
; (PROGN (FORMAT T "x is: ~A ~%" X) (F2 X)))))
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
;
; caught STYLE-WARNING:
; The variable F2 is defined but never used.
; in: DEFUN LANDSLIDE
; (F2 X)
;
; caught STYLE-WARNING:
; undefined function: COMMON-LISP-USER::F2
;
; compilation unit finished
; Undefined function:
; F2
; caught 4 STYLE-WARNING conditions
I have tried several [what I consider] obvious modifications to the code, and they all fail with different warnings. Calling the function like (landslide (ask-number) (count-down)), ask-number prompts for user input as expected, but then SLIME fails with
invalid number of arguments: 0
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
I know I have to be missing something really obvious; can someone tell me what it is?
First: You are missing a set of parens in your let:
You have (let (x (f1)) ...) which binds 2 variables x and f1 to nil.
What you want is (let ((x (f1))) ...) which binds 1 variable x to the values of function call (f1)
Second: Common Lisp is a "lisp-2", so to call f2 you need to use funcall: (funcall f2 ...).
Finally: all your progns are unnecessary, and your code is hard to read because of broken indentation, you can use Emacs to fix it.
Before I reach an error in landslide, there are some notes about this code:
Your first function is hard to read- not just because of indentation, but because of nested cond.
You should always think about how to simplify condition branches- using and, or, and if you have only two branches of code, use if instead.
There are predicates plusp and minusp.
Also, don't forget to flush.
I'd rewrite this as:
(defun ask-number ()
(format t "Please enter a number. ")
(finish-output)
(let ((val (read)))
(if (and (numberp val)
(plusp val))
val
(ask-number))))
Second function, count-down.
(eql n 0) is zerop
cond here has only two branches, if can be better
cond has implicit progn, so don't use progn inside cond
let is unnecessary here, you can use 1- directly when you call count-down
Suggested edit:
(defun count-down (n)
(if (zerop n) n
(progn
(format t "Number is: ~A ~%" n)
(count-down (1- n)))))
Also, this function can be rewritten using loop and downto keyword, something like:
(defun count-down (n)
(loop for i from n downto 0
do (format t "Number is: ~A ~%" i)))
And finally, landslide. You have badly formed let here and as Common Lisp is Lisp-2, you have to use funcall. Note that let has also implicit progn, so you can remove your progn:
(defun landslide (f1 f2)
(let ((x (funcall f1)))
(format t "x is: ~A ~%" x)
(finish-output)
(funcall f2 x)))
Then you call it like this:
(landslide #'ask-number #'count-down)

Average of entered numbers

In this program I want to get the average of the entered numbers not only the sum but I can't get the average and the "Enter a number: " keeps repeating.
here's my code
(princ"Enter how many numbers to read: ")
(defparameter a(read))
(defun num ()
(loop repeat a
sum (progn
(format *query-io* "Enter a number: ")
(finish-output)
(parse-integer (read-line *query-io* )))))
(format t "Sum: ~d ~%" (num))
(format t "Average: ~d ~%" (/ (num) a)) ;; I can't get the output for the average and the "Enter a number: " keeps repeating.
Enter how many numbers to read: 5
Enter a number: 4
Enter a number: 3
Enter a number: 2
Enter a number: 1
Enter a number: 3
Sum: 13
Enter a number: <-------
The reason that your prompt is repeating is because your code is calling NUM twice. Each time NUM is called, it asks for more input. A basic fix is to wrap the part of your program that shows the results in a function, just calling NUM once and binding the results to a variable:
(princ "Enter how many numbers to read: ")
(defparameter a (read))
(defun num ()
(loop repeat a
sum (progn
(format *query-io* "Enter a number: ")
(finish-output)
(parse-integer (read-line *query-io*)))))
(defun stats ()
(let ((sum (num)))
(format t "Sum: ~d ~%" sum)
(format t "Average: ~d ~%" (/ sum a))))
This "works", but when the code is loaded the user is prompted for input to set the A parameter; then the user needs to call STATS to enter data and see the results. This is awkward to say the least. But there are lots of little problems with the program. Here are some suggestions:
Avoid using a global parameter at all
Call READ-LINE instead of READ to get the count of input elements
Use *QUERY-IO* consistently
Call FINISH-OUTPUT consistently
Use better variable names (A and NUM are not very descriptive here)
Use ~A instead of ~D
The average may not be an integer; it could be a fraction. When its argument is not an integer, FORMAT uses ~A in place of ~D anyway, but it is probably better to be explicit about this. I would just use ~A in both lines of output.
You can write one function to incorporate all of the above suggestions:
(defun stats ()
(format *query-io* "Enter how many numbers to read: ")
(finish-output *query-io*)
(let* ((count (parse-integer (read-line *query-io*)))
(sum
(loop repeat count
do (format *query-io* "Enter a number: ")
(finish-output *query-io*)
summing (parse-integer (read-line *query-io*)))))
(format *query-io* "Sum: ~A~%Average: ~A~%" sum (/ sum count))
(finish-output *query-io*)))
Here COUNT replaces the earlier A, and it is a local variable within the STATS function. LET* is used instead of LET so that SUM can make use of COUNT, but nested LET expressions could be used instead. Note that SUM is bound to the result of the loop, which is the result from the SUMMING keyword. *QUERY-IO* is used consistently throughout, and printed output is always followed by FINISH-OUTPUT when its sequencing is important.
There is a lot that could be done to further improve this code. There is no input validation in this code; that should be added. It might be good to break STATS into smaller functions that separate input, calculation, and output operations. It might be nice to be able to handle floats in input and output.
Sample interaction:
CL-USER> (stats)
Enter how many numbers to read: 3
Enter a number: 1
Enter a number: 2
Enter a number: 2
Sum: 5
Average: 5/3
OP has asked in a comment:
I tried to add (min count) (max count)) in your given code to get the
minimum and maximum value but the output is the sum. How can I get
minimum and maximum number?
This is really a new question, but it points to shortcomings in the design of the above function that were hinted at with "It might be good to break STATS into smaller functions...."
Firstly, note that (MIN COUNT) or (MAX COUNT) will not be helpful, since we want the minimum or maximum of the data entered; COUNT is just the number of values that the user wants to enter. The original code directly summed the values as they were input; a more flexible approach would be to collect the input in a list, and then to operate on that list to get the desired results. The MIN and MAX functions operate on a number of values, not on a list, so we will need to use APPLY to apply them to a list of results. We can also apply + to the list of input values to get the sum of the elements in the list:
(defun stats ()
(format *query-io* "Enter how many numbers to read: ")
(finish-output *query-io*)
(let* ((count (parse-integer (read-line *query-io*)))
(data
(loop repeat count
do (format *query-io* "Enter a number: ")
(finish-output *query-io*)
collecting (parse-integer (read-line *query-io*))))
(min (apply #'min data))
(max (apply #'max data))
(sum (apply #'+ data))
(avg (float (/ sum count))))
(format *query-io* "Minimum: ~A~%" min)
(format *query-io* "Maximum: ~A~%" max)
(format *query-io* "Sum: ~A~%" sum)
(format *query-io* "Average: ~A~%" avg)
(finish-output *query-io*)))
Here the loop collects input in a list by using the COLLECTING keyword, and the result is bound to DATA. The desired calculations are made, and the results are printed.
This works, but it is really begging for a better design; there are too many different things happening in one function. You could move the display code into another function, returning MIN, MAX, etc. in a list or as multiple values. But then it would be even more flexible if the calculations were made independent of the code that gathers input by allowing STATS to return a list of input. The calculation of AVG requires COUNT; the new code could return COUNT too, but it is not needed anyway, since we can call LENGTH on the input list to get a count. One wonders why we need the user to enter a number of elements at all. What if we took numbers from the user until a non-numeric value is entered?
This answer has already gotten quite long, but below is some code that breaks the STATS function into smaller parts, refining it in the process. By using smaller function definitions that are more focused on their tasks, the functions can be reused or combined with other functions to accomplish other goals more easily, and it will be easier to modify the definitions when changes are required. The final function, PROMPT-FOR-STATS-REPORT does essentially what the earlier STATS function did. It is now much easier to add new functionality by modifying PROMPT-FOR-STATS. New accessor functions can be added as needed when PROMPT-FOR-STATS is augmented, and PROMPT-FOR-STATS-REPORT can be modified to display results differently, or to access and display newly added functionality.
This is by no means the optimal solution to OP's problem, if there is an "optimal" solution. I encourage OP to try to find ways to improve upon the design of this code. There are some comments scattered throughout:
;;; Here is a function to prompt for an integer. Since we want to receive
;;; non-numeric input `:JUNK-ALLOWED` is set to `T`. When input that can not be
;;; parsed into an integer is provided, `PARSE-INTEGER` will now return `NIL`
;;; instead of signalling an error condition.
(defun prompt-for-int (msg)
(format *query-io* "~A" msg)
(finish-output *query-io*)
(parse-integer (read-line *query-io*) :junk-allowed t))
;;; Here is a function to prompt for input until some non-numeric value
;;; is given. The results are collected in a list and returned.
(defun prompt-for-ints (msg)
(format *query-io* "~A~%" msg)
(finish-output *query-io*)
(let (input-num)
(loop
do (setf input-num (prompt-for-int "Enter a number ENTER to quit: "))
while input-num
collecting input-num)))
;;; Some functions to calculate statistics:
(defun count-of-nums (xs)
(length xs))
(defun min-of-nums (xs)
(apply #'min xs))
(defun max-of-nums (xs)
(apply #'max xs))
(defun sum-of-nums (xs)
(apply #'+ xs))
(defun avg-of-nums (xs)
(float (/ (sum-of-nums xs)
(count-of-nums xs))))
;;; A function to prompt the user for input which returns a list of statistics.
(defun prompt-for-stats (msg)
(let ((data (prompt-for-ints msg)))
(list (count-of-nums data)
(min-of-nums data)
(max-of-nums data)
(sum-of-nums data)
(avg-of-nums data))))
;;; Accessor functions for a list of statistics:
(defun get-stats-count (stats)
(first stats))
(defun get-stats-min (stats)
(second stats))
(defun get-stats-max (stats)
(third stats))
(defun get-stats-sum (stats)
(fourth stats))
(defun get-stats-avg (stats)
(fifth stats))
;;; A function that prompts for input and displays results.
(defun prompt-for-stats-report ()
(let ((results (prompt-for-stats "Enter some integers to view statistics")))
(format *query-io* "Count: ~A~%" (get-stats-count results))
(format *query-io* "Minimum: ~A~%" (get-stats-min results))
(format *query-io* "Maximum: ~A~%" (get-stats-max results))
(format *query-io* "Sum: ~A~%" (get-stats-sum results))
(format *query-io* "Average: ~A~%" (get-stats-avg results))
(finish-output *query-io*)))
Sample interaction:
CL-USER> (prompt-for-stats-report)
Enter some integers to view statistics
Enter a number ENTER to quit: 1
Enter a number ENTER to quit: 2
Enter a number ENTER to quit: 1
Enter a number ENTER to quit:
Count: 3
Minimum: 1
Maximum: 2
Sum: 4
Average: 1.3333334

creating a macro for iterate in Common Lisp

I am trying to practise creating macros in Common Lisp by creating a simple += macro and an iterate macro. I have managed to create the += macro easily enough and I am using it within my iterate macro, which I am having a couple of issues with. When I try to run my macro with for example
(iterate i 1 5 1 (print (list 'one i)))
(where i is the control variable, 1 is the start value, 5 is the end value, and 1 is the increment value). I receive SETQ: variable X has no value
(defmacro += (x y)
(list 'setf x '(+ x y)))
(defmacro iterate (control beginExp endExp incExp &rest body)
(let ( (end (gensym)) (inc (gensym)))
`(do ( (,control ,beginExp (+= ,control ,inc)) (,end ,endExp) (,inc ,incExp) )
( (> ,control ,end) T)
,# body
)
)
)
I have tried multiple different things to fix it by messing with the , and this error makes me unsure as to whether the problem is with iterate or +=. From what I can tell += works properly.
Check the += expansion to find the error
You need to check the expansion:
CL-USER 3 > (defmacro += (x y)
(list 'setf x '(+ x y)))
+=
CL-USER 4 > (macroexpand-1 '(+= a 1))
(SETF A (+ X Y))
T
The macro expansion above shows that x and y are used, which is the error.
We need to evaluate them inside the macro function:
CL-USER 5 > (defmacro += (x y)
(list 'setf x (list '+ x y)))
+=
CL-USER 6 > (macroexpand-1 '(+= a 1))
(SETF A (+ A 1))
T
Above looks better. Note btw. that the macro already exists in standard Common Lisp. It is called incf.
Note also that you don't need it, because the side-effect is not needed in your iterate code. We can just use the + function without setting any variable.
Style
You might want to adjust a bit more to Lisp style:
no camelCase -> default reader is case insensitive anyway
speaking variable names -> improves readability
documentation string in the macro/function - improves readability
GENSYM takes an argument string -> improves readability of generated code
no dangling parentheses and no space between parentheses -> makes code more compact
better and automatic indentation -> improves readability
the body is marked with &body and not with &rest -> improves automatic indentation of the macro forms using iterate
do does not need the += macro to update the iteration variable, since do updates the variable itself -> no side-effects needed, we only need to compute the next value
generally writing a good macro takes a bit more time than writing a normal function, because we are programming on the meta-level with code generation and there is more to think about and a few basic pitfalls. So, take your time, reread the code, check the expansions, write some documentation, ...
Applied to your code, it now looks like this:
(defmacro iterate (variable start end step &body body)
"Iterates VARIABLE from START to END by STEP.
For each step the BODY gets executed."
(let ((end-variable (gensym "END"))
(step-variable (gensym "STEP")))
`(do ((,variable ,start (+ ,variable ,step-variable))
(,end-variable ,end)
(,step-variable ,step))
((> ,variable ,end-variable) t)
,#body)))
In Lisp the first part - variable, start, end, step - usually is written in a list. See for example DOTIMES. This makes it for example possible to make step optional and to give it a default value:
(defmacro iterate ((variable start end &optional (step 1)) &body body)
"Iterates VARIABLE from START to END by STEP.
For each step the BODY gets executed."
(let ((end-variable (gensym "END"))
(step-variable (gensym "STEP")))
`(do ((,variable ,start (+ ,variable ,step-variable))
(,end-variable ,end)
(,step-variable ,step))
((> ,variable ,end-variable) t)
,#body)))
Let's see the expansion, formatted for readability. We use the function macroexpand-1, which does the macro expansion only one time - not macro expanding the generated code.
CL-USER 10 > (macroexpand-1 '(iterate (i 1 10 2)
(print i)
(print (* i 2))))
(DO ((I 1 (+ I #:STEP2864))
(#:END2863 10)
(#:STEP2864 2))
((> I #:END2863) T)
(PRINT I)
(PRINT (* I 2)))
T
You can see that the symbols created by gensym are also identifiable by their name.
We can also let Lisp format the generated code, using the function pprint and giving a right margin.
CL-USER 18 > (let ((*print-right-margin* 40))
(pprint
(macroexpand-1
'(iterate (i 1 10 2)
(print i)
(print (* i 2))))))
(DO ((I 1 (+ I #:STEP2905))
(#:END2904 10)
(#:STEP2905 2))
((> I #:END2904) T)
(PRINT I)
(PRINT (* I 2)))
I figured it out. Turns out I had a problem in my += macro and a couple of other places in my iterate macro. This is the final working result. I forgot about the , while i was writing the += macro. The other macro declerations where out of order.
(defmacro += (x y)
`(setf ,x (+ ,x ,y)))
(defmacro iterate2 (control beginExpr endExpr incrExpr &rest bodyExpr)
(let ((incr(gensym))(end(gensym)) )
`(do ((,incr ,incrExpr)(,end ,endExpr)(,control ,beginExpr(+= ,control ,incr)))
((> ,control ,end) T)
,# bodyExpr
)
)
)

Can a Lisp read procedure read this and how?

I'm writing a grammar which I intend to implement in a Lisp read procedure, i.e. reading one expression at a time from an input source which is i.e. mutable. Most of the grammar is just like Lisp, but the two pertinent changes are:
Whitespace is read and is part of the resulting syntax. Contiguous whitespace is grouped together like contiguous non-whitespace characters are grouped as identifiers, and the result of reading such a string is a "whitespace object", which stores the exact sequence of characters read. The evaluator ignores whitespace objects when they appear in a list (in other words, if foo is a whitespace object then (eval '(+ 3 foo 4)) is equivalent to (eval '(+ 3 4))), and if it is asked to evaluate one directly, it is self-evaluating.
Secondly, if several tokens other than whitespace tokens appear on the same line, those tokens are collected into a list and that list is the result of the read.
e.g.,
+ 3 4 5
(+ 3 4 5)
+ 3 4 (+ 1 4)
(+ 3 4 (+ 1 4))
all produce the value 12.
Is it possible to implement this reader as a Lisp read procedure that follows the typical expectations of a read procedure? If so, how? (I'm at a loss.)
Edit: Clarification on whitespace:
If we say that a "whitespace object" is simply a string and read, then reading the following segment:
(foo bar baz)
produces a syntax object like:
'(foo " " bar " " baz)
In other words, the whitespace between tokens is stored in the resultant syntax object.
Suppose I write a macro named ->, which takes a syntax object (scheme style macro), and whitespace? is a predicate identifying whitespace syntax objects
(define-macro (-> stx)
(let* ((stxl (syntax-object->list stx))
(obj (car stxl))
(let proc ((res empty))
(lst (cdr stxl)))
(let ((method (car lst)))
(if (whitespace? method)
; skip whitespace, recur immediately
(proc res (cdr lst))
; Insert obj as the second element in method
(let ((modified-method (cons (car method)
(cons obj (cdr method)))))
; recur
(proc (cons res modified-method) (cdr lst))))))))
The reading part of this is pretty easy. You just need a whitespace test, and then your reading function will install a custom reader character macro that detects whitespace and reads consecutive sequences of whitespace into a single object. First, the whitespace test and a whitespace object; these are pretty simple:
(defparameter *whitespace*
#(#\space #\tab #\return #\newline)
"A vector of whitespace characters.")
(defun whitespace-p (char)
"Returns true if CHAR is in *WHITESPACE*."
(find char *whitespace* :test 'char=))
(defstruct whitespace-object
characters)
Now the macro character function:
(defun whitespace-macro-char (stream char)
"A macro character function that consumes characters from
stream (including CHAR), until a non-whitespace character (or end of
file) is encountered. Returns a whitespace-object whose characters
slot contains a string of the whitespace characters."
(let ((chars (loop for c = (peek-char nil stream nil #\a)
while (whitespace-p c)
collect (read-char stream))))
(make-whitespace-object
:characters (coerce (list* char chars) 'string))))
Now the read function just has the same signature as the normal read, but copies the readtable, then installs the macro function, and calls read. The result from read is returned, and the readtable is restored:
(defun xread (&optional (stream *standard-input*) (eof-error-p t) eof-value recursive-p)
"Like READ, but called with *READTABLE* bound to a readtable in
which each whitespace characters (that is, each character in
*WHITESPACE*) is a macro characters whose macro function is
WHITESPACE-MACRO-CHAR."
(let ((rt (copy-readtable)))
(map nil (lambda (wchar)
(set-macro-character wchar #'whitespace-macro-char))
*whitespace*)
(unwind-protect (read stream eof-error-p eof-value recursive-p)
(setf *readtable* rt))))
Example:
(with-input-from-string (in "(+ 1 2 (* 3
4))")
(xread in))
(+ #S(WHITESPACE-OBJECT :CHARACTERS " ") 1
#S(WHITESPACE-OBJECT :CHARACTERS " ") 2
#S(WHITESPACE-OBJECT :CHARACTERS " ")
(* #S(WHITESPACE-OBJECT :CHARACTERS " ") 3
#S(WHITESPACE-OBJECT
:CHARACTERS "
")
4))
Now, to implement the eval counterpart that you want, you need to be able to remove whitespace objects from lists. This isn't too hard, and we can write a slightly more general utility function to do it for us:
(defun remove-element-if (predicate tree)
"Returns a new tree like TREE, but which contains no elements in an
element position which ssatisfy PREDICATE. An element is in element
position if it is the car of some cons cell in TREE."
(if (not (consp tree))
tree
(if (funcall predicate (car tree))
(remove-element-if predicate (cdr tree))
(cons (remove-element-if predicate (car tree))
(remove-element-if predicate (cdr tree))))))
CL-USER> (remove-element-if (lambda (x) (and (numberp x) (evenp x))) '(+ 1 2 3 4))
(+ 1 3)
CL-USER> (with-input-from-string (in "(+ 1 2 (* 3
4))")
(remove-element-if 'whitespace-object-p (xread in)))
(+ 1 2 (* 3 4))
So now the evaluation function is a simple wrapper around eval:
(defun xeval (form)
(eval (remove-element-if 'whitespace-object-p form)))
CL-USER> (with-input-from-string (in "(+ 1 2 (* 3
4))")
(xeval (xread in)))
15
Let's make sure that standalone whitespace objects still appear as expected:
CL-USER> (with-input-from-string (in " ")
(let* ((exp (xread in))
(val (xeval exp)))
(values exp val)))
#S(WHITESPACE-OBJECT :CHARACTERS " ")
#S(WHITESPACE-OBJECT :CHARACTERS " ")

Lisp: defmacro with &optional and &body

I wrote a quick and dirty macro to time lisp code. However, the problem I am facing now is that I wanted to include an optional output-stream in the function. However, I can not figure out how to use both the &optional and &body parameters in the defmacro. I looked for examples but found only those for defun which I think I understand. I am not able to figure out why this is failing for me. Any hints:
(defmacro timeit (&optional (out-stream *standard-output*) (runs 1) &body body)
"Note that this function may barf if you are depending on a single evaluation
and choose runs to be greater than one. But I guess that will be the
caller's mistake instead."
(let ((start-time (gensym))
(stop-time (gensym))
(temp (gensym))
(retval (gensym)))
`(let ((,start-time (get-internal-run-time))
(,retval (let ((,temp))
(dotimes (i ,runs ,temp)
(setf ,temp ,#body))))
(,stop-time (get-internal-run-time)))
(format ,out-stream
"~CTime spent in expression over ~:d iterations: ~f seconds.~C"
#\linefeed ,runs
(/ (- ,stop-time ,start-time)
internal-time-units-per-second)
#\linefeed)
,retval)))
This is how I intend to use the code:
(timeit (+ 1 1)) ; Vanilla call
(timeit *standard-output* (+ 1 1)) ; Log the output to stdout
(timeit *standard-output* 1000 (+ 1 1)) ; Time over a 1000 iterations.
I think this, found from the hyperspec, on defmacro is a similar idea.
(defmacro mac2 (&optional (a 2 b) (c 3 d) &rest x) `'(,a ,b ,c ,d ,x)) => MAC2
(mac2 6) => (6 T 3 NIL NIL)
(mac2 6 3 8) => (6 T 3 T (8))
EDIT: Keyword arguments
The usage shown above is clearly flawed. Perhaps, this is better:
(timeit (+ 1 1)) ; Vanilla call
(timeit :out-stream *standard-output* (+ 1 1)) ; Log the output to stdout
(timeit :out-stream *standard-output* :runs 1000 (+ 1 1)) ; Time over a 1000 iterations.
Thanks.
How should that work?
How should it be detected that the first thing is the optional stream?
(timeit a) ; is a the optional stream or an expression to time?
(timeit a b) ; is a the optional stream or an expression to time?
(timeit a b c) ; is a the optional stream or an expression to time?
I would avoid such macro arglists.
Usually I would prefer:
(with-timings ()
a b c)
and with a stream
(with-timings (*standard-output*)
a b c)
The first list gives the optional parameters. The list itself is not optional.
That macro should be easier to write.
Generally it may not be necessary to specify a stream:
(let ((*standard-output* some-stream))
(timeit a b c))
You can implement what you want, but I would not do it:
(defmacro timeit (&rest args)
(case (length args)
(0 ...)
(1 ...)
(otherwise (destructuring-bind (stream &rest body) ...))))
Solution: With a non-optional keyword arglist
(defmacro timeit ((&key
(to-stream *standard-output*)
(with-runs 1))
&body body)
"Note that this function may barf if you are depending on a single evaluation
and choose with-runs to be greater than one. But I guess that will be the
caller's mistake instead."
(let ((start-time (gensym))
(stop-time (gensym))
(temp (gensym))
(retval (gensym))
(elapsed-time (gensym)))
`(let* ((,start-time (get-internal-run-time))
(,retval (let ((,temp))
(dotimes (i ,with-runs ,temp)
(setf ,temp ,#body))))
(,stop-time (get-internal-run-time))
(,elapsed-time (/ (- ,stop-time ,start-time)
internal-time-units-per-second)))
(format ,to-stream
(concatenate 'string
"~CAverage (total) time spent in expression"
" over ~:d iterations: ~f (~f) seconds.~C")
#\linefeed
,with-runs
,elapsed-time
(/ ,elapsed-time ,with-runs)
#\linefeed)
,retval)))
Based on Rainer's comments.
Usage pattern:
(timeit nil (+ 1 1)) ; Vanilla case
(timeit (:to-stream *standard-output*) (+ 1 1)) ; Log to stdout
(timeit (:with-runs 1000) (+ 1 1)) ; Evaluate 1000 times
(timeit (:with-runs 1000 :to-stream *standard-output*) (+ 1 1)) ; Evaluate 1000 times and log to stdout
I've of the general opinion that these kind of arguments should generally be provided in a separate list that is the first argument to the macro. This is especially common in the with- type macros. Some other answers have shown how you can do that, but I think it's also a good macro-writing technique to write a functional version first that implements the main functionality, and to then write a macro version. This one isn't too hard, although the approach here does have the potential to add some time increase for function call overhead.
(defun %timeit (function &optional (runs 1) (stream *standard-output*))
(let ((start (get-internal-run-time))
ret
stop)
(prog1 (dotimes (i runs ret)
(declare (ignorable i))
(setf ret (funcall function)))
(setf stop (get-internal-run-time))
(format stream "~&Time spent in ~a iterations: ~f seconds."
runs
(/ (- stop start) internal-time-units-per-second)))))
(defmacro timeit ((&optional (runs 1) (stream *standard-output*)) &body body)
`(%timeit #'(lambda () ,#body) ,runs ,stream))
CL-USER> (timeit (10000000) (1+ most-positive-fixnum))
Time spent in 10000000 iterations: 0.148 seconds.
4611686018427387904