write acces to function slot (other than defun) [duplicate] - common-lisp

This question already has answers here:
How can I modify function bindings in Common Lisp?
(2 answers)
Closed 6 years ago.
The defun macro "stores" a function object in the function slot of a symbol, e.g.:
(defun f () "Hello.")
The function that prints "Hello" is now stored in the function slot of the symbol f.(And can be retrieved via #'f.)
Is there another way (other than defun) to write/"store" a function object in the function slot of a symbol?
Because something like (setf minus #'-) only would store the function object in the value slot of the symbol minus.

Is there another way (other than defun) to write/"store" a function object in the function slot of a symbol?
You can use symbol-function:
(setf (symbol-function 'f) (lambda () "Bye."))
(f) ; => "Bye."
(defun g () "Hello again.")
(setf (symbol-function 'f) (symbol-function 'g))
(f) ; => "Hello again."
Another possibility is to use fdefinition:
(setf (fdefinition 'f) (lambda () "Bye again.")
(f) ; => "By again"
They are almost equivalent. The main difference is that symbol-function requires an argument which must be a symbol, while fdefinition accepts a function name, which can be also a list (see the glossary).

Related

Controlling the printing of special cons forms (e.g printing (function +) as #'+ etc)

I want some reader macros to print as as shortened expression that the macro understands. Lets say I want to extend the #' macro to take #'~[rest-of-symbol] and turn that into (complement #'rest-of-symbol).
What controls how that is printed? On SBCL, for instance, '(function +) prints as #'+. How do i make '(complement #'listp) print as #~listp?
My first thought was
(defmethod print-object :around ((obj cons) stream)
;; if #'~fn-name / (complement (function fn-name))
;; => fn-name otherwise NIL
(let ((fn-name
(ignore-errors
(destructuring-bind (complement (function fn-name))
obj
(when (and (eq complement 'complement)
(eq function 'function))
fn-name)))))
(if fn-name
(format stream "#'~~~S" fn-name)
(call-next-method))))
This works insofar as (print-object '(complement #'evenp) *standard-output*) prints it the way I want, but the REPL doesn't. Also (print-object '#'+ *standard-output*) prints it as (function +) so the REPL isn't using print-object. With defining the print-object method for user defined classes the REPL always picks up on the new definition.
This is my first post and I'm sorry I can't get the code to format properly. If someone can put a link on how to do that I would appreciate it.
Evaluation time
You are mixing code with data in your example:
(function +)
Is a special form that evaluates to a function object, which admits a shorter syntax:
#'+
But when you are writing:
'(function +)
or
'(complement fn)
Then in both cases you are writing quoted, literal lists, which evaluates to themselves (namely a list starting with symbol function or complement, followed respectively by symbol + and fn).
However, you want the code to be evaluated at runtime to actual function objects; if you type this in the REPL:
(complement #'alpha-char-p)
The result is a value that is printed as follows:
#<FUNCTION (LAMBDA (&REST SB-IMPL::ARGUMENTS) :IN COMPLEMENT) {101AAC8D9B}>
You have an actual function object that you can funcall. In other words, by the time you reach print-object, you no longer have access to source code, you are manipulating data at runtime which happens to be functions. So you cannot use destructuring-bind to get the complement symbol that was present in the source code.
What you need to do instead is to attach metadata to your function. There is a way to do that in Common Lisp by defining a new type of function, thanks to the Meta-Object Protocol.
Funcallable objects
I'm relying on Closer-MOP for all the symbols prefixed with c2cl: below. I define a new class of functions, annotated-fn, which is a function with addditional data:
(defclass annotated-fn (c2cl:funcallable-standard-object)
((data :initform :data :initarg :data :reader annotated-fn-data))
(:metaclass c2cl:funcallable-standard-class))
Notice that this class is a funcallable-standard-object (like the usual functions), and its metaclass is funcallable-standard-class. Such an object has an additional implicit slot that is a function to call.
More precisely, you have to call c2cl:set-funcallable-instance-function to set a function associated with the object, and when later you use funcall or apply with the object, then the wrapped function is called instead. So you can transparently use this class of functions wherever you usually use a function. It just has additional slots (here data).
For example, here is how I instantiate it, with a function to wrap additional data:
(defun annotate-fn (function data)
(let ((object (make-instance 'annotated-fn :data data)))
(prog1 object
(c2cl:set-funcallable-instance-function object function))))
Let's try it:
(describe
(annotate-fn (constantly 3)
'(:category :constantly)))
#<ANNOTATED-FN {1006275C7B}>
[funcallable-instance]
Lambda-list: UNKNOWN
Derived type: FUNCTION
Documentation:
T
Source file: SYS:SRC;CODE;FUNUTILS.LISP
Slots with :INSTANCE allocation:
DATA = (:CATEGORY :CONSTANTLY)
You can also use this object like any other function.
Now, your reader macros can expand into calls to annotate-fn, and add any kind of additional metadata you need to the function.
Reader macro
For our example, imagine you define a reader macros for constant functions:
(set-macro-character #\[ 'read-constantly t)
(set-macro-character #\] (get-macro-character #\) nil))
(defun read-constantly (stream char)
(declare (ignore char))
(let* ((list (read-delimited-list #\] stream t))
(value (if (rest list) list (first list)))
(var (gensym)))
`(let ((,var ,value))
(annotate-fn (constantly ,var)
(list :category :constantly
:constant ,var)))))
Using this syntax:
> [(+ 8 5)]
=> #<ANNOTATED-FN ...>
By the way, the syntax I defined also allows the following:
> [+ 8 5]
Pretty-printing
Let's define a generic function that prints an annotated function given its :category field:
(defgeneric print-for-category (category data object stream))
(defmethod print-object ((o annotated-fn) s)
(let* ((data (annotated-fn-data o))
(category (getf data :category)))
(print-for-category category data o s)))
Then, we can specialize it for :constantly, and here we assume also that the data associated with the function contains a :constant field:
(defmethod print-for-category ((_ (eql :constantly)) data o s)
(format s "[~s]" (getf data :constant)))
For example:
(let ((value (+ 8 6)))
(annotate-fn (constantly value)
`(:constant ,value
:category :constantly)))
This above is printed as:
[14]
Which would be the same as your hypothetical reader macro.
To do this you need to understand the pretty printer. I have understood it in the past but no longer do completely. It dispatches on type and the trick for things like this is that you can specify very specific types for trees of conses, although doing so is verbose.
Here is an example which is almost certainly not completely correct, but does achieve what you want in this case:
(defparameter *ppd* (copy-pprint-dispatch))
(defun pprint-complement-function (s form)
;; This is the thing that the pretty printer will call. It can
;; assume that the form it wants to print is already correct.
(destructuring-bind (complement (function name)) form
(declare (ignore complement function))
(format s "#'~~~W" name)))
;;; Now set this in the table with a suitable hairy type specification
;;;
(set-pprint-dispatch '(cons (eql complement)
(cons (cons (eql function)
(cons t null))
null))
'pprint-complement-function
0
*ppd*)
And now
> (let ((*print-pprint-dispatch* *ppd*))
(pprint '(complement (function foo)))
(pprint '((complement (function foo)) (function foo))))
#'~foo
(#'~foo #'foo)
You can make the awful nested cons type specifier easier by defining this (which, perhaps, should be the compound type specifier for list except you can't do that):
(deftype list-of-types (&rest types)
(labels ((lot (tt)
(if (null tt)
'null
`(cons ,(first tt) ,(lot (rest tt))))))
(lot types)))
And then
(set-pprint-dispatch '(list-of-types (eql complement)
(list-of-types (eql function)
*))
'pprint-complement-function
0
*ppd*)
is perhaps easier to read.

Why when I create an class can't find-symbol it?

I'm confuse about the symbols now, I tried:
CL-USER> (defclass foo2 () ())
#<STANDARD-CLASS COMMON-LISP-USER::FOO2>
CL-USER> (describe 'foo2)
COMMON-LISP-USER::FOO2
[symbol]
FOO2 names the standard-class #<STANDARD-CLASS COMMON-LISP-USER::FOO2>:
Direct superclasses: STANDARD-OBJECT
No subclasses.
Not yet finalized.
No direct slots.
; No value
CL-USER> (find-symbol "foo2")
NIL
NIL
Why I can't found the "foo2" symbol with the find-symbol function?
What I want do with this:
CL-USER> (defun my-make-instance (name n) (make-instance (make-symbol (format nil "~a-~a" name n)))
MY-MAKE-INSTANCE
CL-USER> (my-make-instance "foo" 2)
; Evaluation aborted on #<SB-PCL:CLASS-NOT-FOUND-ERROR foo2 {1003A3A003}>.
And I get:
There is no class named #:|foo2|.
how to I do this?
And other case:
CL-USER> (describe 'foo2)
COMMON-LISP-USER::FOO2
[symbol]
FOO2 names the standard-class #<STANDARD-CLASS COMMON-LISP-USER::FOO2>:
Direct superclasses: STANDARD-OBJECT
No subclasses.
Not yet finalized.
No direct slots.
; No value
CL-USER> (describe (intern "foo2"))
COMMON-LISP-USER::|foo2|
[symbol]
; No value
Why it happened? Is the "foo2" create by defclass a internal symbol, isn't?
Common Lisp is case sensitive and the reader is case converting; your source code generally gets converted to upper case when it is read by the compiler / interpreter. The symbol named "foo2" does not exist in your example, but the symbol named "FOO2" does.
The call to make-symbol will return a new symbol object, not the symbol object associated with your class.
The easiest way to fix your code would be to replace your make-symbol call in my-make-instance with a call to read-from-string to get the same case converting reader behavior to be used on your argument string. The reader will then also intern the symbol in the current package, ensuring it is the same symbol object as the one associated with your class. You also probably want to use defun instead of defmacro to define my-make-instance in this case.
In short you probably want the following code:
(defun my-make-instance (name n)
(make-instance (read-from-string (format nil "~a-~a" name n))))
(defclass foo-2 () ())
(my-make-instance "foo" 2)
;returns below instance
#<FOO-2 {100AB67443}>
If you describe the symbol and get
FOO2 names the standard-class #<STANDARD-CLASS COMMON-LISP-USER::FOO2>:
then FOO2 in uppercase characters really indicates that the symbol has an uppercase name.
* 'foo2
FOO2
Now you can use the function symbol-name to get the name of a symbol as a string:
* (symbol-name 'foo2)
"FOO2"
As you can see above, the name is uppercase.
Using the uppercase name to find the symbol then works:
* (find-symbol "FOO2")
FOO2
:INTERNAL

Adapting readmacros UCI Lisp code to common lisp

I'm trying to make the common lisp equivalent of this UCI Lisp/Interlisp helper function for a pattern mather.
(DRM /? (LAMBDA () (LIST '*VAR* (READ]
The documentation is a follows:
-Variables, which are used by the pattern matcher, start with a question mark ("?"), as in ?FOO.
-This is converted internally to (*VAR* role-name), so ?FOO becomes (*VAR* FOO).
-The DRM defines ? to convert itself to *VAR* when it is read
This is my current implementation of it:
(set-macro-character #\? (lambda () (list '*var* (read))))
But when I ran the match function below:
(match (ptrans (actor ?x) (object ?x) (to (store)))
(ptrans (actor (person)) (object (person)) (to (store))) nil)
I get the following error that's coming from DRM function:
*** - EVAL/APPLY: too many arguments given to :LAMBDA
Is my implementation correct?
Reader macro functions need to take two arguments: one for the stream from which they can read the source code, and one for the character that triggered them to be called. If you change your implementation to
(set-macro-character #\? (lambda (stream char)
(declare (ignore char))
(list '*var* (read stream))))
then any occurrence of ?x will be read as (*VAR* X).
Note that this will be evaluated if used as a function argument, which will cause an error if VAR is not a bound function / macro.
You probably want ?x to be read in as '(*VAR* X) (note the quote) to get the list as data.
In that case you should do this:
(set-macro-character #\? (lambda (stream char)
(declare (ignore char))
(list 'quote
(list '*var* (read stream)))))
to prevent evaluation of the form the reader macro function returns.

Testing if a Variable Contains a Function in Common Lisp

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.

How is it possible to call a locally defined function from its symbol?

According to the CLHS, FUNCALL argument is a function designator, which can be a symbol denoting a function defined in the global environment. I am looking for a way to do this locally, like in this example:
(defun test ()
(let ((name 'local-function))
(flet ((local-function ()
'hello))
(funcall name))))
I am looking for a way to get the function definition from the local environment. Is it possible with Common Lisp?
If you're just trying to call a local function using funcall, note that a function designator can also be the function object, and you can get that by using the (function name) == #'name notation. I.e., you can do:
(defun test ()
(flet ((local-function ()
'hello))
(funcall #'local-function)))
You can return this value, too, and so let the local function “escape” outside. E.g., you could implement a counter:
(defun make-counter (init)
(flet ((counter ()
(incf init)))
#'counter))
; This case is simple, and could have been:
;
; (defun make-counter (init)
; (lambda ()
; (incf init)))
(let ((counter (make-counter 3)))
(list (funcall counter)
(funcall counter)
(funcall counter)))
;=> (4 5 6)
As uselpa pointed out though, you won't be able to get the function object via a symbol, much in the same way that there's no association at runtime between the symbol named "X" and the lexical variable x in
(let ((x 'foo))
x)
The lexical variables don't have any association at run time with the symbols that named them in the source code.
According to this, no. It doesn't work with eval either. I suppose that at run-time there is no trace left of the local function's name.
Also, my understanding is that if the function designator is a symbol, then symbol-function is used, which is not defined for local functions.

Resources