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
Related
I have an assignment where I need to write a script using lisp. I am having issues with passing variables
Here is the code. Issues to follow:
(defmacro while (test &rest bodies)
`(do ()
((not ,test))
,# bodies)
)
(defmacro += (var inc)
`(print (eval var))
;(setf (eval var) (+ (eval var) inc))
)
(defmacro iterate (i begin end inc &rest others)
(setf i begin)
(while (<= i (eval end))
;(dolist (item others)
; (eval item)
;)
(print (list 'two i (eval end)))
(+= (eval end) 1)
(setf i (+ i inc))
)
)
(setf n 5)
(iterate i 1 n 1
(print (list 'one i))
(+= n 1)
)
The first issue lies in passing the statements to the iterate macro. When I try to run the commented out dolist, the print statement will throw an error when it comes to the variable i. For some reason I can not get it to print using the macro variable i which has a value, but it seems to want to default to the global variable i which has not been set. I get the error:
- EVAL: variable I has no value
The second issue is when I call the "+=" macro. The value of end in the iterate macro is 5 as passed to the macro by use of the variable N which it is set to 5, however, when I pass it to the "+=" macro using the line "(+= (eval end) 1)" I can not get it to pass the value. I tried removing the eval in the line "(+= (eval end) 1)" and when I try printing it with "(print (eval var))" in the "+=" macro, I get the error
- EVAL: variable END has no value
How would I solve these issues?
Your first macro is basically correct. It generates code.
(defmacro while (test &body body)
`(do ()
((not ,test))
,#body))
One can check it with an example. We expand the macro using example code. The function MACROEXPAND-1 expands the top-level macro exactly once. You need to pass code to the function MACROEXPAND-1:
CL-USER 1 > (macroexpand-1 '(while (< i 10)
(print i)
(incf i)))
(DO NIL ; NIL is the same as ()
((NOT (< I 10)))
(PRINT I)
(INCF I))
T
The generated code is a DO loop. Just like intended.
Thus we can use your macro:
CL-USER 2 > (let ((i 5))
(while (< i 10)
(print i)
(incf i)))
5
6
7
8
9
NIL
Your other macros should be like that
they should generate code
macro expansion of examples should show the right generated code
the generated code should work
Your macros should NOT
be using EVAL
try to compute results other than code
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
)
)
)
At the end of Ch 8 in Practical Common Lisp, Peter Seibel presents the once-only macro. Its purpose is to mitigate a number of subtle problems with variable evaluation in user-defined macros. Note I'm not trying to understand at this point how this macro works, as in some other posts, but just how to use it properly:
(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 following is a sample (incorrect) contrived macro that attempts to exhibit several variable evaluation problems. It purports to iterate over a range of integers by some delta, returning the range:
(defmacro do-range ((var start stop delta) &body body)
"Sample macro with faulty variable evaluations."
`(do ((,var ,start (+ ,var ,delta))
(limit ,stop))
((> ,var limit) (- ,stop ,start))
,#body))
For example, (do-range (i 1 15 3) (format t "~A " i)) should print 1 4 7 10 13 and then return 14.
The problems include 1) potential capture of the second occurrence of limit, since it occurs as a free variable, 2) potential capture of the initial occurrence of the bound variable limit, since it occurs in an expression along with other variables appearing in the macro parameters, 3) out of order evaluation, since delta will be evaluated before stop, even though stop appears before delta in the parameter list, and 4) multiple variable evaluations, since stop and start are evaluated more than once. As I understand it, once-only should fix these problems:
(defmacro do-range ((var start stop delta) &body body)
(once-only (start stop delta limit)
`(do ((,var ,start (+ ,var ,delta))
(limit ,stop))
((> ,var limit) (- ,stop ,start))
,#body)))
However, (macroexpand '(do-range (i 1 15 3) (format t "~A " i))) complains about limit being an unbound variable. If I switch instead to with-gensyms, which should take care of problems 1 & 2 above only, the expansion proceeds without incident.
Is this an issue with the once-only macro? And does once-only really solve all the problems outlined above (and perhaps others)?
The ONCE-ONLY macro
To get rid of a warning that N is unused, I would change the macro to:
(defmacro once-only ((&rest names) &body body)
(let ((gensyms (loop for nil in names collect (gensym))))
; changed N to NIL, NIL is ignored
`(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 purpose of this macro is to make sure that expressions are only evaluated once and in a defined order. For that it will introduce new uninterned variables and will bind the evaluation results to those. Inside he macro the new variables are available. The macro itself is provided to make writing macros easier.
Using ONCE-ONLY in DO-RANGE
Your example use of ONCE-ONLY:
(defmacro do-range ((var start stop delta) &body body)
(once-only (start stop delta limit)
`(do ((,var ,start (+ ,var ,delta))
(limit ,stop))
((> ,var limit) (- ,stop ,start))
,#body)))
Why is there LIMIT in the once-only list? limit is undefined there. LIMIT is used inside the ONCE-ONLY form as a symbol, but outside there is no binding.
ONCE-ONLY expects that the list of names is a list of symbols and that these names are bound to forms. In your case limit is a symbol, but it is undefined.
We need to remove limit from the list of names:
(defmacro do-range ((var start stop delta) &body body)
(once-only (start stop delta)
`(do ((,var ,start (+ ,var ,delta))
(limit ,stop))
((> ,var limit) (- ,stop ,start))
,#body)))
Now, what to do about LIMIT? Given that once-only provides bindings for the names, including for STOP, we can eliminate the symbol LIMIT and replace its use with ,stop:
(defmacro do-range ((var start stop delta) &body body)
(once-only (start stop delta)
`(do ((,var ,start (+ ,var ,delta)))
((> ,var ,stop) (- ,stop ,start))
,#body)))
Example:
CL-USER 137 > (pprint
(macroexpand
'(do-range (i 4 10 2)
(print i))))
(LET ((#1=#:G2170 4)
(#3=#:G2171 10)
(#2=#:G2172 2))
(DO ((I #1# (+ I #2#)))
((> I #3#) (- #3# #1#))
(PRINT I)))
Often when I try to write a macro, I run up against the following difficulty: I need one form that is passed to the macro to be evaluated before being processed by a helper function that is invoked while generating the macro's expansion. In the following example, we are only interested in how we could write a macro to emit the code we want, and not in the uselessness of the macro itself:
Imagine (bear with me) a version of Common Lisp's lambda macro, where only the number of arguments is important, and the names and order of the arguments are not. Let's call it jlambda. It would be used like so:
(jlambda 2
...body)
where 2 is the arity of the function returned. In other words, this produces a binary operator.
Now imagine that, given the arity, jlambda produces a dummy lambda-list which it passes to the actual lambda macro, something like this:
(defun build-lambda-list (arity)
(assert (alexandria:non-negative-integer-p arity))
(loop for x below arity collect (gensym)))
(build-lambda-list 2)
==> (#:G15 #:G16)
The expansion of the above call to jlambda will look like this:
(lambda (#:G15 #:16)
(declare (ignore #:G15 #:16))
…body))
Let's say we need the jlambda macro to be able to receive the arity value as a Lisp form that evaluates to a non-negative integer (as opposed to receiving a non-negative integer directly) eg:
(jlambda (+ 1 1)
...body)
The form (+ 1 1) needs to be evaluated, then the result needs to be passed to build-lambda-list and that needs to be evaluated, and the result of that is inserted into the macro expansion.
(+ 1 1)
=> 2
(build-lambda-list 2)
=> (#:G17 #:18)
(jlambda (+ 1 1) ...body)
=> (lambda (#:G19 #:20)
(declare (ignore #:G19 #:20))
…body))
So here's a version of jlambda that works when the arity is provided as a number directly, but not when it's passed as a form to be evaluated:
(defun jlambda-helper (arity)
(let ((dummy-args (build-lambda-list arity)))
`(lambda ,dummy-args
(declare (ignore ,#dummy-args))
body)))
(defmacro jlambda (arity &body body)
(subst (car body) 'body (jlambda-helper arity)))
(jlambda 2 (print “hello”)) ==> #<anonymous-function>
(funcall *
'ignored-but-required-argument-a
'ignored-but-required-argument-b)
==> “hello”
“hello”
(jlambda (+ 1 1) (print “hello”)) ==> failed assertion in build-lambda-list, since it receives (+ 1 1) not 2
I could evaluate the (+ 1 1) using the sharp-dot read macro, like so:
(jlambda #.(+ 1 1) (print “hello”)) ==> #<anonymous-function>
But then the form cannot contain references to lexical variables, since they are not available when evaluating at read-time:
(let ((x 1))
;; Do other stuff with x, then:
(jlambda #.(+ x 1) (print “hello”))) ==> failure – variable x not bound
I could quote all body code that I pass to jlambda, define it as a function instead, and then eval the code that it returns:
(defun jlambda (arity &rest body)
(let ((dummy-args (build-lambda-list arity)))
`(lambda ,dummy-args
(declare (ignore ,#dummy-args))
,#body)))
(eval (jlambda (+ 1 1) `(print “hello”))) ==> #<anonymous-function>
But I can't use eval because, like sharp-dot, it throws out the lexical environment, which is no good.
So jlambda must be a macro, because I don't want the function body code evaluated until the proper context for it has been established by jlambda's expansion; however it must also be a function, because I want the first form (in this example, the arity form) evaluated before passing it to helper functions that generate the macro expansion. How do I overcome this Catch-22 situation?
EDIT
In response to #Sylwester 's question, here's an explanation of the context:
I'm writing something akin to an “esoteric programming language”, implemented as a DSL in Common Lisp. The idea (admittedly silly but potentially fun) is to force the programmer, as far as possible (I'm not sure how far yet!), to write exclusively in point-free style. To do this, I will do several things:
Use curry-compose-reader-macros to provide most of the functionality required to write in point-free style in CL
Enforce functions' arity – i.e. override CL's default behaviour that allows functions to be variadic
Instead of using a type system to determine when a function has been “fully applied” (like in Haskell), just manually specify a function's arity when defining it.
So I'll need a custom version of lambda for defining a function in this silly language, and – if I can't figure that out - a custom version of funcall and/or apply for invoking those functions. Ideally they'll just be skins over the normal CL versions that change the functionality slightly.
A function in this language will somehow have to keep track of its arity. However, for simplicity, I would like the procedure itself to still be a funcallable CL object, but would really like to avoid using the MetaObject Protocol, since it's even more confusing to me than macros.
A potentially simple solution would be to use a closure. Every function could simply close over the binding of a variable that stores its arity. When invoked, the arity value would determine the exact nature of the function application (i.e. full or partial application). If necessary, the closure could be “pandoric” in order to provide external access to the arity value; that could be achieved using plambda and with-pandoric from Let Over Lambda.
In general, functions in my language will behave like so (potentially buggy pseudocode, purely illustrative):
Let n be the number of arguments provided upon invocation of the function f of arity a.
If a = 0 and n != a, throw a “too many arguments” error;
Else if a != 0 and 0 < n < a, partially apply f to create a function g, whose arity is equal to a – n;
Else if n > a, throw a “too many arguments” error;
Else if n = a, fully apply the function to the arguments (or lack thereof).
The fact that the arity of g is equal to a – n is where the problem with jlambda would arise: g would need to be created like so:
(jlambda (- a n)
...body)
Which means that access to the lexical environment is a necessity.
This is a particularly tricky situation because there's no obvious way to create a function of a particular number of arguments at runtime. If there's no way to do that, then it's probably easiest to write a a function that takes an arity and another function, and wraps the function in a new function that requires that is provided the particular number of arguments:
(defun %jlambda (n function)
"Returns a function that accepts only N argument that calls the
provided FUNCTION with 0 arguments."
(lambda (&rest args)
(unless (eql n (length args))
(error "Wrong number of arguments."))
(funcall function)))
Once you have that, it's easy to write the macro around it that you'd like to be able to:
(defmacro jlambda (n &body body)
"Produces a function that takes exactly N arguments and and evalutes
the BODY."
`(%jlambda ,n (lambda () ,#body)))
And it behaves roughly the way you'd want it to, including letting the arity be something that isn't known at compile time.
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2 3))
HELLO
HELLO
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2))
; Evaluation aborted on #<SIMPLE-ERROR "Wrong number of arguments." {1004B95E63}>.
Now, you might be able to do something that invokes the compiler at runtime, possibly indirectly, using coerce, but that won't let the body of the function be able to refer to variables in the original lexical scope, though you would get the implementation's wrong number of arguments exception:
(defun %jlambda (n function)
(let ((arglist (loop for i below n collect (make-symbol (format nil "$~a" i)))))
(coerce `(lambda ,arglist
(declare (ignore ,#arglist))
(funcall ,function))
'function)))
(defmacro jlambda (n &body body)
`(%jlambda ,n (lambda () ,#body)))
This works in SBCL:
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2 3))
HELLO
CL-USER> (let ((a 10) (n 7))
(funcall (jlambda (- a n)
(print 'hello))
1 2))
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {1005259923}>.
While this works in SBCL, it's not clear to me whether it's actually guaranteed to work. We're using coerce to compile a function that has a literal function object in it. I'm not sure whether that's portable or not.
NB: In your code you use strange quotes so that (print “hello”) doesn't actually print hello but the whatever the variable “hello” evaluates to, while (print "hello") does what one would expect.
My first question is why? Usually you know how many arguments you are taking compile time or at least you just make it multiple arity. Making an n arity function only gives you errors when passwd with wrong number of arguments as added feature with the drawback of using eval and friends.
It cannot be solved as a macro since you are mixing runtime with macro expansion time. Imagine this use:
(defun test (last-index)
(let ((x (1+ last-index)))
(jlambda x (print "hello"))))
The macro is expanded when this form is evaluated and the content replaced before the function is assigned to test. At this time x doesn't have any value whatsoever and sure enough the macro function only gets the symbols so that the result need to use this value. lambda is a special form so it again gets expanded right after the expansion of jlambda, also before any usage of the function.
There is nothing lexical happening since this happens before the program is running. It could happen before loading the file with compile-file and then if you load it will load all forms with the macros already expanded beforehand.
With compile you can make a function from data. It is probably as evil as eval is so you shouldn't be using it for common tasks, but they exist for a reason:
;; Macro just to prevent evaluation of the body
(defmacro jlambda (nexpr &rest body)
`(let ((dummy-args (build-lambda-list ,nexpr)))
(compile nil (list* 'lambda dummy-args ',body))))
So the expansion of the first example turns into this:
(defun test (last-index)
(let ((x (1+ last-index)))
(let ((dummy-args (build-lambda-list x)))
(compile nil (list* 'lambda dummy-args '((print "hello")))))))
This looks like it could work. Lets test it:
(defparameter *test* (test 10))
(disassemble *test*)
;Disassembly of function nil
;(CONST 0) = "hello"
;11 required arguments <!-- this looks right
;0 optional arguments
;No rest parameter
;No keyword parameters
;4 byte-code instructions:
;0 (const&push 0) ; "hello"
;1 (push-unbound 1)
;3 (calls1 142) ; print
;5 (skip&ret 12)
;nil
Possible variations
I've made a macro that takes a literal number and makes bound variables from a ... that can be used in the function.
If you are not using the arguments why not make a macro that does this:
(defmacro jlambda2 (&rest body)
`(lambda (&rest #:rest) ,#body))
The result takes any number of arguments and just ignores it:
(defparameter *test* (jlambda2 (print "hello")))
(disassemble *test*)
;Disassembly of function :lambda
;(CONST 0) = "hello"
;0 required arguments
;0 optional arguments
;Rest parameter <!-- takes any numer of arguments
;No keyword parameters
;4 byte-code instructions:
;0 (const&push 0) ; "hello"
;1 (push-unbound 1)
;3 (calls1 142) ; print
;5 (skip&ret 2)
;nil
(funcall *test* 1 2 3 4 5 6 7)
; ==> "hello" (prints "hello" as side effect)
EDIT
Now that I know what you are up to I have an answer for you. Your initial function does not need to be runtime dependent so all functions indeed have a fixed arity, so what we need to make is currying or partial application.
;; currying
(defmacro fixlam ((&rest args) &body body)
(let ((args (reverse args)))
(loop :for arg :in args
:for r := `(lambda (,arg) ,#body)
:then `(lambda (,arg) ,r)
:finally (return r))))
(fixlam (a b c) (+ a b c))
; ==> #<function :lambda (a) (lambda (b) (lambda (c) (+ a b c)))>
;; can apply multiple and returns partially applied when not enough
(defmacro fixlam ((&rest args) &body body)
`(let ((lam (lambda ,args ,#body)))
(labels ((chk (args)
(cond ((> (length args) ,(length args)) (error "too many args"))
((= (length args) ,(length args)) (apply lam args))
(t (lambda (&rest extra-args)
(chk (append args extra-args)))))))
(lambda (&rest args)
(chk args)))))
(fixlam () "hello") ; ==> #<function :lambda (&rest args) (chk args)>
;;Same but the zero argument functions are applied right away:
(defmacro fixlam ((&rest args) &body body)
`(let ((lam (lambda ,args ,#body)))
(labels ((chk (args)
(cond ((> (length args) ,(length args)) (error "too many args"))
((= (length args) ,(length args)) (apply lam args))
(t (lambda (&rest extra-args)
(chk (append args extra-args)))))))
(chk '()))))
(fixlam () "hello") ; ==> "hello"
If all you want is lambda functions that can be applied either partially or fully, I don't think you need to pass the amount of parameters explicitly. You could just do something like this (uses Alexandria):
(defmacro jlambda (arglist &body body)
(with-gensyms (rest %jlambda)
`(named-lambda ,%jlambda (&rest ,rest)
(cond ((= (length ,rest) ,(length arglist))
(apply (lambda ,arglist ,#body) ,rest))
((> (length ,rest) ,(length arglist))
(error "Too many arguments"))
(t (apply #'curry #',%jlambda ,rest))))))
CL-USER> (jlambda (x y) (format t "X: ~s, Y: ~s~%" x y))
#<FUNCTION (LABELS #:%JLAMBDA1046) {1003839D6B}>
CL-USER> (funcall * 10) ; Apply partially
#<CLOSURE (LAMBDA (&REST ALEXANDRIA.0.DEV::MORE) :IN CURRY) {10038732DB}>
CL-USER> (funcall * 20) ; Apply fully
X: 10, Y: 20
NIL
CL-USER> (funcall ** 100) ; Apply fully again
X: 10, Y: 100
NIL
CL-USER> (funcall *** 100 200) ; Try giving a total of 3 args
; Debugger entered on #<SIMPLE-ERROR "Too many arguments" {100392D7E3}>
Edit: Here's also a version that lets you specify the arity. Frankly, I don't see how this could possibly be useful though. If the user cannot refer to the arguments, and nothing is done with them automatically, then, well, nothing is done with them. They might as well not exist.
(defmacro jlambda (arity &body body)
(with-gensyms (rest %jlambda n)
`(let ((,n ,arity))
(named-lambda ,%jlambda (&rest ,rest)
(cond ((= (length ,rest) ,n)
,#body)
((> (length ,rest) ,n)
(error "Too many arguments"))
(t (apply #'curry #',%jlambda ,rest)))))))
CL-USER> (jlambda (+ 1 1) (print "hello"))
#<CLOSURE (LABELS #:%JLAMBDA1085) {1003B7913B}>
CL-USER> (funcall * 2)
#<CLOSURE (LAMBDA (&REST ALEXANDRIA.0.DEV::MORE) :IN CURRY) {1003B7F7FB}>
CL-USER> (funcall * 5)
"hello"
"hello"
Edit2: If I understood correctly, you might be looking for something like this (?):
(defvar *stack* (list))
(defun jlambda (arity function)
(lambda ()
(push (apply function (loop repeat arity collect (pop *stack*)))
*stack*)))
CL-USER> (push 1 *stack*)
(1)
CL-USER> (push 2 *stack*)
(2 1)
CL-USER> (push 3 *stack*)
(3 2 1)
CL-USER> (push 4 *stack*)
(4 3 2 1)
CL-USER> (funcall (jlambda 4 #'+)) ; take 4 arguments from the stack
(10) ; and apply #'+ to them
CL-USER> (push 10 *stack*)
(10 10)
CL-USER> (push 20 *stack*)
(20 10 10)
CL-USER> (push 30 *stack*)
(30 20 10 10)
CL-USER> (funcall (jlambda 3 [{reduce #'*} #'list])) ; pop 3 args from
(6000 10) ; stack, make a list
; of them and reduce
; it with #'*
I'm trying to teach myself common lisp, and as an exercise in macro-writing, I'm trying to create a a macro to define a nested-do loop of arbitrary depth. I'm working with sbcl, using emacs and slime.
To start, I wrote this double-loop macro:
(defmacro nested-do-2 (ii jj start end &body body)
`(do ((,ii ,start (1+ ,ii)))
((> ,ii ,end))
(do ((,jj ,ii (1+ ,jj)))
((> ,jj ,end))
,#body)))
which I could then use as follows:
(nested-do-2 ii jj 10 20 (print (+ ii jj)))
BTW, I originally wrote this macro using gensym to generate the loop counters (ii, jj), but then I realized that the macro was pretty useless if I couldn't access the counters in the body.
Anyway, I would like to generalize the macro to create a nested-do loop that would be nested to an arbitrary level. This is what I've got so far, but it doesn't quite work:
(defmacro nested-do ((&rest indices) start end &body body)
`(dolist ((index ,indices))
(do ((index ,start (1+ index)))
((> index ,end))
(if (eql index (elt ,indices (elt (reverse ,indices) 0)))
,#body))))
which I would like to invoke as follows:
(nested-do (ii jj kk) 10 15 (print (+ ii jj kk)))
However, the list is not being expanded properly, and I end up in the debugger with this error:
error while parsing arguments to DEFMACRO DOLIST:
invalid number of elements in
((INDEX (II JJ KK)))
And in case it's not obvious, the point of the embedded if statement is to execute the body only in the innermost loop. That doesn't seem terribly elegant to me, and it's not really tested (since I haven't been able to expand the parameter list yet), but it's not really the point of this question.
How can I expand the list properly within the macro? Is the problem in the macro syntax, or in the expression of the list in the function call? Any other comments will also be appreciated.
Thanks in advance.
Here's one way to do it - build the structure from the bottom (loop body) up each index:
(defmacro nested-do ((&rest indices) start end &body body)
(let ((rez `(progn ,#body)))
(dolist (index (reverse indices) rez)
(setf rez
`(do ((,index ,start (1+ ,index)))
((> ,index ,end))
,rez)))))
[Aside from the down votes, this actually works and it is beautiful too!]
Just to clearly illustrate the recursive nature of the macro definition, here is a Scheme implementation:
(define-syntax nested-do
(syntax-rules ()
((_ ((index start end)) body)
(do ((index start (+ 1 index)))
((= index end))
body))
((_ ((index start end) rest ...) body)
(do ((index start (+ 1 index)))
((= index end))
(nested-do (rest ...) body)))))
Using the above, as a template, something like this gets it done:
(defmacro nested-do ((&rest indices) start end &body body)
(let ((index (car indices)))
`(do ((,index ,start (1+ ,index)))
((> ,index ,end))
,(if (null (cdr indices))
`(progn ,#body)
`(nested-do (,#(cdr indices)) ,start ,end ,#body)))))
* (nested-do (i j) 0 2 (print (list i j)))
(0 0)
(0 1)
(0 2)
(1 0)
(1 1)
(1 2)
(2 0)
(2 1)
(2 2)
NIL
Note that with all Common-Lisp macros you'll need to use the 'gensym' patterns to avoid variable capture.