I'm trying to write functions that wrap another function but I'm not sure how to pass parameters correctly while maintaining a sensible lambda-list.
E.g. if I have a function
(defun f (x &key y z) ...)
I want to write something like
(defun g (x &key y z)
(h (f x :y y :z z)))
This isn't satisfactory because I want to call f from g with the exact arguments g was called with, which doesn't happen (e.g. I don't want to supply keyword arguments to f that weren't supplied to g by the caller).
I initially wrote something like:
(defun g (&rest f-args)
(apply #'f f-args))
And that's the effect I want, however the lambda list for g is now very cryptic and I keep having to navigate to f to see what the arguments should be.
I did come up with a solution (and it's mostly satisfactory so I posted it as an answer), but I need to be explicit with every single key argument, and with large lambda-lists (e.g. if I want to wrap drakma:http-request), it will be a pain. I hope that maybe there's a better way.
You could write a macro that defines a function by copying the lambda list from another function. The problem is that there isn't a standard way to get the lambda list, but for SBCL you can use SB-INTROSPECT:FUNCTION-LAMBDA-LIST (although that won't work with (declaim (optimize (debug 0)))). You could try reading Swank source code to see how it gets the lambda lists for various implementations.
(defmacro define-wrapper (name lambda-source &body body)
`(defun ,name ,(sb-introspect:function-lambda-list lambda-source)
,#body))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 (f x :y y :z z)))
(f 2) ;=> 9
(g 2) ;=> 18
That's a bit ugly since the code doesn't show the variable definitions. A bit more complex solution might be to do something like
;; Requires Alexandria.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
`(defun ,name ,lambda-list
,#(sublis `((_ . (,lambda-source ,#(loop for r in required collect r)
,#(loop for (name init suppliedp)
in optional collect name)
,#(loop for ((k-name name) init suppliedp)
in keywords
append (list k-name name)))))
body)))))
(defun f (x &key (y 3) (z 4))
(+ x y z))
(define-wrapper g f
(* 2 _))
Where the _ in the wrapper is replaced with a call to the function F with the given arguments. You do still have to remember that the argument variables exist and can conflict with ones you define yourself.
That passes all arguments to the function regardless of whether they were given. That might mess up a function that behaves differently depending on whether an argument was supplied or not. You could avoid that by using APPLY, but it's a bit more complex.
(defmacro define-wrapper (name lambda-source &body body)
(let ((lambda-list (sb-introspect:function-lambda-list lambda-source)))
(alexandria:with-gensyms (deparsed-arglist-sym
key-sym val-sym suppliedp-sym)
(multiple-value-bind (required optional rest keywords)
(alexandria:parse-ordinary-lambda-list lambda-list)
(declare (ignore rest))
(multiple-value-bind (body declarations docstring)
(alexandria:parse-body body :documentation t)
`(defun ,name ,lambda-list
,#(when docstring (list docstring))
,#declarations
(let ((,deparsed-arglist-sym
(nconc (loop for ,val-sym in (list ,#required) collect ,val-sym)
(loop for (,val-sym . ,suppliedp-sym)
in (list ,#(loop for (name init suppliedp)
in optional
collect (list 'cons name
(or suppliedp t))))
when ,suppliedp-sym collect ,val-sym)
(loop for (,key-sym ,val-sym ,suppliedp-sym)
in (list ,#(loop for ((kname name) init suppliedp)
in keywords
collect (list 'list kname name
(or suppliedp t))))
when ,suppliedp-sym append (list ,key-sym ,val-sym)))))
,#(sublis `((_ . (apply #',lambda-source ,deparsed-arglist-sym)))
body))))))))
(define-wrapper bar drakma:http-request
"Return the length of a response to http-request."
;; HTTP-REQUEST has some &aux variables.
(declare (ignore drakma::unparsed-uri
drakma::args))
(length _))
(bar "http://www.google.com") ;=> 11400 (14 bits, #x2C88)
I came up with this:
(defun g (x &rest f-keys &key y z)
(declare (ignorable y z))
(apply #'f x f-keys))
It's great for small lambda-lists but I hope I could do better.
I also can't see default values unless I type them explicitly.
Related
In Common Lisp, is there a way for an argument to a function to determine how the function is called, in the following sense? Let's say we have a function which has alredy been defined, say (defun foo (n) (+ 3 n)) and we want to define an iterative calls form ic which works in the following way:
(foo 6) => 9
(foo (ic 3 6)) => (foo (foo (foo 6))) => 15
(foo (ic 4 6)) => (foo (foo (foo (foo 6)))) => 18
Can this be done without redefining the function foo? Clearly ic needs to influence a function call outside itself.
By default no. That will change the semantics of the language: It will change what programs mean in the language. That said, you can define macros with such features but then, that will a domain specific language.
Macros are the designated tool for situations where you want to create forms with a different evaluation order from standard procedures.
To achieve the iterated function you want, you can simply define a function which takes a function func and an integer n then, returns a function which applies func n times to its arguments.
(defun iterate-function (func n)
"return a function which applies func n times to its argument.
(funcall (ic f 3) 0) => (f (f (f 0)))"
(unless (and (plusp n) (integerp n))
(error "n must be a non-negative integer"))
(let ((fns (make-list (1- n) :initial-element func)))
#'(lambda (&rest args)
(reduce #'funcall fns :initial-value (apply func args)))))
Now, we can create an iterated function like so:
CL-USER> (ic #'(λ (x) (* x x)) 3)
#<FUNCTION (LAMBDA (&REST ARGS) :IN IC) {100A67B6DB}>
We can now apply the iterated function to arguments like so:
CL-USER> (funcall (ic #'(λ (x) (* x x)) 3) 2)
256
One, possibly complex, way would be to define a macro BAR which would rewrite code.
Source:
(bar (foo (ic 3 6)))
Rewrite:
(foo (foo (foo 6)))
The macro BAR might need a code walker to transform more complex Lisp code like:
(bar
(let ((arg 6))
(foo (ic 3 arg))))
I am trying to learn Common Lisp with the book Common Lisp: A gentle introduction to Symbolic Computation. In addition, I am using SBCL, Emacs and Slime.
In chapter 7, the author suggests there are three styles of programming the book will cover: recursion, iteration and applicative programming.
I am interested on the last one. This style is famous for the applicative operator funcall which is the primitive responsible for other applicative operators such as mapcar.
Thus, with an educational purpose, I decided to implement my own version of mapcar using funcall:
(defun my-mapcar (fn xs)
(if (null xs)
nil
(cons (funcall fn (car xs))
(my-mapcar fn (cdr xs)))))
As you might see, I used recursion as a programming style to build an iconic applicative programming function.
It seems to work:
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
CL-USER> (my-mapcar (lambda (n) (+ n 1)) (list ))
NIL
;; comparing the results with the official one
CL-USER> (mapcar (lambda (n) (+ n 1)) (list ))
NIL
CL-USER> (mapcar (lambda (n) (+ n 1)) (list 1 2 3 4))
(2 3 4 5)
Is there a way to implement mapcar without using recursion or iteration? Using only applicative programming as a style?
Thanks.
Obs.: I tried to see how it was implemented. But it was not possible
CL-USER> (function-lambda-expression #'mapcar)
NIL
T
MAPCAR
I also used Emacs M-. to look for the documentation. However, the points below did not help me. I used this to find the files below:
/usr/share/sbcl-source/src/code/list.lisp
(DEFUN MAPCAR)
/usr/share/sbcl-source/src/compiler/seqtran.lisp
(:DEFINE-SOURCE-TRANSFORM MAPCAR)
/usr/share/sbcl-source/src/compiler/fndb.lisp
(DECLAIM MAPCAR SB-C:DEFKNOWN)
mapcar is by itself a primitive applicative operator (pag. 220 of Common Lisp: A gentle introduction to Symbolic Computation). So, if you want to rewrite it in an applicative way, you should use some other primitive applicative operator, for instance map or map-into. For instance, with map-into:
CL-USER> (defun my-mapcar (fn list &rest lists)
(apply #'map-into (make-list (length list)) fn list lists))
MY-MAPCAR
CL-USER> (my-mapcar #'1+ '(1 2 3))
(2 3 4)
CL-USER> (my-mapcar #'+ '(1 2 3) '(10 20 30) '(100 200 300))
(111 222 333)
Technically, recursion can be implemented as follows:
(defun fix (f)
(funcall (lambda (x) (funcall x x))
(lambda (x) (funcall f (lambda (&rest y) (apply (funcall x x) y))))))
Notice that fix does not use recursion in any way. In fact, we could have only used lambda in the definition of f as follows:
(defconstant fix-combinator
(lambda (g) (funcall
(lambda (x) (funcall x x))
(lambda (x) (funcall
g
(lambda (&rest y) (apply (funcall x x)
y)))))))
(defun fix-2 (f)
(funcall fix-combinator f))
The fix-combinator constant is more commonly known as the y combinator.
It turns out that fix has the following property:
Evaluating (apply (fix f) list) is equivalent to evaluating (apply (funcall f (fix f)) list). Informally, we have (fix f) = (funcall f (fix f)).
Thus, we can define map-car (I'm using a different name to avoid package lock) by
(defun map-car (func lst)
(funcall (fix (lambda (map-func) (lambda (lst) ; We want mapfunc to be (lambda (lst) (mapcar func lst))
(if (endp lst)
nil
(cons (funcall func (car lst))
(funcall map-func (cdr lst)))))))
lst))
Note the lack of recursion or iteration.
That being said, generally mapcar is just taken as a primitive notion when using the "applicative" style of programming.
Another way you can implement mapcar is by using the more general reduce function (a.k.a. fold). Let's name the user-provided function f and define my-mapcar.
The reduce function carries an accumulator value that builds up the resulting list, here it is going take a value v, a sublist rest, and call cons with (funcall f v) and rest, so as to build a list.
More precisely, here reduce is going to implement a right-fold, since cons is right-associative (e.g. the recursive list is the "right" hand side, ie. the second argument of cons, e.g. (cons a (cons b (cons nil)))).
In order to define a right-fold with reduce, you pass :from-end t, which indicates that it builds-up a value from the last element and the initial accumulator to obtain a new accumulator value, then the second to last element with that new accumulator to build a new accumulator, etc. This is how you ensure that the resulting elements are in the same order as the input list.
In that case, the reducing function takes its the current element as its first argument, and the accumulator as a second argument.
Since the type of the elements and the type of the accumulator are different, you need to pass an :initial-value for the accumulator (the default behavior where the initial-value is taken from the list is for functions like + or *, where the accumulator is in the same domain as the list elements).
With that in mind, you can write it as follows:
(defun my-map (f list)
(reduce (lambda (v rest) (cons (funcall f v) rest))
list
:from-end t
:initial-value nil))
For example:
(my-map #'prin1-to-string '(0 1 2 3))
; => ("0" "1" "2" "3")
I am wondering how one can achieve the following. Suppose I have a list of variables that are bound by some let above. I would like to turn this list into a list of the values to which those variables are bound.
That is, suppose we have
(define make-plist-from-variables (variables)
(let ((keys variables)
(values (mapcar #'identity variables)))
(if (eq (length keys) (length values))
(make-plist keys values)
nil))))
What can I use in place of #'identity to unpack those values properly?
At the moment, the following call produces the following output.
CL-USER> (let ((a 2) (b 3)) (make-plist-from-variables '(a b)))
(A A B B)
I would like it to be (A 2 B 3)
It needs to be a macro because there is no way to fetch a variable's lexical value based on its symbol.
(defmacro make-plist-from-variables (&rest variables)
(loop :for binding :in variables
:collect `',binding :into result
:collect binding :into result
:finally (return `(list ,#result))))
(macroexpand-1 '(make-plist-from-variables a b))
; ==> (list 'a a 'b b)
(let ((a 2) (b 3))
(make-plist-from-variables a b))
; ==> (a 2 b 3)
EDIT
Implementation without loop using mapcan:
(defmacro make-plist-from-variables (&rest variables)
`(list ,#(mapcan (lambda (v) `(',v ,v)) variables))
Functions don't have access to the lexical environment of their callers.
More precisely, during evaluation you cannot access the values of lexical variables knowing only their symbols. Only macros have access to environment objects.
Special variables
You can use dynamic binding:
(defun foo ()
(declare (special a))
(symbol-value 'a))
(let ((a 3))
(declare (special a))
(foo))
=> 3
In your case, you would collect the symbol along its value, by using SYMBOL-vaLUE on all your symbols.
Related to your question is how to dynamically bind variables to values where the variable names and/or values are known at evaluation time; see special operator PROGV.
Macros
You could obtain e.g. an association list by writing the following code:
(acons 'a a (acons 'b b nil))
Depending on the use case behind your question, you may want to have a macro that expands into such code, that references the variables you want to evaluate.
Could someone explain to me what's going on in this very simple code snippet?
(defun test-a ()
(let ((x '(nil)))
(setcar x (cons 1 (car x)))
x))
Upon a calling (test-a) for the first time, I get the expected result: ((1)).
But to my surprise, calling it once more, I get ((1 1)), ((1 1 1)) and so on.
Why is this happening? Am I wrong to expect (test-a) to always return ((1))?
Also note that after re-evaluating the definition of test-a, the return result resets.
Also consider that this function works as I expect:
(defun test-b ()
(let ((x '(nil)))
(setq x (cons (cons 1 (car x))
(cdr x)))))
(test-b) always returns ((1)).
Why aren't test-a and test-b equivalent?
The Bad
test-a is self-modifying code. This is extremely dangerous. While the variable x disappears at the end of the let form, its initial value persists in the function object, and that is the value you are modifying. Remember that in Lisp a function is a first class object, which can be passed around (just like a number or a list), and, sometimes, modified. This is exactly what you are doing here: the initial value for x is a part of the function object and you are modifying it.
Let us actually see what is happening:
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote (nil)))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1))))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1 1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1 1))))) (setcar x (cons 1 (car x))) x))
(test-a)
=> ((1 1 1))
(symbol-function 'test-a)
=> (lambda nil (let ((x (quote ((1 1 1))))) (setcar x (cons 1 (car x))) x))
The Good
test-b returns a fresh cons cell and thus is safe. The initial value of x is never modified. The difference between (setcar x ...) and (setq x ...) is that the former modifies the object already stored in the variable x while the latter stores a new object in x. The difference is similar to x.setField(42) vs. x = new MyObject(42) in C++.
The Bottom Line
In general, it is best to treat quoted data like '(1) as constants - do not modify them:
quote returns the argument, without evaluating it. (quote x) yields x.
Warning: quote does not construct its return value, but just returns
the value that was pre-constructed by the Lisp reader (see info node
Printed Representation). This means that (a . b) is not
identical to (cons 'a 'b): the former does not cons. Quoting should
be reserved for constants that will never be modified by side-effects,
unless you like self-modifying code. See the common pitfall in info
node Rearrangement for an example of unexpected results when
a quoted object is modified.
If you need to modify a list, create it with list or cons or copy-list instead of quote.
See more examples.
PS1. This has been duplicated on Emacs.
PS2. See also Why does this function return a different value every time? for an identical Common Lisp issue.
PS3. See also Issue CONSTANT-MODIFICATION.
I found the culprit is indeed 'quote. Here's its doc-string:
Return the argument, without evaluating it.
...
Warning: `quote' does not construct its return value, but just returns
the value that was pre-constructed by the Lisp reader
...
Quoting should be reserved for constants that will
never be modified by side-effects, unless you like self-modifying code.
I also rewrote for convenience
(setq test-a
(lambda () ((lambda (x) (setcar x (cons 1 (car x))) x) (quote (nil)))))
and then used
(funcall test-a)
to see how 'test-a was changing.
It looks like the '(nil) in your (let) is only evaluated once. When you (setcar), each call is modifying the same list in-place. You can make (test-a) work if you replace the '(nil) with (list (list)), although I presume there's a more elegant way to do it.
(test-b) constructs a totally new list from cons cells each time, which is why it works differently.
There are always many functions for iterating across list of values like mapcar, every, some.
I need iteration across predicates for single value:
(let ( (val (complex-expr ...)) )
(or (pred1 val) (pred2 val) ... (predN val)))
(let ( (val (complex-expr ...)) )
(and (pred1 val) (pred2 val) ... (predN val)))
Are there any standard functions doing above code with syntax:
(some-p val pred1 pred2 ... predN)
(every-p val pred1 pred2 ... predN)
UPDATE FYI Elisp have this function in it's standard library:
run-hook-with-args-until-success
run-hook-with-args-until-failure
run-hook-with-args
The standard doesn't include anything exactly like what you're asking for, but it does include some and every for computing (or (f x1) (f x2) … (f xn)) and (and (f x1) (f x2) … (f xn)):
CL-USER> (some 'evenp '(1 2 3 4 5))
T
CL-USER> (every 'evenp '(1 2 3 4 5))
NIL
What you're trying to do fits into this paradigm, except that the f you need should take each xi, treat it as a function, and call it with some value. Some and every still work here:
CL-USER> (let ((value 3))
(some (lambda (predicate) (funcall predicate value)) '(evenp symbolp oddp)))
T
CL-USER> (let ((value "hello"))
(some (lambda (predicate) (funcall predicate value)) '(characterp numberp)))
NIL
Of course, you can wrap that up another in function to avoid writing the lambda function every time:
(defun some-p (value predicates)
(some (lambda (predicate)
(funcall predicate value))
predicates))
CL-USER> (some-p "hello" '(characterp numberp))
NIL
CL-USER> (some-p 3 '(characterp numberp))
T
If you really want the function to variadic (like you showed in your question), you can do it with a &rest parameter, but do note that it's not the style most of these kinds of functions use:
(defun some-p (value &rest predicates)
(some (lambda (predicate)
(funcall predicate value))
predicates))
CL-USER> (some-p 3 'characterp 'numberp)
T
CL-USER> (some-p "hello" 'characterp 'numberp)
NIL
It's much more common to take the arguments as a list, though. Two good reasons for this (which are part of the same phenomenon) are that: (i) it's easier to pass the list from another source. E.g., it's easier to do [a] than [b]:
(let ((preds '(p1 p2 ... pn)))
(some-p-list value preds) ; [a]
(apply 'some-p-rest value preds)) ; [b]
Even if you don't mind the apply in [b], as Rainer Joswig noted in comments, there's a constant call-arguments-limit in a Common Lisp implementation that puts a limit on the number of arguments a function can be called with. It's often big, but it can be as small as 50. That means that if preds has 50 elements, then (apply 'some-p-rest value preds) would fail.
There is no standard function, but it is easy to write:
Note that you can also use the LOOP macro for that:
some
CL-USER 10 > (loop with value = 4
for pred in (list #'numberp #'plusp #'oddp)
thereis (funcall pred value))
T
every
CL-USER 11 > (loop with value = 3
for pred in (list #'numberp #'plusp #'oddp)
always (funcall pred value))
T
every-p
CL-USER 16 > (defun every-p (value predicates)
(loop for predicate in predicates
always (funcall predicate value)))
EVERY-P
CL-USER 17 > (every-p 3 (list #'numberp #'plusp #'oddp))
T