According to this question, an alias to a function can be created like so:
(defun some-function () ...)
(setf (fdefinition 'sfunc) #'some-function)
But:
(defun some-function () ...)
(defun (setf some-function) () ...)
(setf (fdefinition 'sfunc) #'some-function)
> (setf (sfunc) ...)
; caught STYLE-WARNING:
; undefined function: (SETF SFUNC)
The alias is not created for the setf function. How can an alias be created for a setf function?
(setf (fdefinition '(setf sfunc)) (fdefinition '(setf some-function)))
Related
I am using SBCL, Emacs, and Slime. Hence, I can do:
CL-USER> (defvar example #'(lambda (x) (* x 20)))
EXAMPLE
CL-USER> (funcall example 10)
200
Ok. It works as expected. Using the library Dexador, I can also so:
CL-USER> (ql:quickload :dexador)
To load "dexador":
Load 1 ASDF system:
dexador
; Loading "dexador"
.......
(:DEXADOR)
CL-USER> (dex:get "http://www.paulgraham.com")
"big HTML ommited"
200
#<HASH-TABLE :TEST EQUAL :COUNT 11 {10029F1443}>
#<QURI.URI.HTTP:URI-HTTP http://www.paulgraham.com>
#<SB-SYS:FD-STREAM for "socket 10.0.0.193:44936, peer: 74.6.52.135:80" {1002681F73}>
Now, I am trying to make the argument to be passed be a function! More specifically, the dex:get function. I tried different approaches, but none of them worked out:
CL-USER> (defvar example-failing #'(lambda (x) (x "http://www.paulgraham.com")))
; in: DEFVAR EXAMPLE-FAILING
; (LAMBDA (X) (X "http://www.paulgraham.com"))
;
; caught STYLE-WARNING:
; The variable X is defined but never used.
; in: DEFVAR EXAMPLE-FAILING
; (X "http://www.paulgraham.com")
;
; caught STYLE-WARNING:
; undefined function: COMMON-LISP-USER::X
;
; compilation unit finished
; Undefined function:
; X
; caught 2 STYLE-WARNING conditions
EXAMPLE-FAILING
CL-USER> (funcall example-failing dex:get)
; Evaluation aborted on #<UNBOUND-VARIABLE GET {1002C57103}>.
CL-USER> (funcall example-failing 'dex:get)
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1002DEA263}>.
CL-USER> (funcall example-failing #'dex:get)
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1002F906C3}>.
CL-USER> (funcall example-failing (function dex:get))
; Evaluation aborted on #<UNDEFINED-FUNCTION X {1003147F83}>.
I managed to do it with:
CL-USER> (defvar hacky-eval #'(lambda (x) (eval x)))
HACKY-EVAL
CL-USER> (funcall hacky-eval (dex:get "http://www.paulgraham.com"))
"big html omitted"
But, this feels as bad practice. Is there another way to fix this?
Thanks
I am confused by your question although not as confused as you seem to be. You already seem to know that, to call a function which is the value of a variable, you need either
funcall if you have all the arguments as individual things;
apply if you have only a list of arguments;
and that to get the function value of something you need (function thing) or equivalently #'thing[1].
But then you forget that in your function, and pay no attention to the copious warnings from SBCL.
So
(defvar *example* (lambda (f) (funcall f "http://www.paulgraham.com")))
...
(funcall *example* #'dex:get)
Note that none of this (and nothing in your question) relies on lexical scope: this would all have worked in any historical Lisp.
[1]: you don't need #' for (lambda ...) only because lambda is a macro which expands into (function (lambda ...)). Very old code sometimes uses the explicit #'(lambda ...) form since this macro did not always exist in CL.
Your code:
(defvar example-failing
#'(lambda (x)
(x "http://www.paulgraham.com")))
This makes no sense in Common Lisp. x is a variable. You can't use a variable as a function as in (x arg). In Common Lisp there are different namespaces for functions and variables. For example LET introduces a local variable and FLET introduces a local function.
The ways to call a function bound to a variable are:
(funcall x arg)
(apply x (list arg))
Thus correct examples would be:
(defvar example-failing
#'(lambda (x)
(apply x (list "http://www.paulgraham.com"))))
or
(defvar example-failing
#'(lambda (x)
(funcall x "http://www.paulgraham.com")))
Your solution is no solution
This is your example:
CL-USER> (defvar hacky-eval #'(lambda (x) (eval x)))
HACKY-EVAL
CL-USER> (funcall hacky-eval (dex:get "http://www.paulgraham.com"))
"big html omitted"
This does not work as you think.
(funcall hacky-eval (dex:get "http://www.paulgraham.com"))
is just the same as
(funcall hacky-eval "big html omitted")
and then
(eval "big html omitted")
and then
"big html omitted"
All your call to eval does is to evaluate a string to itself.
You really need to understand basic evaluation rules in Lisp:
(defun foo (arg)
(eval arg))
(foo (+ 3 4))
is simply the same as:
(defun foo (arg)
arg)
(foo (+ 3 4))
which is the same as
(identity (+ 3 4))
Note: if you pass just self evaluating data to EVAL, then all it does is to return the data
A function call (foo (+ 1 2)) works like this:
Lisp sees that FOO is a function
Lisp evaluates the arguments. (+ 1 2) -> 3
Lisp calls the function FOO with the evaluated argument: (funcall #'foo 3)
Lisp computes the function FOO: (EVAL 3) -> 3
Lisp returns the value(s) from FOO -> 3
Start by using a proper defun:
(defun request (url)
(dex:get url))
CL-USER> (request "http://…")
Now you want to use something else than dex:get? Well… write another function, because their argument handling, headers, return values… might be different.
(defun request-drakma (url)
(drakma:… url))
Maybe in later code you want to reference to either function?
(defun do-request (url &optional (get-fn #'request))
(funcall get-fn url))
(defvar example #'(lambda (x) (* x 20)))
Here you are giving a name to an anonymous function… just use defun^^
I'm trying to write a macro that defines some helpers for struct-of-arrays data structure (based on this snippet). Inside that macro I define another macro that helps with traversing all of the slot values in struct. The thing is I can't make double unquoting work properly. Here's the code:
(defmacro defcomponent (name-and-options &body slots)
(setf name-and-options (ensure-list name-and-options))
(let ((struct (first name-and-options))
(slot-names (iter (for s in slots)
(collecting
(ematch s
((or (and name (symbol)
(<> _ '*)
(<> _ nil))
(list* name _ (plist :type _ :read-only _)))
name))))))
`(progn (defstruct ,name-and-options
;; some task-specific stuff omitted here
)
(defmacro ,(symbolicate 'with- struct) (components &rest body)
`(loop
,#',(iter (for s in slot-names)
(appending `(for ,s across (,(symbolicate struct '- s) components))))
do ,#body)))))
So for instance (defcomponent buzz x y) macroexpands to
(PROGN
(DEFSTRUCT (BUZZ)
X Y) ;; details omitted
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP ,#'(FOR X ACROSS (BUZZ-X COMPONENTS) FOR Y ACROSS (BUZZ-Y COMPONENTS))
DO ,#BODY))
which kinda works, but I want to access components parameter of the internal with-buzz macro, i.e. something like this
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
`(LOOP FOR X ACROSS (BUZZ-X ,COMPONENTS) FOR Y ACROSS (BUZZ-Y ,COMPONENTS)
DO ,#BODY))
How do I possibly acheive that? I've tried a lot of the combinations of , and ,# to no avail.
Sometimes it helps not to work with backquote patterns. Then scope problems can be easier understood with the help of a compiler, which would warn about the usual variable scope problems.
As a slightly simplified exercise, we will write a function, which generates code. The generated code is a macro definition, which itself generates code.
(defun makeit (name slots)
(labels ((symbolicate (pattern &rest things)
(intern (apply #'format nil pattern things)))
(compute-for-clauses (slots)
(loop for s in slots
append (list ''for (list 'quote s)
''across (list 'list
(list 'quote
(symbolicate "~a-~a" name s))
'components)))))
(list 'progn
(list 'defmacro
(symbolicate "WITH-~a" name)
'(components &rest body)
(append '(list* 'loop)
(compute-for-clauses slots)
(list ''do 'body))))))
Example
CL-USER 51 > (pprint (makeit 'buzz '(x y)))
(PROGN
(DEFMACRO WITH-BUZZ (COMPONENTS &REST BODY)
(LIST* 'LOOP
'FOR
'X
'ACROSS
(LIST 'BUZZ-X COMPONENTS)
'FOR
'Y
'ACROSS
(LIST 'BUZZ-Y COMPONENTS)
'DO
BODY)))
CL-USER 52 > (eval *)
NIL
CL-USER 53 > (macroexpand-1 '(with-buzz a (+ 12) (+ 30)))
(LOOP FOR X ACROSS (BUZZ-X A) FOR Y ACROSS (BUZZ-Y A) DO (+ 12) (+ 30))
T
All right, I've managed to do it by resorting to manual list construction + eval instead of quasiquoting, but sweet mother of god it looks so hakish.
;; skip
(defmacro ,(symbolicate 'with- struct) (components &rest body)
(append
'(loop)
(eval
`(iter (for s in ',',slot-names)
(appending `(for ,s across (,(symbolicate ',',struct '- ,'s) ,,components)))))
'(do)
body))
I'll gladly accept any other answer solving the problem more idiomatically.
I'm new to lisp (i'm experimenting with sbcl and ccl), i came across the use of car and cdr that can be chained arbitrarily within a single function call like (caddr).
I was wandering how one would write functions that behave like this...
Say for example i'd like my-eval to eval the input s-exp 3 times if i invoke it like (my-evaaal '(+ 2 1))
I've hacked my way around with a macro like
(my-ev $$$$ '(...)) where the behavior is dictated by the number of '$' in the first argument by transforming it into char sequence (coerce (symbol-name x) 'list) and the evaluate and recurse until the list is nil...
basic need:
;; if
(defvar *foo* 1)
(eval '*foo*) ;; => 1
(eval ''*foo*) ;; => *foo*
(eval '''*foo*) ;; => '*foo*
;; then
(eval (eval (eval '''*foo*))) ;; => 1
desired syntax
(my-eval '''*foo*) ;; => '*foo*
(my-evaal '''*foo*) ;; => *foo*
(my-evaaal '''foo) ;; => 1
Functions like CAAR, CADR are just regular functions; you can define a macro to help you define them easily if you want to.
Macros
(defpackage :so (:use :cl :ppcre))
(in-package :so)
(defmacro eval%% (count form)
(case count
(0 form)
(1 `(eval ,form))
(t (check-type count (integer 2))
`(eval%% ,(1- count) (eval ,form)))))
For example, the following :
(eval%% 3 '''most-positive-fixnum)
expands successively as:
(EVAL%% 2 (EVAL '''MOST-POSITIVE-FIXNUM))
(EVAL%% 1 (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
(EVAL (EVAL (EVAL '''MOST-POSITIVE-FIXNUM)))
Then, you can define custom eval functions as follows, or even with another macro:
(defun evaal (x) (eval%% 2 x))
(defun evaaal (x) (eval%% 3 x))
Handler and restarts
Alternatively, note that you can catch calls to undefined functions:
(block nil
(handler-bind ((undefined-function
(lambda (e)
(return
(values (cell-error-name e)
(compute-restarts e))))))
(evaaaaaal 'a)))
=> EVAAAAAAL
(#<RESTART CONTINUE {7FD5F5F8CE43}> #<RESTART USE-VALUE {7FD5F5F8CE03}>
#<RESTART SB-KERNEL::RETURN-VALUE {7FD5F5F8CDC3}>
#<RESTART SB-KERNEL::RETURN-NOTHING {7FD5F5F8CD83}>
#<RESTART SWANK::RETRY {7FD5F5F8DA13}> #<RESTART ABORT {7FD5F5F8DEC3}>
#<RESTART ABORT {7FD5F5F8EB03}>)
You can also use the standard USE-VALUE restart to provide a different function to call:
(defun multi-eval-handler (condition)
(let ((name (cell-error-name condition)))
(when (eq (symbol-package name) (find-package :so))
(register-groups-bind ((#'length count)) ("EV\(A+\)L" (string name))
(invoke-restart 'use-value (make-repeated-evaluator count))))))
You need an auxiliary function that computes an evaluation N times:
(defun make-repeated-evaluator (count)
(case count
(0 #'identity)
(1 #'eval)
(t (check-type count (integer 2))
(lambda (form)
(loop
for value = form then (eval value)
repeat count
finally (return value))))))
For example:
(funcall (make-repeated-evaluator 3)
'''most-positive-fixnum)
=> 4611686018427387903
And then, you can have arbitrarily long eval functions:
(handler-bind ((undefined-function #'multi-eval-handler))
(evaaaaaaaaaaaaaal '''''''''''''0))
Now, if you compile the code, you'll have warnings at compile-time about the unknown function, when then you can muffle warnings.
I am trying to make a 'pseudo OO system':
(defun bank-account ()
(let ((balance))
(labels ((init (x)
(setf balance x))
(increment (x)
(setf balance (+ balance x)))
(get-balance ()
balance))
(lambda (func)
(case func (init #'init)
(increment #'increment)
(get-balance #'get-balance))))))
(defparameter bank-account-object (bank-account))
(funcall (funcall bank-account-object 'init) 42)
(funcall (funcall bank-account-object 'increment) 10)
(funcall (funcall bank-account-object 'get-balance))
Q: are there better ways to accomplish the same without using CLOS, defstruct, or defmacro?
The problem that I see with this is that it is closed for extension, and I see no simple way to add extensibility.
Minor nitpick: that's not a bank-system but a bank-account. When you think about that further, it seems to me that the interesting part about this example domain has not been touched: double accounting, i. e. ensuring the null-sum invariant.
There are two sayings: a closure is a poor man's object, and an object is a poor man's closure. I have the feeling that you are more in the realm of the former here. However, it might be a good learning experience to think about this—as long as you don't put it into production somewhere…
;; The "class"
(defun create-bank-account ()
(let ((balance))
(labels ((init (x)
(setf balance x))
(increment (x)
(setf balance (+ balance x)))
(get-balance ()
balance))
(lambda (func)
(case func (init #'init)
(increment #'increment)
(get-balance #'get-balance))))))
;; The "methods"
(defun init-balance (object amount)
(funcall (funcall object 'init) amount))
(defun increment-balance (object amount)
(funcall (funcall object 'increment) amount))
(defun get-balance (object)
(funcall (funcall object 'get-balance)))
;; Example usage
(defparameter bank-account (create-bank-account))
(init-balance bank-account 42) ; => 42
(increment-balance bank-account 10) ; => 52
(get-balance bank-account) ; => 52
As mentioned in other answers, the resulting object might be hard to extend. That could be a feature, but one possible way to improve on it is to let it be redefined dynamically. You can even switch from classes to protoypes.
(ql:quickload :optima)
(defpackage :obj (:use :cl :optima))
(in-package :obj)
(defun make-object (&optional prototype)
(let ((properties (make-hash-table :test #'eq))
(self))
(flet ((resolve (key)
(or (gethash key properties)
(and prototype (funcall prototype :get key)))))
(setf self
(lambda (&rest args)
(optima:ematch args
((list :get :prototype) prototype)
((list :get key) (resolve key))
((list :set :prototype p)
(cerror "Continue" "Changing prototype object, are you sure?")
(setf prototype p))
((list :set key value)
(if value
(setf (gethash key properties) value)
(remhash key properties)))
((list :invoke method args)
(let ((resolved (resolve method)))
(if resolved
(apply resolved self args)
(funcall (or (resolve :no-such-method)
(error "No such method: ~a in ~a"
method
self))
self
method))))))))))
Some helper symbols:
;; call built-in command
(defmacro $ (obj method &rest args)
`(funcall ,obj ,method ,#args))
;; access property
(declaim (inline # (setf #)))
(defun # (o k) ($ o :get k))
(defun (setf #) (v o k) ($ o :set k v))
;; invoke method
(defun % (o m &rest a)
($ o :invoke m a))
A simple test
(let ((a (make-object)))
;; set name property
(setf (# a :name) "a")
;; inherit
(let ((b (make-object a)))
(print (list (# b :name)
;; shadow name property
(setf (# b :name) "b")
(# a :name)))
;; define a method
(setf (# a :foo) (lambda (self) (print "FOO")))
;; invoke it
(% a :foo)))
Bank account
(defun create-bank-account (&optional parent)
(let ((account (make-object parent)))
(prog1 account
(setf (# account :init)
(lambda (self x)
(setf (# self :balance) x)))
(setf (# account :increment)
(lambda (self increment)
(incf (# self :balance) increment))))))
(let ((account (create-bank-account)))
(% account :init 0)
(% account :increment 100)
(# account :balance))
100
(defun lat
(lambda (l)
(cond ((null l) t)
((atom (car l))(lat (cdr l))
(t nil))))
The function takes a list as an argument. It is a recursive function that checks every element in the list. Whether it is atom or not. If every element is an atom, then it returns true else false.
Following is the error displayed
While compiling LAT :
Bad lambda list : (LAMBDA (L)
(COND ((NULL L) T) ((ATOM # #)) (T NIL)))
[Condition of type CCL::COMPILE-TIME-PROGRAM-ERROR]
Just like Hal Abelson called Scheme "lisp" in the SICP videos this book does the same, however the language in the book is a predecessor to Scheme and not Common Lisp. When you see:
(define name
(lambda (arg ...)
body ...)
This is the same as this in CL:
(defun name (arg ...)
body ...)
The reason is that in Scheme it's the same namespace for operator as well as operand bindings. A lisp-2 like Common Lisp can split it up like this:
(setf (fdefinition 'name)
(lambda (arg ...)
body ...))
This probably won't happen since you can always use defun, but in the event you return a function from a function you can do this or you must rely on funcall or apply to use the returned value:
;; This is a function that creates a function
(defun get-counter (from step)
(lambda ()
(let ((tmp from))
(incf from step)
tmp)))
When using this you might want to bind it globally:
(setf (fdefinition 'evens) (get-counter 0 2))
(evens) ; ==> 0
(evens) ; ==> 2
Or in functions you get it bound to normal variables and need to funcall or apply:
(defparameter *odds* (get-counter 1 2))
(funcall *odds*)
; ==> 1
Which one do you prefer?
(list (funcall *odds*) (evens))
; ==> (3 4)
The ? in lat? inidicated predicate and in CL a p in the end does the same. Your function latp is suppose to return nil or t so it should not return a function at all. Thus:
(defun latp (list)
(cond ((null list) t)
((atom (car list)) (latp (cdr list)))
(t nil)))
This of course is the same as:
(defun latp (list)
(or (null list)
(and (atom (car list))
(latp (cdr list)))))
Unlike Scheme using the name list as the argument does not affect the function call to list.