Currently a function curried with Alexandria's curry must be called with funcall. However it is possible to set the new function's symbol-function so that we can do without it and treat it like a real function. Illustrated on https://lispcookbook.github.io/cl-cookbook/functions.html#with-the-alexandria-library:
(defun adder (foo bar)
"Add the two arguments."
(+ foo bar))
(defvar add-one (alexandria:curry #'adder 1) "Add 1 to the argument.")
(funcall add-one 10) ;; => 11
(setf (symbol-function 'add-one) add-one)
(add-one 10) ;; => 11
;; and still ok with (funcall add-one 10)
Is there a good reason not to allow both styles ? This looks quite interesting to me in this context of currying.
ps: I did ask on Alexandria's issue tracker some 3 weeks ago
pps: https://gitlab.common-lisp.net/alexandria/alexandria/blob/master/functions.lisp#L116
Based on your comment, and looking at the issue, yes it would be "foolish" to change curry so that it binds functions in the global namespace:
This would be a major change for curry, which would break existing code
A macro with this functionality would not mesh well with the spirit of Alexandria, as far as I know. This would be better suited for Serapeum, which happens to already define such a function, namely defalias. As you can see, the definition is a little more involved than using symbol-value. See also the documentation.
For reference, this simple macro does the job:
(defmacro defcurry (name function &rest arguments)
"Returns a regular function, created by currying FUNCTION with ARGUMENTS."
`(let ((closure (alexandria:curry ,function ,#arguments)))
(setf (symbol-function ,name) closure)))
Example:
(defun adder (x y) (+ x y))
(defcurry 'add2 #'adder 2)
(add2 3) ;; no "funcall" here
;; => 5"
edit: but… this is much simpler:
(defun add2 (a)
(adder 2 a))
Related
I am trying to use generic functions' ability to specify behaviour based on the first argument of a list.
In other words, I want the list (atypelist 1 2 3) and the list (btypelist 1 2 3) to have their individual behaviour when passed to foo. So far, this is what I came up with:
(deftype atypelist (lst)
`(eq (car ,lst) 'atypelist))
(deftype btypelist (lst)
`(eq (car ,lst) 'btypelist))
(defmethod foo ((lst atypelist))
(format nil "success atypelist: ~S" lst))
(defmethod foo ((lst btypelist))
(format nil "success btypelist: ~S" lst))
However, when I call (typep (list 'atypelist 1 2 3) 'atypelist) I get the following error:
error while parsing arguments to DEFTYPE ATYPELIST:
too few elements in
()
to satisfy lambda list
(LST):
exactly 1 expected, but got 0
I am guessing the error is in my definition of atypelist.
Questions:
Is there a better way to get the functionality I am looking for?
If yes - what is the way?
If not - how to properly define a type on a list/cons that has a particular symbol in the car?
Before I start: what you want to do can't work, and is confused in two ways.
Firstly deftype defines a type in terms of other type specifiers: the body of a deftype form must expand into a type specifier, not an expression, as yours does. And deftype's arguments are not the thing you want to check the type for, they are parts of the type specification.
In this case you want to specify that the thing is a cons, and that its car is eql to something. Fortunately there are specializing type specifiers for both of these things, and you end up with something like this:
(deftype cons-with-specified-car (x)
`(cons (eql ,x) t))
And now
> (typep '(1) '(cons-with-specified-car 1))
t
> (typep '(a) '(cons-with-specified-car a))
t
> (typep '() '(cons-with-specified-car a))
nil
And if you want:
(deftype cons-with-a ()
'(cons-with-specified-car a))
and now
> (typep '(a) 'cons-with-a)
t
Secondly none of this will work because this it not how CLOS works. CLOS dispatches on classes not types, and you have merely defined a type, not a class: your method definitions simply cannot work, since classes cannot be parametrized in this way like types can.
Some ways you might achieve what you want.
If what you want to do is to dispatch on the first element of a list, then the obvious approach, if you want to use CLOS, is to use a two-level approach where you first dispatch on the class of the thing (cons is a class), and then use eql specializers to pick out the things you want.
(defgeneric select (it)
(:method ((it cons))
(select* (car it) it))
(:method (it)
nil))
(defgeneric select* (key it)
(:method (key it)
(format t "~&unknown key ~S in ~S~%" key it)))
(defmethod select* ((key (eql 'a)) it)
(format t "~&~S begins with a~%" it))
However in a case like this, unless you very much want the extensibility that CLOS gets you (which is a good reason to use CLOS here), I'd just use typecase. You could do this using the type defined above:
(defun select (it)
(typecase it
((cons-with-specified-car a)
'(cons a))
(cons
'cons)
(t
nil)))
or, probably simpler, just use what the deftype expands into:
(defun select (it)
(typecase it
((cons (eql a) t)
'(cons a))
(cons
'cons)
(t
nil)))
Finally probably what anyone doing this would actually write (again, assuming you do not want the extensibility CLOS gets you) is:
(defun select (it)
(typecase it
(cons
(case (car it)
...))
(t
...)))
Here is a possible solution, using the type specifier satisfies:
CL-USER> (defun is-atypelist (list)
(eq (car list) 'atypelist))
IS-ATYPELIST
CL-USER> (defun is-btypelist (list)
(eq (car list) 'btypelist))
IS-BTYPELIST
CL-USER> (deftype atypelist ()
`(satisfies is-atypelist))
ATYPELIST
CL-USER> (deftype btypelist ()
`(satisfies is-btypelist))
BTYPELIST
CL-USER> (typep (list 'atypelist 1 2 3) 'atypelist)
T
CL-USER> (typep (list 'atypelist 1 2 3) 'btypelist)
NIL
Note that this does not define a class, but a type, if this is what you need.
Is there a better way to get the functionality I am looking for?
1. Wrap your lists in container types
(defclass lst () ((items :initarg :items :reader items)))
(defclass alst (lst) ())
(defclass blst (lst) ())
It may be a little bit more cumbersome to work with but this is pretty much straightforward and not too suprising.
2. Douple-dispatch
(defgeneric foo (val))
(defgeneric foo/tag (tag val))
For example:
(defmethod foo ((c cons))
(destructuring-bind (tag . list) c
(foo/tag tag list)))
3. Define a custom method combination
It should be possible to hack the meta-object protocol dispatch mechanism to dispatch on the first item of a list. I wouldn't recommend it however.
4. Use a different dispatch mechanism
Use a completely different dispatching mechanism outside of CLOS, like pprint-dispatch does. For example you may want to use trivia or optima pattern-matching libraries, or cl-algebraic-data-type. This may be more useful if you are dealing with trees of symbols.
I have a struct with :name and :value that I'd like to use as arguments to a macro. But I'm not sure how to tell lisp that.
I can write out the call like
(sxql:yield (sxql:set= :name "a" :value 1))
"SET name = ?, value = ?"
("a" 1)
But I'd like to use an already existing structure
(defstruct my-struct name value)
(setq x (make-my-struct :name "a" :value 1))
; #S(MY-STRUCT :NAME "a" :VALUE 1)
using answers from Common LISP: convert (unknown) struct object to plist?
I've made
(defun struct-plist (x)
"make struct X into a property list. ugly kludge"
(let* ((slots (sb-mop:class-slots (class-of x)))
(names (mapcar 'sb-mop:slot-definition-name slots)))
(alexandria:flatten
(mapcar (lambda (n) (list (intern (string n) "KEYWORD")
(slot-value x n)))
names))))
(setq p (struct-plist x)) ; (:NAME "a" :VALUE 1)
My naive attempts are
(sxql:set= p) ; error in FORMAT: No more argument SET ~{~A = ~A~^, ~}
(funcall 'sxql:set= p) ; SXQL:SET= is a macro, not a function.
(macroexpand (sxql:set= p)) ; error in FORMAT ...
I imagine this is an easy/fundamental lisp programming question. But I'm not sure how to ask it (or search for answers). I'm also hoping there is an better struct<->plist story than what I've stumbled across so far.
EDIT: In case this is really an xy-problem. I've used flydata:defmodel to create the struct and I want to insert to a database using the same model.
This is definitely an xy problem: unfortunately I don't understand y (flydata?) well enough to answer the y part.
Here's why what you are trying to do can't work however. Consider this code in a file being compiled:
(defstruct mine name value)
...
(sxql:set= <anything derived from mine>)
Compiling this file must satisfy two constraints:
It does not fully create the structure type mine (see defstruct);
It must macroexpand sxql:set=.
What these constraints mean is that sxql:set= can't know about the structure at the time it is expanded. So any trick which relies on information about the structure must make that information available at compile time.
As I said, I don't understand the y part well enough to understand what you are trying to do, but a hacky approach to this is:
write a wrapper for defstruct which stashes information at compile time (strictly: at macro-expansion time);
write a wrapper for sxql:set= which uses that information to expand into something which makes sense.
Here is a mindless wrapper for defstruct. Note that this is mindless: it can only understand the most simple defstruct forms, and even then it may be wrong. It exists only as an example.
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar *structure-information* '()))
(defmacro define-mindless-structure (name &body slots)
(assert (and (symbolp name)
(every #'symbolp slots))
(name slots)
"I am too mindless")
(let ((found (or (assoc name *structure-information*)
(car (push (list name) *structure-information*)))))
(setf (cdr found) (mapcar (lambda (slot)
(list slot (intern (symbol-name slot)
(find-package "KEYWORD"))
(intern (concatenate 'string
(symbol-name name)
"-"
(symbol-name slot)))))
slots)))
`(defstruct ,name ,#slots))
So now
(define-mindless-structure mine
name value)
Will expand into (defstruct mine name value) and, at macroexpansion time will stash some information about this structure in *structure-information*.
Now I stop really understanding what you need to do because I don't know what sxql:set= is meant to do, but it might be something like this:
(defmacro mindless-set= ((s o))
(let ((info (assoc s *structure-information*))
(ov (make-symbol "O")))
(unless info
(error "no information for ~A" s))
`(let ((,ov ,o))
(sxql:set= ,#(loop for (slot initarg accessor) in (cdr info)
;; the compiler will whine about slot annoyingly
collect initarg
collect `(,accessor ,ov))))))
So with this macro, assuming a suitable define-mindless-structure for mine form has been seen by the time the macro is expanded, then
(mindless-set= (mine it))
Will expand into
(let ((#:o it))
(set= :name (mine-name #:o) :value (mine-value #:o)))
But, as I said, I am not sure what the expansion you actually want is.
Finally, before even thinking about using anything like the above, it would be worth looking around to see if there are portability libraries which provide compile/macroexpansion-time functionality like this: there very well may be such, as I don't keep up with things.
I am writing a common lisp program and I have a variable that can contain either a string or a function. I want to call the function if it is one and return that as well as the string. How do I test if a variable is a function?
Code so far:
(defun string-or-function (var)
(if (typep var 'simple-array)
var
(if "Function equivalent of typep goes here."
(setf temp (fn-that-does-something))
(string-or-function temp)
Edit: Code that works:
(defun string-or-function (var)
(let ((s-or-f (type-of var)))
(if (equal s-or-f 'function)
(print "function")
(if (equal (car s-or-f) 'simple-array)
(print "string")))))
Is there a better way to do it?
Common Lisp has a predicative type system. The notion that a value has a "principal" type doesn't make as much sense in Lisp. The type-of function is actually fairly infrequently used, as it makes less sense to ask "What is the type of X" and more sense to ask "Is X of type Y". This can be done with typep, or in your case more concisely with typecase, which is just a case statement for types.
(defun string-or-function (var)
(typecase var
(string (format t "string"))
(function (format t "function"))
(t (format t "something else"))))
I want to call the function if it is one and return that as well as the string.
I think you mean something like this:
(defun evaluate (arg)
"Returns something from evaluating ARG in some manner. If ARG is a string,
return it. If ARG is a function, call it with no arguments and return its
return value(s)."
(ctypecase arg
(string arg)
(function (funcall arg))))
If you need extensibility:
(defgeneric evaluate (arg)
(:documentation "Returns something from evaluating ARG in some manner."))
(defmethod evaluate ((arg string))
arg)
(defmethod evaluate ((arg function))
(funcall arg))
Here are some other ways:
(defun string-or-function-p (x)
(typep x '(or string function)))
...but you can probably also use check-type, which is not a predicate but a check which signals a restartable condition in case the value does not satisfy the type specification:
(check-type place (or string function))
If you happen to use this type a lot, define a custom type:
(deftype string-or-fun () '(or string function))
Of course, you can also use generic functions depending on your needs (silly example):
(defgeneric execute (object)
(:method ((s string)) (eval (read-from-string s)))
(:method ((f function)) (funcall f)))
But note that generic function dispatch on classes, not types, which are different things.
(eq (type-of var) 'function)
However, remember that Common Lisp keeps variables and function names in different namespaces, so (var 1 2 3) and (cons var 1) are looking in two different places. You probably cannot call var like (var), but will rather need to use (funcall var), depending on which namespace this is in.
Basically, you probably shouldn't be stuffing a function-or-maybe-a-string into one variable.
When I try to program in a functional style with immutable objects, sequential operations end up being written inside-out, like this:
(thing-operation3
(thing-operation2
(thing-operation1 thing extra-arg1)
extra-arg2)
extra-arg3)
I'm starting to see this pattern repeating all over my code, and I find it very hard to read. This could marginally be improved using higher-order procedures like curry and compose:
((compose1
(curryr thing-operation3 extra-arg3)
(curryr thing-operation2 extra-arg2)
(curryr thing-operation1 extra-arg1))
thing)
Better perhaps, but it is still written upside-down, and it takes some extra cognitive load to figure out what is going on. And I'm not sure whether this is ideomatic Lisp-code.
Object-oriented style is so much easier to read:
thing.operation1(extra-arg1).operation2(extra-arg2)
.operation3(extra-arg3)
It reads in a natural order, and it could also be implemented with immutable objects.
What is the ideomatic way of writing such sequential operations in Lisp so that they are easy to read?
An usual way in Common Lisp would be to use LET*
(let* ((thing1 (thing-operation0 thing0 extra-arg0))
(thing2 (thing-operation1 thing1 extra-arg1))
(thing3 (thing-operation2 thing2 extra-arg2)))
(thing-operation3 thing3 extra-arg3))
That way one can name the return values, which improves readability and one could write declarations for those.
One could also write a macro which might be used like in the following:
(pipe
(thing-operation1 thing extra-arg1)
(thing-operation2 _2 extra-arg2)
(thing-operation3 _3 extra-arg3)
(thing-operation4 _4 extra-arg4))
Some language provide similar macros and Lisp libraries may provide variations of it. Let's write a simple version of it:
(defmacro pipe (expression &rest expressions)
(if (null expressions)
expression
(destructuring-bind ((fn arg &rest args) &rest more-expressions)
expressions
(declare (ignorable arg))
`(pipe
(,fn ,expression ,#args)
,#more-expressions))))
For above pipe expression the following code is produced:
(THING-OPERATION4
(THING-OPERATION3
(THING-OPERATION2
(THING-OPERATION1 THING EXTRA-ARG1)
EXTRA-ARG2)
EXTRA-ARG3)
EXTRA-ARG4)
A variant:
(defmacro pipe (expression &rest expressions)
(if (null expressions)
expression
(destructuring-bind ((fn arg &rest args) &rest more-expressions)
expressions
`(pipe
(let ((,arg ,expression))
(,fn ,arg ,#args))
,#more-expressions))))
This would let you write:
(pipe (+ 1000 pi)
(+ arg1 arg1) ; use the previous result multiple times
(+ arg2 (sqrt arg2))) ; use the previous result multiple times
Clojure has a threading operator, ->, which does what you expect:
(-> thing
(thing-operation1 extra-arg1)
(thing-operation2 extra-arg2)
(thing-operation3 extra-arg3))
You can implement this easily as a macro in other Lisp dialects. Greg Hendershott's rackjure library has a ~> form that does the same thing in Racket, for example.
The -> (or ~> in rackjure) macro splices the result in as the first argument of each subform. If you want to splice the result in as the last argument instead, there's a ->> macro (~>> in rackjure).
You might use the PROGN Common Lisp special form.
Or you could define your own Lisp macro to fit your taste.
how about
(reduce (lambda (a b) (funcall b a))
(list thing
(partial-apply op1 arg1)
(partial-apply op2 arg2)
...
(partial-apply opn argn) ))
(in Common Lisp). In Racket,
(foldl (lambda (a b) (a b))
thing (list
(partial-apply op1 arg1)
(partial-apply op2 arg2)
...
(partial-apply opn argn) ))
Regarding terminology, it's either ((curry fun) arg) or (partial-apply fun arg).
In Common Lisp, is it possible to redefine an already defined function within a certain scope? For example, given a function A that calls a function B. Can I temporarily redefine B during a call to A?
I'm looking for something along the lines of a let block, but that can redefine functions.
Within a given lexical scope, yes. Use FLET or LABELS. Any function defined with FLET will be unable to call functions defined in the same lexical scope, if you want that (for, say, self-recursive of a group of mutually recursive functions), you will need to use LABELS.
Note that both FLET and LABELS only establish lexical shadowing, should not be used to shadow functions from the COMMON-LISP package and will not dynamically change what function is called from outside the lexical scope the form establishes.
Local functions can be introduced with FLET and LABELS.
If you want to redefine/shadow an existing function using dynamic scope, this is a macro I've been using for a while.
(defmacro! with-shadow ((fname fun) &body body)
"Shadow the function named fname with fun
Any call to fname within body will use fun, instead of the default function for fname.
This macro is intentionally unhygienic:
fun-orig is the anaphor, and can be used in body to access the shadowed function"
`(let ((fun-orig))
(cond ((fboundp ',fname)
(setf fun-orig (symbol-function ',fname))
(setf (symbol-function ',fname) ,fun)
(unwind-protect (progn ,#body)
(setf (symbol-function ',fname) fun-orig)))
(t
(setf (symbol-function ',fname) ,fun)
(unwind-protect (progn ,#body)
(fmakunbound ',fname))))))
Usage:
Clozure Common Lisp Version 1.9-r15759 (DarwinX8664) Port: 4005 Pid: 4728
; SWANK 2012-03-06
CL-USER>
(defun print-using-another-fname (x)
(print x))
PRINT-USING-ANOTHER-FNAME
CL-USER>
(let ((*warn-if-redefine-kernel* nil))
(with-shadow (print (lambda (x)
(funcall fun-orig (+ x 5))))
(print-using-another-fname 10)))
15
15
CL-USER>
(print 10)
10
10
CL-USER>
Note that it relies on Doug Hoyte's defmacro! macro, available in Let Over Lambda.
Also as written, it's anaphoric (fun-orig is available within the body). If you want it completely hygienic, just change the fun-orig's to ,g!fun-orig's.
I most often redefine functions when writing unit tests. Mocking functions within the scope of a particular unit test is helpful, and sometimes that needs to be done with dynamic (not lexical) scope.
You can simulate dynamic-binding for funs like this:
(defmacro setvfun (symbol function)
`(progn
(setf ,symbol ,function)
(setf (symbol-function ',symbol) (lambda (&rest args) (apply (symbol-value ',symbol) args)))))
and then ,for example, with
(setvfun some-fun (lambda() (format t "initial-definition~%")))
(defun test-the-fun (&rest args) (apply #'some-fun args))
(defun test ()
(test-the-fun)
(flet ((some-fun () (format t "Lexically REDEFINED (if you see this, something is very wrong)~%")))
(test-the-fun))
(let ((some-fun (lambda (x) (format t "Dynamically REDEFINED with args: ~a~%" x))))
(declare (special some-fun))
(test-the-fun "Hello"))
(test-the-fun))
you get:
REPL> (test)
==>initial-definition
==>initial-definition
==>Dynamically REDEFINED with args: Hello
==>initial-definition