I found myself calling lots of methods whose first argument is a complex object from a given class.
Whilst with-slots and with-accessors are useful, generic methods cannot be bound in this way. So I thought: if we could locally curry any functions, slots + accessors + generic functions + functions could all be addressed with the same construct.
Example of code I want to clean up:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(loop while (and (char/= #\" (peek scanner))
(not (at-end-p scanner)))
do
(if (char= #\Newline (peek scanner)) (incf (line scanner))
(advance scanner)))
(when (at-end-p scanner)
(clox.error::clox-error (line scanner) "Unterminated string.")
(return-from clox-string nil))
(advance scanner) ;; consume closing "
(add-token scanner 'STRING (subseq (source scanner)
(1+ (start scanner))
(1- (current scanner)))))
This would be cleaner (I'm imitating this in CL https://craftinginterpreters.com/scanning.html#reserved-words-and-identifiers but I often end up with more verbose and less readable code than in Java - specially when using this classes a lot). As in CL methods don't belong to classes you end up declaring such arguments over and over. This would be a bit better:
(defun clox-string (scanner)
"Parse string into a token and add it to tokens"
(let-curry scanner (peek at-end-p line source start current advance add-token)
(loop while (and (char/= #\" (peek))
(not (at-end-p)))
do
(if (char= #\Newline (peek)) (incf (line))
(advance)))
(when (at-end-p)
(clox.error::clox-error (line) "Unterminated string.")
(return-from clox-string nil))
(advance) ;; consume closing "
(add-token 'STRING (subseq (source)
(1+ (start))
(1- (current)))))
sketch of macro (not working):
;; Clearly not as I don't understand macros very well :) non-working code:
(defmacro let-curry (obj functions &body body)
"Locally curry all functions"
(let ((fn (gensym)))
`(flet (loop
for ,fn in ,functions
collect (list ,fn (&rest args)
(funcall ,fn ,obj args)))
,#body)))
EDIT (ADD): Notice that scanner is a class; start, source, line, etc., accessors to the slots with the same name; add-token a generic function of more than one argument, advance a generic method of one argument:
(defclass scanner ()
((source
:initarg :source
:accessor source)
...
(...)))
(defmethod advance ((scanner scanner)) ...)
(defmethod add-token ((scanner scanner) token-type) ...)
Simpler Example with error:
;; With
(defun add (x y) (+ x y))
(defun mul (x y) (* x y))
;; I want to have this:
(let-curry 1000 (add mul)
(print (add 3))
(print (mul 3)))
;; expanding to:
(flet ((add (y) (add 1000 y))
(mul (y) (mul 1000 y)))
(print (add 3))
(print (mul 3)))
;; but instead I'm getting:
Execution of a form compiled with errors.
Form:
(FLET (LOOP
FOR
#1=#:G777
IN
(ADD MUL
)
COLLECT
(LIST #1#
(&REST ARGS)
(FUNCALL #1# 1000 ARGS)))
(PRINT (ADD 3))
(PRINT (MUL 3)))
Compile-time error:
The FLET definition spec LOOP is malformed.
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Thanks! The basic question is: is it possible to make such macro work?
Your version didn't expand to what you wanted but:
(flet (loop for #:g8307 in (add mul) collect (list #:g8307 (&rest args) (funcall #:g8307 1000 args)))
(print (add 3)) (print (mul 3)))
Now the loop needs to be done at macro expansion time.
Here is a working version:
(defmacro let-curry (obj (&rest functions) &body body)
"Locally curry all functions"
`(flet ,(loop for fn in functions
collect `(,fn (&rest args)
(apply #',fn ,obj args)))
,#body))
;; test it using add and mul from OP
(macroexpand-1 '(let-curry 10 (add mul) (list (add 5) (mul 5))))
;; ==>
(flet ((add (&rest args) (apply #'add 10 args))
(mul (&rest args) (apply #'mul 10 args)))
(list (add 5) (mul 5)))
(let-curry 10 (add mul) (list (add 5) (mul 5)))
;; ==> (15 50)
Using gensym is only needed if you are in danger of shadowing/colliding something or to ensure evaluation order is least surprising, but in your case you actually want to shadow the original names with the curried version so it makes sense to just use the original name.
If you want to have more than one argument you should use apply
since you know the function is in the function namespace you need to call #'symbol instead of symbol.
I've done (&rest functions) instead of functions in the prototype that with bad usage (not a list) you get a compile time error and it is more preciese.
Related
contextualization: I've been doing a university project in which I have to write a parser for regular expressions and build the corresponding epsilon-NFA. I have to do this in Prolog and Lisp.
I don't know if questions like this are allowed, if not I apologize.
I heard some of my classmates talking about how they used the function gensym for that, I asked them what it did and even checked up online but I literally can't understand what this function does neither why or when is best to use it.
In particular, I'm more intrested in what it does in Lisp.
Thank you all.
GENSYM creates unique symbols. Each call creates a new symbol. The symbol usually has a name which includes a number, which is counted up. The name is also unique (the symbol itself is already unique) with a number, so that a human reader can identify different uninterned symbols in the source code.
CL-USER 39 > (gensym)
#:G1083
CL-USER 40 > (gensym)
#:G1084
CL-USER 41 > (gensym)
#:G1085
CL-USER 42 > (gensym)
#:G1086
gensym is often used in Lisp macros for code generation, when the macro needs to create new identifiers, which then don't clash with existing identifiers.
Example: we are going to double the result of a Lisp form and we are making sure that the Lisp form itself will be computed only once. We do that by saving the value in a local variable. The identifier for the local variable will be computed by gensym.
CL-USER 43 > (defmacro double-it (it)
(let ((new-identifier (gensym)))
`(let ((,new-identifier ,it))
(+ ,new-identifier ,new-identifier))))
DOUBLE-IT
CL-USER 44 > (macroexpand-1 '(double-it (cos 1.4)))
(LET ((#:G1091 (COS 1.4)))
(+ #:G1091 #:G1091))
T
CL-USER 45 > (double-it (cos 1.4))
0.33993432
a little clarification of the existing answers (as the op is not yet aware of the typical common lisp macros workflow):
consider the macro double-it, proposed by mr. Joswig. Why would we bother creating this whole bunch of let? when it can be simply:
(defmacro double-it (it)
`(+ ,it ,it))
and ok, it seems to be working:
CL-USER> (double-it 1)
;;=> 2
but look at this, we want to increment x and double it
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 5
;; WHAT? it should be 4!
the reason can be seen in macro expansion:
(let ((x 1))
(+ (setq x (+ 1 x)) (setq x (+ 1 x))))
you see, as the macro doesn't evaluate form, just splices it into generated code, it leads to incf being executed twice.
the simple solution is to bind it somewhere, and then double the result:
(defmacro double-it (it)
`(let ((x ,it))
(+ x x)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> 4
;; NICE!
it seems to be ok now. really it expands like this:
(let ((x 1))
(let ((x (setq x (+ 1 x))))
(+ x x)))
ok, so what about the gensym thing?
let's say, you want to print some message, before doubling your value:
(defmacro double-it (it)
`(let* ((v "DOUBLING IT")
(val ,it))
(princ v)
(+ val val)))
CL-USER> (let ((x 1))
(double-it (incf x)))
;;=> DOUBLING IT
;;=> 4
;; still ok!
but what if you accidentally name value v instead of x:
CL-USER> (let ((v 1))
(double-it (incf v)))
;;Value of V in (+ 1 V) is "DOUBLING IT", not a NUMBER.
;; [Condition of type SIMPLE-TYPE-ERROR]
It throws this weird error! Look at the expansion:
(let ((v 1))
(let* ((v "DOUBLING IT") (val (setq v (+ 1 v))))
(princ v)
(+ val val)))
it shadows the v from the outer scope with string, and when you are trying to add 1, well it obviously can't. Too bad.
another example, say you want to call the function twice, and return 2 results as a list:
(defmacro two-funcalls (f v)
`(let ((x ,f))
(list (funcall x ,v) (funcall x ,v))))
CL-USER> (let ((y 10))
(two-funcalls (lambda (z) z) y))
;;=> (10 10)
;; OK
CL-USER> (let ((x 10))
(two-funcalls (lambda (z) z) x))
;; (#<FUNCTION (LAMBDA (Z)) {52D2D4AB}> #<FUNCTION (LAMBDA (Z)) {52D2D4AB}>)
;; NOT OK!
this class of bugs is very nasty, since you can't easily say what's happened.
What is the solution? Obviously not to name the value v inside macro. You need to generate some sophisticated name that no one would reproduce in their code, like my-super-unique-value-identifier-2019-12-27. This would probably save you, but still you can't really be sure. That's why gensym is there:
(defmacro two-funcalls (f v)
(let ((fname (gensym)))
`(let ((,fname ,f))
(list (funcall ,fname ,v) (funcall ,fname ,v)))))
expanding to:
(let ((y 10))
(let ((#:g654 (lambda (z) z)))
(list (funcall #:g654 y) (funcall #:g654 y))))
you just generate the var name for the generated code, it is guaranteed to be unique (meaning no two gensym calls would generate the same name for the runtime session),
(loop repeat 3 collect (gensym))
;;=> (#:G645 #:G646 #:G647)
it still can potentially be clashed with user var somehow, but everybody knows about the naming and doesn't call the var #:GXXXX, so you can consider it to be impossible. You can further secure it, adding prefix
(loop repeat 3 collect (gensym "MY_GUID"))
;;=> (#:MY_GUID651 #:MY_GUID652 #:MY_GUID653)
GENSYM will generate a new symbol at each call. It will be garanteed, that the symbol did not exist before it will be generated and that it will never be generated again. You may specify a symbols prefix, if you like:
CL-USER> (gensym)
#:G736
CL-USER> (gensym "SOMETHING")
#:SOMETHING737
The most common use of GENSYM is generating names for items to avoid name clashes in macro expansion.
Another common purpose is the generaton of symbols for the construction of graphs, if the only thing demand you have is to attach a property list to them, while the name of the node is not of interest.
I think, the task of NFA-generation could make good use of the second purpose.
This is a note to some of the other answers, which I think are fine. While gensym is the traditional way of making new symbols, in fact there is another way which works perfectly well and is often better I find: make-symbol:
make-symbol creates and returns a fresh, uninterned symbol whose name is the given name. The new-symbol is neither bound nor fbound and has a null property list.
So, the nice thing about make-symbol is it makes a symbol with the name you asked for, exactly, without any weird numerical suffix. This can be helpful when writing macros because it makes the macroexpansion more readable. Consider this simple list-collection macro:
(defmacro collecting (&body forms)
(let ((resultsn (make-symbol "RESULTS"))
(rtailn (make-symbol "RTAIL")))
`(let ((,resultsn '())
(,rtailn nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null ,rtailn)
(setf ,resultsn new
,rtailn new)
(setf (cdr ,rtailn) new
,rtailn new)))
it))
,#forms
,resultsn))))
This needs two bindings which the body can't refer to, for the results, and the last cons of the results. It also introduces a function in a way which is intentionally 'unhygienic': inside collecting, collect means 'collect something'.
So now
> (collecting (collect 1) (collect 2) 3)
(1 2)
as we want, and we can look at the macroexpansion to see that the introduced bindings have names which make some kind of sense:
> (macroexpand '(collecting (collect 1)))
(let ((#:results 'nil) (#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #:rtail)
(setf #:results new #:rtail new)
(setf (cdr #:rtail) new #:rtail new)))
it))
(collect 1)
#:results))
t
And we can persuade the Lisp printer to tell us that in fact all these uninterned symbols are the same:
> (let ((*print-circle* t))
(pprint (macroexpand '(collecting (collect 1)))))
(let ((#2=#:results 'nil) (#1=#:rtail nil))
(flet ((collect (it)
(let ((new (list it)))
(if (null #1#)
(setf #2# new #1# new)
(setf (cdr #1#) new #1# new)))
it))
(collect 1)
#2#))
So, for writing macros I generally find make-symbol more useful than gensym. For writing things where I just need a symbol as an object, such as naming a node in some structure, then gensym is probably more useful. Finally note that gensym can be implemented in terms of make-symbol:
(defun my-gensym (&optional (thing "G"))
;; I think this is GENSYM
(check-type thing (or string (integer 0)))
(let ((prefix (typecase thing
(string thing)
(t "G")))
(count (typecase thing
((integer 0) thing)
(t (prog1 *gensym-counter*
(incf *gensym-counter*))))))
(make-symbol (format nil "~A~D" prefix count))))
(This may be buggy.)
I'm currently experimenting with macro's in Lisp and I would like to write a macro which can handle syntax as follows:
(my-macro (args1) (args2))
The macro should take two lists which would then be available within my macro to do further processing. The catch, however, is that the lists are unquoted to mimic the syntax of some real Lisp/CLOS functions. Is this possible?
Currently I get the following error when attempting to do something like this:
Undefined function ARGS1 called with arguments ().
Thanks in advance!
I think you need to show what you have tried to do. Here is an example of a (silly) macro which has an argument pattern pretty much what yours is:
(defmacro stupid-let ((&rest vars) (&rest values) &body forms)
;; Like LET but with a terrible syntax
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
Then
> (macroexpand '(stupid-let (a b c) (1 2 3) (+ a b c)))
(let ((a 1) (b 2) (c 3)) (+ a b c))
The above macro depends on defmacro's arglist-destructuring, but you don't have to do that:
(defun proper-list-p (l)
;; elaborate version with an occurs check, quadratic.
(labels ((plp (tail tails)
(if (member tail tails)
nil
(typecase tail
(null t)
(cons (plp (rest tail) (cons tail tails)))
(t nil)))))
(plp l '())))
(defmacro stupid-let (vars values &body forms)
;; Like LET but with a terrible syntax
(unless (and (proper-list-p vars) (proper-list-p values))
(error "need lists of variables and values"))
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
As a slightly more useful example, here is a macro which is a bit like the CLOS with-slots / with-accessors macros:
(defmacro with-mindless-accessors ((&rest accessor-specifications) thing
&body forms)
"Use SYMBOL-MACROLET to define mindless accessors for THING.
Each accessor specification is either a symbol which names the symbol
macro and the accessor, or a list (macroname accessorname) which binds
macroname to a symbol macro which calls accessornam. THING is
evaluated once only."
(multiple-value-bind (accessors functions)
(loop for accessor-specification in accessor-specifications
if (symbolp accessor-specification)
collect accessor-specification into acs
and collect accessor-specification into fns
else if (and (proper-list-p accessor-specification)
(= (length accessor-specification) 2)
(every #'symbolp accessor-specification))
collect (first accessor-specification) into acs
and collect (second accessor-specification) into fns
else do (error "bad accessor specification ~A" accessor-specification)
end
finally (return (values acs fns)))
(let ((thingn (make-symbol "THING")))
`(let ((,thingn ,thing))
(symbol-macrolet ,(loop for accessor in accessors
for function in functions
collect `(,accessor (,function ,thingn)))
,#forms)))))
So now we can write this somewhat useless code:
> (with-mindless-accessors (car cdr) (cons 1 2)
(setf cdr 3)
(+ car cdr))
4
And this:
> (let ((l (list 1 2)))
(with-mindless-accessors (second) l
(setf second 4)
l))
(1 4)
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 #'*
When I compile the following code, SBCL complains that g!-unit-value and g!-unit are undefined. I'm not sure how to debug this. As far as I can tell, flatten is failing.
When flatten reaches the unquoted part of defunits, it seems like the entire part is being treated as an atom. Does that sound correct?
The following uses code from the book Let over Lambda:
Paul Graham Utilities
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (a args) (princ a s))))
(defun group (source n)
(if (zerop n) (error "zero length"))
(labels ((rec (source acc)
(let ((rest (nthcdr n source)))
(if (consp rest)
(rec rest (cons (subseq source 0 n) acc))
(nreverse (cons source acc))))))
(if source (rec source nil) nil)))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
Let Over Lambda Utilities - Chapter 3
(defmacro defmacro/g! (name args &rest body)
(let ((g!-symbols (remove-duplicates
(remove-if-not #'g!-symbol-p
(flatten body)))))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (g!-symbol)
`(,g!-symbol (gensym ,(subseq
(symbol-name g!-symbol)
2))))
g!-symbols)
,#body))))
(defun g!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro! (name args &rest body)
(let* ((o!-symbols (remove-if-not #'o!-symbol-p args))
(g!-symbols (mapcar #'o!-symbol-to-g!-symbol o!-symbols)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,#g!-symbols) (list ,#o!-symbols))
,(progn ,#body)))))
(defun o!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"O!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (o!-symbol)
(symb "G!" (subseq (symbol-name o!-symbol) 2)))
Let Over Lambda - Chapter 5
(defun defunits-chaining (u units prev)
(if (member u prev)
(error "~{ ~a~^ depends on~}"
(cons u prev)))
(let ((spec (find u units :key #'car)))
(if (null spec)
(error "Unknown unit ~a" u)
(let ((chain (second spec)))
(if (listp chain)
(* (car chain)
(defunits-chaining
(second chain)
units
(cons u prev)))
chain)))))
(defmacro! defunits (quantity base-unit &rest units)
`(defmacro ,(symb 'unit-of- quantity)
(,g!-unit-value ,g!-unit)
`(* ,,g!-unit-value
,(case ,g!-unit
((,base-unit) 1)
,#(mapcar (lambda (x)
`((,(car x))
,(defunits-chaining
(car x)
(cons
`(,base-unit 1)
(group units 2))
nil)))
(group units 2))))))
This is kind of tricky:
Problem: you assume that backquote/comma expressions are plain lists.
You need to ask yourself this question:
What is the representation of a backquote/comma expression?
Is it a list?
Actually the full representation is unspecified. See here: CLHS: Section 2.4.6.1 Notes about Backquote
We are using SBCL. See this:
* (setf *print-pretty* nil)
NIL
* '`(a ,b)
(SB-INT:QUASIQUOTE (A #S(SB-IMPL::COMMA :EXPR B :KIND 0)))
So a comma expression is represented by a structure of type SB-IMPL::COMMA. The SBCL developers thought that this representation helps when such backquote lists need to be printed by the pretty printer.
Since your flatten treats structures as atoms, it won't look inside...
But this is the specific representation of SBCL. Clozure CL does something else and LispWorks again does something else.
Clozure CL:
? '`(a ,b)
(LIST* 'A (LIST B))
LispWorks:
CL-USER 87 > '`(a ,b)
(SYSTEM::BQ-LIST (QUOTE A) B)
Debugging
Since you found out that somehow flatten was involved, the next debugging steps are:
First: trace the function flatten and see with which data it is called and what it returns.
Since we are not sure what the data actually is, one can INSPECT it.
A debugging example using SBCL:
* (defun flatten (x)
(inspect x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
STYLE-WARNING: redefining COMMON-LISP-USER::FLATTEN in DEFUN
FLATTEN
Above calls INSPECT on the argument data. In Common Lisp, the Inspector usually is something where one can interactively inspect data structures.
As an example we are calling flatten with a backquote expression:
* (flatten '`(a ,b))
The object is a proper list of length 2.
0. 0: SB-INT:QUASIQUOTE
1. 1: (A ,B)
We are in the interactive Inspector. The commands now available:
> help
help for INSPECT:
Q, E - Quit the inspector.
<integer> - Inspect the numbered slot.
R - Redisplay current inspected object.
U - Move upward/backward to previous inspected object.
?, H, Help - Show this help.
<other> - Evaluate the input as an expression.
Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
to the current inspected object, so that it can be referred to in
evaluated expressions.
So the command 1 walks into the data structure, here a list.
> 1
The object is a proper list of length 2.
0. 0: A
1. 1: ,B
Walk in further:
> 1
The object is a STRUCTURE-OBJECT of type SB-IMPL::COMMA.
0. EXPR: B
1. KIND: 0
Here the Inspector tells us that the object is a structure of a certain type. That's what we wanted to know.
We now leave the Inspector using the command q and the flatten function continues and returns a value:
> q
(SB-INT:QUASIQUOTE A ,B)
For anyone else who is trying to get defmacro! to work on SBCL, a temporary solution to this problem is to grope inside the unquote structure during the flatten procedure recursively flatten its contents:
(defun flatten (x)
(labels ((flatten-recursively (x flattening-list)
(cond ((null x) flattening-list)
((eq (type-of x) 'SB-IMPL::COMMA) (flatten-recursively (sb-impl::comma-expr x) flattening-list))
((atom x) (cons x flattening-list))
(t (flatten-recursively (car x) (flatten-recursively (cdr x) flattening-list))))))
(flatten-recursively x nil)))
But this is horribly platform dependant. If I find a better way, I'll post it.
In case anyone's still interested in this one, here are my three cents. My objection to the above modification of flatten is that it might be more naturally useful as it were originally, while the problem with representations of unquote is rather endemic to defmacro/g!. I came up with a not-too-pretty modification of defmacro/g! using features to decide what to do. Namely, when dealing with non-SBCL implementations (#-sbcl) we proceed as before, while in the case of SBCL (#+sbcl) we dig into the sb-impl::comma structure, use its expr attribute when necessary and use equalp in remove-duplicates, as we are now dealing with structures, not symbols. Here's the code:
(defmacro defmacro/g! (name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #-sbcl #'g!-symbol-p
#+sbcl #'(lambda (s)
(and (sb-impl::comma-p s)
(g!-symbol-p (sb-impl::comma-expr s))))
(flatten body))
:test #-sbcl #'eql #+sbcl #'equalp)))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (s)
`(#-sbcl ,s #+sbcl ,(sb-impl::comma-expr s)
(gensym ,(subseq
#-sbcl
(symbol-name s)
#+sbcl
(symbol-name (sb-impl::comma-expr s))
2))))
syms)
,#body))))
It works with SBCL. I have yet to test it thoroughly on other implementations.
I would like to create a function that allows to:
(incf vara varb varc vard)
Instead of
(incf vara)
(incf varb)
(incf varc)
(incf vard)
What I do not understand is how to be able to send more arguments, how to define that in a function?
(defun inc (&rest arg)
(interactive)
(mapcar 'incf arg)
)
This increases the argument, but ofcourse does not save them back into the variables.
How to go about this?
If you want to be able to write this form as (my-incf a b c) without quoting the variable names a, b, and c, make it a macro rather than a function:
(defmacro incf+ (&rest vars)
`(progn
,#(mapcar (lambda (var) `(incf ,var)) vars)))
Check that it expands into the right code using macroexpand:
(macroexpand '(incf+ var1 var2 var3))
;; => (progn (incf var1) (incf var2) (incf var3))
Because variables in Emacs Lisp have dynamic scope by default, you can accomplish almost the same thing with a function which takes quoted variable names as arguments. But the macro version has the advantage that, since it expands into code in the place when it was called, it will work with lexically bound variables as well. symbol-value only works with dynamically bound variables.
You can test this by putting the following in a file and loading it (in Emacs 24 or higher):
;; -*- lexical-binding: t -*-
(defun incf+fun (&rest vars)
(mapc #'(lambda (var) (incf (symbol-value var))) vars))
(defun incf-macro-test ()
(let ((a 5) (b 7) (c 11))
(incf+ a b c)
(list a b c)))
(defun incf-function-test ()
(let ((a 5) (b 7) (c 11))
(incf+fun 'a 'b 'c)
(list a b c)))
Evaluating (incf-macro-test) will return (6 8 12), but (incf-function-test) will enter the debugger with a (void-variable a) error.
It should work:
(require 'cl)
(setq a 1)
(setq b 2)
(defun inc (&rest arg)
(interactive)
(mapc (lambda (x) (incf (symbol-value x))) arg))
(inc 'a 'b)
(message "%s %s" a b) => (2 3)
You have to quote each argument otherwise (inc a b) becomes (inc 1 2) before executing inc.