Related
Prelude
In Raku there's a notion called infinite list AKA lazy list which is defined and used like:
my #inf = (1,2,3 ... Inf);
for #inf { say $_;
exit if $_ == 7 }
# => OUTPUT
1
2
3
4
5
6
7
I'd like to implement this sort of thing in Common Lisp, specifically an infinite list of consecutive integers like:
(defun inf (n)
("the implementation"))
such that
(inf 5)
=> (5 6 7 8 9 10 .... infinity)
;; hypothetical output just for the demo purposes. It won't be used in reality
Then I'll use it for lazy evaluation like this:
(defun try () ;; catch and dolist
(catch 'foo ;; are just for demo purposes
(dolist (n (inf 1) 'done)
(format t "~A~%" n)
(when (= n 7)
(throw 'foo x)))))
CL-USER> (try)
1
2
3
4
5
6
7
; Evaluation aborted.
How can I implement such an infinite list in CL in the most practical way?
A good pedagogical approach to this is to define things which are sometimes called 'streams'. The single best introduction to doing this that I know of is in Structure and Interpretation of Computer Programs. Streams are introduced in section 3.5, but don't just read that: read the book, seriously: it is a book everyone interested in programming should read.
SICP uses Scheme, and this sort of thing is more natural in Scheme. But it can be done in CL reasonably easily. What I've written below is rather 'Schemy' CL: in particular I just assume tail calls are optimised. That's not a safe assumption in CL, but it's good enough to see how you can build these concepts into a language which does not already have them, if your language is competent.
First of all we need a construct which supports lazy evaluation: we need to be able to 'delay' something to create a 'promise' which will be evaluated only when it needs to be. Well, what functions do is evaluate their body only when they are asked to, so we'll use them:
(defmacro delay (form)
(let ((stashn (make-symbol "STASH"))
(forcedn (make-symbol "FORCED")))
`(let ((,stashn nil)
(,forcedn nil))
(lambda ()
(if ,forcedn
,stashn
(setf ,forcedn t
,stashn ,form))))))
(defun force (thing)
(funcall thing))
delay is mildly fiddly, it wants to make sure that a promise is forced only once, and it also wants to make sure that the form being delayed doesn't get infected by the state it uses to do that. You can trace the expansion of delay to see what it makes:
(delay (print 1))
-> (let ((#:stash nil) (#:forced nil))
(lambda ()
(if #:forced #:stash (setf #:forced t #:stash (print 1)))))
This is fine.
So now, we'll invent streams: streams are like conses (they are conses!) but their cdrs are delayed:
(defmacro cons-stream (car cdr)
`(cons ,car (delay ,cdr)))
(defun stream-car (s)
(car s))
(defun stream-cdr (s)
(force (cdr s)))
OK, let's write a function to get the nth element of a stream:
(defun stream-nth (n s)
(cond ((null s)
nil)
((= n 0) (stream-car s))
(t
(stream-nth (1- n) (stream-cdr s)))))
And we can test this:
> (stream-nth 2
(cons-stream 0 (cons-stream 1 (cons-stream 2 nil))))
2
And now we can write a function to enumerate an interval in the naturals, which by default will be an half-infinite interval:
(defun stream-enumerate-interval (low &optional (high nil))
(if (and high (> low high))
nil
(cons-stream
low
(stream-enumerate-interval (1+ low) high))))
And now:
> (stream-nth 1000 (stream-enumerate-interval 0))
1000
And so on.
Well, we'd like some kind of macro which lets us traverse a stream: something like dolist, but for streams. Well we can do this by first writing a function which will call a function for each element in the stream (this is not the way I'd do this in production CL code, but it's fine here):
(defun call/stream-elements (f s)
;; Call f on the elements of s, returning NIL
(if (null s)
nil
(progn
(funcall f (stream-car s))
(call/stream-elements f (stream-cdr s)))))
And now
(defmacro do-stream ((e s &optional (r 'nil)) &body forms)
`(progn
(call/stream-elements (lambda (,e)
,#forms)
,s)
,r))
And now, for instance
(defun look-for (v s)
;; look for an element of S which is EQL to V
(do-stream (e s (values nil nil))
(when (eql e v)
(return-from look-for (values e t)))))
And we can then say
> (look-for 100 (stream-enumerate-interval 0))
100
t
Well, there is a lot more mechanism you need to make streams really useful: you need to be able to combine them, append them and so on. SICP has many of these functions, and they're generally easy to turn into CL, but too long here.
For practical purposes it would be wise to use existing libraries, but since the question is about how to implemented lazy lists, we will do it from scratch.
Closures
Lazy iteration is a matter of producing an object that can generate the new value of a lazy sequence each time it is asked to do so.
A simple approach for this is to return a closure, i.e. a function that closes over variables, which produces values while updating its state by side-effect.
If you evaluate:
(let ((a 0))
(lambda () (incf a)))
You obtain a function object that has a local state, namely here the variable named a.
This is a lexical binding to a location that is exclusive to this function, if you evaluate a second time the same expression, you'll obtain a different anonymous function that has its own local state.
When you call the closure, the value stored in a in incremented and its value is returned.
Let's bind this closure to a variable named counter, call it multiple times and store the successive results in a list:
(let ((counter (let ((a 0))
(lambda () (incf a)))))
(list (funcall counter)
(funcall counter)
(funcall counter)
(funcall counter)))
The resulting list is:
(1 2 3 4)
Simple iterator
In your case, you want to have an iterator that starts counting from 5 when writing:
(inf 5)
This can implemented as follows:
(defun inf (n)
(lambda ()
(shiftf n (1+ n))))
Here is there is no need to add a let, the lexical binding of an argument to n is done when calling the function.
We assign n to a different value within the body over time.
More precisely, SHIFTF assigns n to (1+ n), but returns the previous value of n.
For example:
(let ((it (inf 5)))
(list (funcall it)
(funcall it)
(funcall it)
(funcall it)))
Which gives:
(5 6 7 8)
Generic iterator
The standard dolist expects a proper list as an input, there is no way you can put another kind of data and expect it to work (or maybe in an implementation-specific way).
We need a similar macro to iterate over all the values in an arbitrary iterator.
We also need to specify when iteration stops.
There are multiple possibilities here, let's define a basic iteration protocol as follows:
we can call make-iterator on any object, along with arbitrary arguments, to obtain an iterator
we can call next on an iterator to obtain the next value.
More precisely, if there is a value, next returns the value and T as a secondary value; otherwise, next returns NIL.
Let's define two generic functions:
(defgeneric make-iterator (object &key)
(:documentation "create an iterator for OBJECT and arguments ARGS"))
(defgeneric next (iterator)
(:documentation "returns the next value and T as a secondary value, or NIL"))
Using generic functions allows the user to define custom iterators, as long as they respect the specified behaviour above.
Instead of using dolist, which only works with eager sequences, we define our own macro: for.
It hides calls to make-iterator and next from the user.
In other words, for takes an object and iterates over it.
We can skip iteration with (return v) since for is implemented with loop.
(defmacro for ((value object &rest args) &body body)
(let ((it (gensym)) (exists (gensym)))
`(let ((,it (make-iterator ,object ,#args)))
(loop
(multiple-value-bind (,value ,exists) (next ,it)
(unless ,exists
(return))
,#body)))))
We assume any function object can act as an iterator, so we specialize next for values f of class function, so that the function f gets called:
(defmethod next ((f function))
"A closure is an interator"
(funcall f))
Also, we can also specialize make-iterator to make closures their own iterators (I see no other good default behaviour to provide for closures):
(defmethod make-iterator ((function function) &key)
function)
Vector iterator
For example, we can built an iterator for vectors as follows. We specialize make-iterator for values (here named vec) of class vector.
The returned iterator is a closure, so we will be able to call next on it.
The method accepts a :start argument defaulting to zero:
(defmethod make-iterator ((vec vector) &key (start 0))
"Vector iterator"
(let ((index start))
(lambda ()
(when (array-in-bounds-p vec index)
(values (aref vec (shiftf index (1+ index))) t)))))
You can now write:
(for (v "abcdefg" :start 2)
(print v))
And this prints the following characters:
#\c
#\d
#\e
#\f
#\g
List iterator
Likewise, we can build a list iterator.
Here to demonstrate other kind of iterators, let's have a custom cursor type.
(defstruct list-cursor head)
The cursor is an object which keeps a reference to the current cons-cell in the list being visited, or NIL.
(defmethod make-iterator ((list list) &key)
"List iterator"
(make-list-cursor :head list))
And we define next as follows, specializeing on list-cursor:
(defmethod next ((cursor list-cursor))
(when (list-cursor-head cursor)
(values (pop (list-cursor-head cursor)) t)))
Ranges
Common Lisp also allows methods to be specialized with EQL specializers, which means the object we give to for might be a specific keyword, for example :range.
(defmethod make-iterator ((_ (eql :range)) &key (from 0) (to :infinity) (by 1))
(check-type from number)
(check-type to (or number (eql :infinity)))
(check-type by number)
(let ((counter from))
(case to
(:infinity
(lambda () (values (incf counter by) t)))
(t
(lambda ()
(when (< counter to)
(values (incf counter by) T)))))))
A possible call for make-iterator would be:
(make-iterator :range :from 0 :to 10 :by 2)
This also returns a closure.
Here, for example, you would iterate over a range as follows:
(for (v :range :from 0 :to 10 :by 2)
(print v))
The above expands as:
(let ((#:g1463 (make-iterator :range :from 0 :to 10 :by 2)))
(loop
(multiple-value-bind (v #:g1464)
(next #:g1463)
(unless #:g1464 (return))
(print v))))
Finally, if we add small modification to inf (adding secondary value):
(defun inf (n)
(lambda ()
(values (shiftf n (1+ n)) T)))
We can write:
(for (v (inf 5))
(print v)
(when (= v 7)
(return)))
Which prints:
5
6
7
I'll show it with a library:
How to create and consume an infinite list of integers with the GTWIWTG generators library
This library, called "Generators The Way I Want Them Generated", allows to do three things:
create generators (iterators)
combine them
consume them (once).
It is not unsimilar to the nearly-classic Series.
Install the lib with (ql:quickload "gtwiwtg"). I will work in its package: (in-package :gtwiwtg).
Create a generator for an infinite list of integers, start from 0:
GTWIWTG> (range)
#<RANGE-BACKED-GENERATOR! {10042B4D83}>
We can also specify its :from, :to, :by and :inclusive parameters.
Combine this generator with others: not needed here.
Iterate over it and stop:
GTWIWTG> (for x *
(print x)
(when (= x 7)
(return)))
0
1
2
3
4
5
6
7
T
This solution is very practical :)
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
)
)
)
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 different binding models for macro lambda lists.
Edit: in fact the lambda list for my test macros is always (&rest ...). Which means that I'm 'destructuring' the argument list and not the lambda list. I try to get a solution that works for combining optional with key arguments or rest/body with key arguments - both combinations don't work in the Common Lisp standard implementation.
So I have different functions giving me a list of bindings having the same syntax as used by 'let'.
E.g:
(build-bindings ...) => ((first 1) middle (last "three"))
Now I thought to use a simple macro inside my test macros feeding such a list to 'let'.
This is trivial if I have a literal list:
(defmacro let-list (_list &rest _body)
`(let ,_list ,#_body))
(let-list ((a 236)) a) => 236
But that's the same as a plain 'let'.
What I'd like to have is the same thing with a generated list.
So e.g.
(let-list (build-bindings ...)
(format t "first: ~s~%" first)
last)
with (build-bindings ...), evaluated in the same lexical scope as the call (let-list ...), returning
((first 1) middle (last "three"))
the expansion of the macro should be
(let
((first 1) middle (last "three"))
(format t "first: ~s~%" first)
last)
and should print 1 and return "three".
Any idea how to accomplish that?
Edit (to make the question more general):
If I have a list of (symbol value) pairs, i.e. same syntax that let requires for it's list of bindings, e.g. ((one 1) (two 'two) (three "three")), is there any way to write a macro that creates lexical bindings of the symbols with the supplied values for it's &rest/&body parameter?
This is seems to be a possible solution which Joshua pointed me to:
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))
evaluates to:
;Compiler warnings :
; In an anonymous lambda form: Undeclared free variable X
; In an anonymous lambda form: Undeclared free variable Y
; In an anonymous lambda form: Undeclared free variable Z
x 23, y 6, z NIL
I could also easily rearrange my build-bindings functions to return the two lists needed.
One problem is, that the compiler spits warnings if the variables have never been declared special.
And the other problem that, if the dynamically bound variables are also used in a surrounding lexical binding, they a shadowed by the lexical binding - again if they have never been declared special:
(let ((x 47) (y 11) (z 0))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z)))))
evaluates to:
x 47, y 11, z 0
A better way could be:
(let ((x 47) (y 11) (z 0))
(locally
(declare (special x y))
(let ((list_ '((x 23) (y 6) z)))
(let
((symbols_(loop for item_ in list_
collect (if (listp item_) (car item_) item_)))
(values_ (loop for item_ in list_
collect (if (listp item_) (cadr item_) nil))))
(progv symbols_ values_
(format t "x ~s, y ~s, z ~s~%" x y z))))))
evaluates to:
;Compiler warnings about unused lexical variables skipped
x 23, y 6, z NIL
I can't see at the moment whether there are other problems with the dynamic progv bindings.
But the whole enchilada of a progv wrapped in locally with all the symbols declared as special cries for a macro again - which is again not possible due to same reasons let-list doesn't work :(
The possiblilty would be a kind of macro-lambda-list destructuring-hook which I'm not aware of.
I have to look into the implementation of destructuring-bind since that macro does kind of what I'd like to do. Perhaps that will enlight me ;)
So a first (incorrect) attempt would look something like this:
(defun build-bindings ()
'((first 1) middle (last "three")))
(defmacro let-list (bindings &body body)
`(let ,bindings
,#body))
Then you could try doing something like:
(let-list (build-bindings)
(print first))
That won't work, of course, because the macro expansion leaves the form (build-bindings) in the resulting let, in a position where it won't be evaluated:
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET (BUILD-BINDINGS)
(PRINT FIRST))
Evaluation during Macroexpansion time
The issue is that you want the result of build-bindings at macroexpansion time, and that's before the code as a whole is run. Now, in this example, build-bindings can be run at macroexpansion time, because it's not doing anything with any arguments (remember I asked in a comment what the arguments are?). That means that you could actually eval it in the macroexpansion:
(defmacro let-list (bindings &body body)
`(let ,(eval bindings)
,#body))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings)
(print first))))
(LET ((FIRST 1) MIDDLE (LAST "three"))
(PRINT FIRST))
Now that will work, insofar as it will bind first, middle, and last to 1, nil, and "three", respectively. However, if build-bindings actually needed some arguments that weren't available at macroexpansion time, you'd be out of luck. First, it can take arguments that are available at macroexpansion time (e.g., constants):
(defun build-bindings (a b &rest cs)
`((first ',a) (middle ',b) (last ',cs)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 1 2 3 4 5)
(print first))))
(LET ((FIRST '1) (MIDDLE '2) (LAST '(3 4 5)))
(PRINT FIRST))
You could also have some of the variables appear in there:
(defun build-bindings (x ex y why)
`((,x ,ex) (,y ,why)))
CL-USER> (pprint (macroexpand-1 '(let-list (build-bindings 'a 'ay 'b 'bee)
(print first))))
(LET ((A AY) (B BEE))
(PRINT FIRST))
What you can't do, though, is have the variable names be determined from values that don't exist until runtime. E.g., you can't do something like:
(let ((var1 'a)
(var2 'b))
(let-list (build-bindings var1 'ay var2 'bee)
(print first))
because (let-list (build-bindings …) …) is macroexpanded before any of this code is actually executed. That means that you'd be trying to evaluate (build-bindings var1 'ay var2 'bee) when var1 and var2 aren't bound to any values.
Common Lisp does all its macroexpansion first, and then evaluates code. That means that values that aren't available until runtime are not available at macroexpansion time.
Compilation (and Macroexpansion) at Runtime
Now, even though I said that Common Lisp does all its macroexpansion first, and then evaluates code, the code above actually uses eval at macroexpansion to get some extra evaluation earlier. We can do things in the other direction too; we can use compile at runtime. That means that we can generate a lambda function and compile it based on code (e.g., variable names) provided at runtime. We can actually do this without using a macro:
(defun %dynamic-lambda (bindings body)
(flet ((to-list (x) (if (listp x) x (list x))))
(let* ((bindings (mapcar #'to-list bindings))
(vars (mapcar #'first bindings))
(vals (mapcar #'second bindings)))
(apply (compile nil `(lambda ,vars ,#body)) vals))))
CL-USER> (%dynamic-lambda '((first 1) middle (last "three"))
'((list first middle last)))
;=> (1 NIL "three")
This compiles a lambda expression that is created at runtime from a body and a list of bindings. It's not hard to write a macro that takes some fo the quoting hassle out of the picture:
(defmacro let-list (bindings &body body)
`(%dynamic-lambda ,bindings ',body))
CL-USER> (let-list '((first 1) middle (last "three"))
(list first middle last))
;=> (1 NIL "three")
CL-USER> (macroexpand-1 '(let-list (build-bindings)
(list first middle last)))
;=> (%DYNAMIC-LAMBDA (BUILD-BINDINGS) '((LIST FIRST MIDDLE LAST)))
CL-USER> (flet ((build-bindings ()
'((first 1) middle (last "three"))))
(let-list (build-bindings)
(list first middle last)))
;=> (1 NIL "three")
This gives you genuine lexical variables from a binding list created at runtime. Of course, because the compilation is happening at runtime, you lose access to the lexical environment. That means that the body that you're compiling into a function cannot access the "surrounding" lexical scope. E.g.:
CL-USER> (let ((x 3))
(let-list '((y 4))
(list x y)))
; Evaluation aborted on #<UNBOUND-VARIABLE X {1005B6C2B3}>.
Using PROGV and special variables
If you don't need lexical variables, but can use special (i.e., dynamically scoped) variables instead, you can establish bindings at runtime using progv. That would look something like:
(progv '(a b c) '(1 2 3)
(list c b a))
;;=> (3 2 1)
You'll probably get some warnings with that if run it, because when the form is compiled, there's no way to know that a, b, and c are supposed to be special variables. You can use locally to add some special declarations, though:
(progv '(a b c) '(1 2 3)
(locally
(declare (special a b c))
(list c b a)))
;;=> (3 2 1)
Of course, if you're doing this, then you have to know the variables in advance which is exactly what you were trying to avoid in the first place. However, if you're willing to know the names of the variables in advance (and your comments seem like you might be okay with that), then you can actually use lexical variables.
Lexical variables with values computed at run time
If you're willing to state what the variables will be, but still want to compute their values dynamically at run time, you can do that relatively easily. First, lets write the direct version (with no macro):
;; Declare three lexical variables, a, b, and c.
(let (a b c)
;; Iterate through a list of bindings (as for LET)
;; and based on the name in the binding, assign the
;; corresponding value to the lexical variable that
;; is identified by the same symbol in the source:
(dolist (binding '((c 3) (a 1) b))
(destructuring-bind (var &optional value)
(if (listp binding) binding (list binding))
(ecase var
(a (setf a value))
(b (setf b value))
(c (setf c value)))))
;; Do something with the lexical variables:
(list a b c))
;;=> (1 NIL 3)
Now, it's not too hard to write a macrofied version of this. This version isn't perfect, (e.g., there could be hygiene issues with names, and declarations in the body won't work (because the body is being spliced in after some stuff). It's a start, though:
(defmacro computed-let (variables bindings &body body)
(let ((assign (gensym (string '#:assign-))))
`(let ,variables
(flet ((,assign (binding)
(destructuring-bind (variable &optional value)
(if (listp binding) binding (list binding))
(ecase variable
,#(mapcar (lambda (variable)
`(,variable (setf ,variable value)))
variables)))))
(map nil #',assign ,bindings))
,#body)))
(computed-let (a b c) '((a 1) b (c 3))
(list a b c))
;;=> (1 NIL 3)
One way of making this cleaner would be to avoid the assignment altogether, and the computed values to provide the values for the binding directly:
(defmacro computed-let (variables bindings &body body)
(let ((values (gensym (string '#:values-)))
(variable (gensym (string '#:variable-))))
`(apply #'(lambda ,variables ,#body)
(let ((,values (mapcar #'to-list ,bindings)))
(mapcar (lambda (,variable)
(second (find ,variable ,values :key 'first)))
',variables)))))
This version creates a lambda function where the arguments are the specified variables and the body is the provided body (so the declarations in the body are in an appropriate place), and then applies it to a list of values extracted from the result of the computed bindings.
Using LAMBDA or DESTRUCTURING-BIND
since I'm doing some "destructuring" of the arguments (in a bit a different way), I know which arguments must be present or have which
default values in case of missing optional and key arguments. So in
the first step I get a list of values and a flag whether an optional
or key argument was present or defaulted. In the second step I would
like to bind those values and/or present/default flag to local
variables to do some work with them
This is actually starting to sound like you can do what you need to by using a lambda function or destructuring-bind with keyword arguments. First, note that you can use any symbol as a keyword argument indicator. E.g.:
(apply (lambda (&key
((b bee) 'default-bee b?)
((c see) 'default-see c?))
(list bee b? see c?))
'(b 42))
;;=> (42 T DEFAULT-SEE NIL)
(destructuring-bind (&key ((b bee) 'default-bee b?)
((c see) 'default-see c?))
'(b 42)
(list bee b? see c?))
;;=> (42 T DEFAULT-SEE NIL)
So, if you just make your function return bindings as a list of keyword arguments, then in the destructuring or function application you can automatically bind corresponding variables, assign default values, and check whether non-default values were provided.
Acting a bit indirectly:
a solution that works for combining optional with key arguments or
rest/body with key arguments
Have you considered the not-entirely-uncommon paradigm of using a sub-list for the keywords?
e.g.
(defmacro something (&key (first 1) second) &body body) ... )
or, a practical use from Alexandria:
(defmacro with-output-to-file ((stream-name file-name
&rest args
&key (direction nil direction-p)
&allow-other-keys)
&body body)
I am learning common lisp and tried to implement a swap value function to swap two variables' value. Why the following does not work?
(defun swap-value (a b)
(setf tmp 0)
(progn
((setf tmp a)
(setf a b)
(setf b tmp))))
Error info:
in: LAMBDA NIL
; ((SETF TMP A) (SETF A B) (SETF B TMP))
;
; caught ERROR:
; illegal function call
; (SB-INT:NAMED-LAMBDA SWAP-VALUE
; (A B)
You can use the ROTATEF macro to swap the values of two places. More generally, ROTATEF rotates the contents of all the places to the left. The contents of the
leftmost place is put into the rightmost place. It can thus be used with more than two places.
dfan is right, this isn't going to swap the two values.
The reason you are getting that error though is that this:
(progn
((setf tmp a)
(setf a b)
(setf b tmp)))
should be this:
(progn
(setf tmp a)
(setf a b)
(setf b tmp))
The first progn has one s-expression in the body, and it's treated
as an application of the function (setf tmp a). In Common Lisp, I
think that only variables or lambda forms can be in the function
position of an application. I could be wrong about the details here,
but I know there are restrictions in CL that aren't in Scheme. That's
why it's an illegal call.
For instance, this is illegal in CL and results in the same error:
CL-USER> ((if (< 1 2) #'+ #'*) 2 3)
; in: LAMBDA NIL
; ((IF (< 1 2) #'+ #'*) 2 3)
;
; caught ERROR:
; illegal function call
;
; compilation unit finished
; caught 1 ERROR condition
You COULD write a swap as a macro (WARNING: I'm a Lisp noob, this
might be a terrible reason for a macro and a poorly written one!)
(defmacro swap (a b)
(let ((tmp (gensym)))
`(progn
(setf ,tmp ,a)
(setf ,a ,b)
(setf ,b ,tmp))))
Nope! Don't do this. Use rotatef as Terje Norderhaug points out.
A function (rather than macro) swapping two special variables can take the variable symbols as arguments. That is, you quote the symbols in the call. Below is an implementation of such a swap function:
(defvar *a* 1)
(defvar *b* 2)
(defun swap-values (sym1 sym2)
(let ((tmp (symbol-value sym1)))
(values
(set sym1 (symbol-value sym2))
(set sym2 tmp))))
? (swap-values '*a* '*b*)
2
1
? *a*
2
Note the use of defvar to define global/special variables and the per convention use of earmuffs (the stars) in their names. The symbol-value function provides the value of a symbol, while set assigns a value to the symbol resulting from evaluating its first argument. The values is there to make the function return both values from the two set statements.
You can not use setf to build a lexical variable tmp. You can use let, as follow:
(defun swap-value (a b)
(let ((tmp 0))
(setf tmp a)
(setf a b)
(setf b tmp))
(values a b))
which will do you hope.
Complimentary to other answers, the OP's targeted problem - the (multiple) value assignment issue - can be solved by parallel assignment using psetf:
(let ((a 21)
(b 42))
(psetf a b
b a)
(print (list a b)))
;; (42 21)