I want to define a generic function in CL that takes an optional and a keyword argument both of which have a default value. I tried
(defgeneric read-one (buffer &optional (sz 1) &key (signed '()))
but this throws Invalid &OPTIONAL argument specifier #1=(SZ 1)
So what is the proper way to do this sort of thing?
afaik you can't provide defaults in defgeneric. You would have to do this in the concrete implementation (defmethod)
(defgeneric read-one (buffer &optional sz &key signed))
(defmethod read-one (buffer &optional (sz 1) &key (signed '()))
(format t "~a, ~a, ~a~%" buffer sz signed))
CL-USER> (read-one (list 1 2 3) )
;; (1 2 3), 1, NIL
;; NIL
;; CL-USER> (read-one (list 1 2 3) 101 :signed t)
;; (1 2 3), 101, T
;; NIL
You can't provide defaults or supplied-p options in generic function lambda lists (or things like &aux).
So to provide default values you need to to do this in a method. This can be painful if you have a lot of primary methods, so a good way to do this, if you want the default to be common between primary methods, is in a method which wraps around the primary method or methods.
In standard method combination it's tempting to use around methods for this:
(defgeneric foo (x &optional y &key z)
(:method :around (x &optional (y 1) &key (z 0))
(call-next-method x y :z z)))
(defmethod foo (x &optional y &key z)
;; This method can assume things have been defaulted as can any
;; other principal method
(values x y z))
Now
> (foo nil)
nil
1
0
> (foo nil 4 :z 12)
nil
4
12
But that can be problematic, because it is always possible for another around method to be wrapped around any given around method, since around methods run in most-specific-first order:
(defmethod foo :around ((x number) &optional (y 3) &key (z 8))
(call-next-method x y :z z))
And now
> (foo nil)
nil
1
0
> (foo 1)
1
3
8
Sometimes that is what you want: you might want the default values to depend on the classes of the positional arguments. But sometimes what you want is to be able to say 'these are the defaults, nothing can override them'. You can't do that with standard method combination.
To do this you need wrapping-standard method combination or something like it. Using that you can do this:
(defgeneric foo (x &optional y &key z)
(:method-combination wrapping-standard)
(:method :wrapping (x &optional (y 1) &key (z 0))
(call-next-method x y :z z)))
(defmethod foo (x &optional y &key z)
(values x y z))
And this wrapping method can't be overridden:
(defmethod foo :around ((x number) &optional (y 3) &key (z 8))
(call-next-method x y :z z))
But still:
> (foo nil)
nil
1
0
> (foo 1)
1
1
0
Note I did not write wrapping-standard, but it's useful I think.
Related
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.
I'm having a little trouble creating a recursive function in Scheme. I need to create a function called foo(x) that recursively does the addition of all the powers. For example foo(5) would be 5^4 + 4^3 + 3^2 + 2^1 + 1^0 = 701.
The stopping condition is if x = 0 then return zero. Else then return x^x-1 + foo(x-1)
Here's what I have so far for my function:
(define (foo x)
(cond ((zero? x) 0)
(else (+(expt(x (- x 1)))foo(- x 1)))))
You just have to be more careful with the parentheses, in particular notice that the correct way to call a procedure is like this: (foo x), instead of this: foo(x). This should work:
(define (foo x)
(cond ((zero? x) 0)
(else (+ (expt x (- x 1))
(foo (- x 1))))))
(foo 5)
=> 701
Allow me to ident the code. I just pasted it in DrRacket and hit CTRL+I then put the arguments to + on one line each:
(define (foo x)
(cond ((zero? x) 0)
(else (+ (expt (x (- x 1)))
foo
(- x 1)))))
So the base case is ok, but your default case looks very off. x is treated as a procedure since it has parentheses around it and - also uses x as if it's a number. It can't be both.
foo is not applied since it doesn't have parentheses around it so it evaluates to a procedure value, while + would expect all its arguments to be numeric.
The rules of Scheme are that parentheses matters. x and (x) are two totally different things. The first x can be any value, but (x) is an application so x have to evaluate to a procedure. Some exceptions are for special forms you need to know by heart like cond, and define but rather than that it's very important to know you change the meaning of a program by adding parentheses.
The correct definition of your procedure might be:
(define (foo x)
(if (zero? x)
0
(+ (expt x (- x 1))
(foo (- x 1)))))
(foo 5) ; ==> 701
Here I've changed cond to if since none of conds features were used. Seeing cond I expect either side effects or more than one predicate.
I would like to assign to two (or more) variables, e.g., x and y (z etc.) the same value read from user input. Now I have (setf x (read)), but I'd like to also have the input value put in y as well. Do I have to then do (setf y x)? Is there something more elegant?
(setf x (read) y (read))
only makes the user input twice, so that's no good.
There's nothing quite like that built into the language, though you can easily implement it. E.g., here's a macro setf* (not the best name, though), that assigns a single value to a bunch of places (which don't have to be variables):
(defmacro setf* ((&rest places) value)
(let ((temp (gensym)))
`(let ((,temp ,value))
(setf ,#(mapcan (lambda (place)
(list place temp))
places)))))
CL-USER> (macroexpand-1 '(setf* (a (car list) (aref array 2 3)) d))
(LET ((#:G1043 D))
(SETF A #:G1043
(CAR LIST) #:G1043
(AREF ARRAY 2 3) #:G1043))
You'd do
(setf* (x y) (read))
Of course, for a simple one off, you might as well just do this by hand, as either (as sds suggested):
(setf x (read)
y x)
or
(let ((temp (read)))
(setf x temp
y temp))
you can assign x to y in the same form:
(setf x (read) y x)
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
Define the function 'occ' that takes a list L and a symbol A and counts the occurance of symbol A in L.
Example:
(occ '(((s) o ) d) 'f) --> 0
What i have gotten so far:
(defun occ(list a)
(setq counter 0)
;Checks if the given list is has an nested list
(if (consp list)
; Breaking the list down atom by atom and recursing
(or (occ a (car list))
(occ a (cdr list)))
; checks if symbols are the same
(if(eq a list)
(setq counter(1+ counter)))))
However My output keep saying Nil instead of displaying the counter value.
I cannot use any higher-functions of LISP.
First of all, don't use setq for variable initialization inside yout function, use let. Second, let's look why you doing it wrong, your code:
(defun occ(list a)
(setq counter 0) ;; You always setting counter to 0 on new
;; level of recursion
(if (consp list)
(or (occ a (car list)) ;; You reversed arguments order?
(occ a (cdr list))) ;; according to your definition it must be
;; (occ (car list) a)
(if(eq a list)
(setq counter(1+ counter)))))
Anyway, you don't need any counter variables to do what you want.
Right function may look like this (i changed arguments order becaus it looks better for me to find SYMBOL in LIST):
(defun occ (sym nested-list)
(cond
((consp nested-list)
(+ (occ sym (car nested-list)) (occ sym (cdr nested-list))))
((eq sym nested-list) 1)
(t 0)))
CL-USER> (occ 'x '(((s) o ((f ()) f)) d))
0
CL-USER> (occ 'f '(((s) o ((f (x (((f))))) f)) d f))
4
If you feed your definition to SBCL:
; in: DEFUN OCC
; (SETQ COUNTER 0)
;
; caught WARNING:
; undefined variable: COUNTER
;
; compilation unit finished
; Undefined variable:
; COUNTER
; caught 1 WARNING condition
So you are modifying a global undefined variable counter. When do the function return? Well, or will return the very first non nil return from recursion with car or cdr. What returns values? Well when it's not a cons it will evaluate to the intermediate value of a incf of counter when the symbol matches or nil when it doesn't.
Try doing it like this:
(defun occ (list a &optional (counter 0))
(cond ((equal list a) (1+ counter))
((atom list) counter)
(t (occ (cdr list)
a
(occ (car list)
a
counter)))))
counter is an optional accumulator that you use to hold the values. Since it's passed it isn't shared between the recursive calls but replaced with the updated value at each call making it functional and easy to follow. When you need to search both car and cdr you recurse car with the counter of this stage and the returning value will be used as the counter in the cdr. For lists of atom this will be tail recursive if the implementation supports it. This supports finding symbols as tails of lists. eg. (occ '((x . x) . x) 'x) ; ==> 3 If you are sure you have no dotted list (every list is nil terminated) you can use the loop macro:
(defun occ (list a)
(loop :for e :in list
:counting (equal e a) :into count
:if (consp e)
:summing (occ e a) :into sum
:finally (return (+ count sum))))
;; tests
(occ '(x (x x (x (x ) x)) y z) 'y) ; ==> 1
(occ '(x (x x (x (x ) x)) y z) 'x) ; ==> 6
(occ '((x . x) . x) 'x) ; ERROR like "A proper list must not end with X".