I have added the following method to the generic function speak but would now like to remove this particular method in the REPL without removing the rest of the generic functions' methods.
(defmethod speak :around ((c courtier) string) ; [1]
(format t "Does the King believe that ~A?" string)
(if (eql (read) 'yes)
(if (next-method-p) (call-next-method)) ; [2]
(format t "Indeed, it is a preposterous idea.~%"))
'bow)
[1] The :around method replaces the primary method for the type.
[2] Then it decides whether to call the primary method or not.
The documentation link to the function remove-method has no examples and I don't know what is the syntax to refer to the actual :around method above.
(remove-method #'speak)
TOO FEW ARGUMENTS
(remove-method #'speak :around)
NO-APPLICABLE-METHOD
From the documentation:
remove-method generic-function method
It expects a generic function object and a method object as arguments.
One can find the method via find-method.
CL-USER 39 > (find-method #'speak
(list :around)
(list (find-class 'courtier) (find-class t)))
#<STANDARD-METHOD SPEAK (:AROUND) (COURTIER T) 42001285EB>
CL-USER 40 > (remove-method #'speak
(find-method #'speak
(list :around)
(list (find-class 'courtier)
(find-class t))))
#<STANDARD-GENERIC-FUNCTION SPEAK 422000A68C>
Note also that a good Lisp development environment may also allow to remove methods in the editor or the inspector.
Note that in the Lisp listener, one does not need to call find-method twice like above. The variable * contains the last result.
CL-USER 43 > (find-method #'speak
(list :around)
(list (find-class 'courtier)
(find-class t)))
#<STANDARD-METHOD SPEAK (:AROUND) (COURTIER T) 4200150DEB>
CL-USER 44 > (remove-method #'speak *)
#<STANDARD-GENERIC-FUNCTION SPEAK 422000A68C>
Here is another interaction example using SLIME in GNU Emacs with the presentation feature for SLIME enabled. A presentation is Lisp output, which keeps the connection between the printed object and the generated text.
Call the find-method function. It returns the method. Here we use presentations, which keep the connections between text and Lisp objects. The output is displayed in the color red and it is mouse-sensitive. Moving the mouse over the red returned object will add interaction options.
Now type (remove-method #'speak and then middle-click (or whatever SLIME is configured to use) on the red output: the presentation (the text and the connected object) will be copied to the line. Type ) and enter the form. SLIME has actually constructed a list with the real object and not the textual representation, then.
This is how repls work on the Symbolics Lisp Machine and in CLIM / McCLIM...
If using GNU Emacs with SLIME, you can also use slime-inspector. For example define generic function foo and two methods:
USER> (defgeneric foo (x))
#<STANDARD-GENERIC-FUNCTION FOO (0)>
USER> (defmethod foo ((x string)) (length x))
#<STANDARD-METHOD FOO (STRING) {100B4D7E23}>
USER> (defmethod foo ((x integer)) x)
#<STANDARD-METHOD FOO (INTEGER) {100C355843}>
You have two main options to enter the inspector:
From the REPL, type #'foo so that a presentation object for the generic method is printed:
USER> #'foo
#<STANDARD-GENERIC-FUNCTION FOO (0)>
Either right-click the presentation (anywhere inside #<...>) and select Inspect, or put the cursor in the presentation and press C-c C-v TAB (slime-inspect-presentation-at-point).
From a source file, enter slime-inspect, a.k.a. C-c I, and enter #'foo.
In both cases, you are shown a view similar to this:
#<STANDARD-GENERIC-FUNCTION {505A9A2B}>
--------------------
Name: FOO
Arguments: (X)
Method class: #<STANDARD-CLASS COMMON-LISP:STANDARD-METHOD>
Method combination: #<SB-PCL::STANDARD-METHOD-COMBINATION STANDARD () {1000214003}>
Methods:
(INTEGER) [remove method]
(STRING) [remove method]
(....)
Each [remove method] text is actually a button, click or press Return on any of them to remove the associated method from the generic function.
Related
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.
I want to create an interpreted function definition, not a compiled one.
SBCL manual says :
Variable: *evaluator-mode* [sb-ext] : Toggle between different evaluator
implementations. If set to :compile, an implementation of eval that
calls the compiler will be used. If set to :interpret, an interpreter
will be used.
So, I try to create a BAR function (which does not exist) :
(let ((sb-ext::*evaluator-mode* :interpret))
(defun bar (x) (+ x 1)))
But then, I check, and BAR is already compiled :
CL-USER> (compiled-function-p #'bar)
T
So, how do you create an interpreted version of BAR ?
The let form in your question only sets the evaluator mode at runtime. By then, the function has already been compiled.
You need to set it at load time and also make sure to load the file instead of compiling then loading it.
Try this:
In your-file.lisp:
;; at load time, set evaluator mode to interpret (before bar definition is met)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :interpret))
;;define your interpreted function
(defun bar (x)
(+ x 1))
;; set evaluator back to compile mode (optional)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :compile))
;;check if bar is a compiled function
(print (compiled-function-p #'bar)) ;;prints NIL
Then load it with (load "your-file.lisp") (this doesn't compile the file first).
I think that *evaluator-mode* is pretty inherently a global variable. For instance, if you do this:
> (setf sb-ext:*evaluator-mode* ':interpret)
:interpret
> (setf (symbol-function 'bar)
(lambda (x) x))
#<interpreted-function nil {10026E7E2B}>
> (compiled-function-p #'bar)
nil
you get an interpreted function. But if you do this:
> (setf sb-ext:*evaluator-mode* ':compile)
:compile
> (setf (symbol-function 'bar)
(let ((sb-ext:*evaluator-mode* ':interpret))
(lambda (x) x)))
#<function (lambda (x)) {52C3687B}>
> (compiled-function-p #'bar)
t
You don't. My take on this, which may be wrong, is that the value which is in effect at the start of each top-level form is what counts: once the system has decided that it's going to use the compiling-evaluator for a form then it can't change its mind.
And note that there is a complicated definition of 'top-level form', and in particular that when processing a file then in a form like
(let (...)
(x ...))
then (x ...) is not a top-level form.
A simple reflection warning example:
lein repl
user=> (set! *warn-on-reflection* true)
true
user=> (eval '(fn [x] (.length x)))
Reflection warning, NO_SOURCE_PATH:1:16 - reference to field length can't be resolved.
#object[user$eval2009$fn__2010 0x487ba4b8 "user$eval2009$fn__2010#487ba4b8"]
I want to make this into a function. But where do reflection warnings go?
//clojure/compile.java 63
RT.errPrintWriter()
.format("Reflection warning, %s:%d:%d - reference to field %s can't be resolved.\n",
SOURCE_PATH.deref(), line, column, fieldName);
//clojure/RT.java 269
public static PrintWriter errPrintWriter(){
Writer w = (Writer) ERR.deref();
//clojure/RT.java 188
final static public Var ERR =
Var.intern(CLOJURE_NS, Symbol.intern("*err*"),
new PrintWriter(new OutputStreamWriter(System.err), true)).setDynamic();
Ok so they go to System.err. Lets capture it's output:
(def pipe-in (PipedInputStream.))
(def pipe-out (PipedOutputStream. pipe-in))
(System/setErr (PrintStream. pipe-out))
(defn reflection-check [fn-code]
(binding [*warn-on-reflection* true]
(let [x (eval fn-code)
;_ (.println (System/err) "foo") ; This correctly makes us return "foo".
n (.available pipe-in)
^bytes b (make-array Byte/TYPE n)
_ (.read pipe-in b)
s (apply str (mapv char b))]
s)))
However, calling it gives no warning, and no flushing seems to be useful:
(println "Reflection check:" (reflection-check '(fn [x] (.length x)))) ; no warning.
How can I extract the reflection warning?
You have correctly discovered how *err* is initialized, but since vars are rebindable this is no guarantee about its current value. The REPL often rebinds it to something else, e.g. a socket. If you want to redirect it yourself, you should simply rebind *err* to a Writer of your choosing.
Really I'm not sure your approach would work even if *err* were never rebound. The Clojure runtime has captured a pointer to the original value of System.err, and then you ask the Java runtime to use a new value for System.err. Clojure certainly won't know about this new value. Does the JRE maintain an extra level of indirection to allow it to do these swaps behind the scenes even for people who have already captured System.err? Maybe, but if so it's not documented.
I ran into a similar problem a while back and created some helper functions modelled on with-out-str. Here is a solution to your problem:
(ns tst.demo.core
(:use tupelo.core tupelo.test) )
(defn reflection-check
[fn-code]
(let [err-str (with-err-str
(binding [*warn-on-reflection* true]
(eval fn-code)))]
(spyx err-str)))
(dotest
(reflection-check (quote (fn [x] (.length x)))))
with result:
-------------------------------
Clojure 1.10.1 Java 14
-------------------------------
err-str => "Reflection warning, /tmp/form-init3884945788481466752.clj:12:36
- reference to field length can't be resolved.\n"
Note that binding and let forms can be in either order and still work.
Here is the source code:
(defmacro with-err-str
"Evaluates exprs in a context in which *err* is bound to a fresh
StringWriter. Returns the string created by any nested printing
calls."
[& body]
`(let [s# (new java.io.StringWriter)]
(binding [*err* s#]
~#body
(str s#))))
If you need to capture the Java System.err stream, it is different:
(defmacro with-system-err-str
"Evaluates exprs in a context in which JVM System/err is bound to a fresh
PrintStream. Returns the string created by any nested printing calls."
[& body]
`(let [baos# (ByteArrayOutputStream.)
ps# (PrintStream. baos#)]
(System/setErr ps#)
~#body
(System/setErr System/err)
(.close ps#)
(.toString baos#)))
See the docs here.
There are 5 variants (plus clojure.core/with-out-str):
with-err-str
with-system-out-str
with-system-err-str
discarding-system-out
discarding-system-err
Source code is here.
I am reading the book successful lisp, There is a example:
(defstruct (ship
(:print-function
(lambda (struct stream depth)
(declare (ignore depth))
(format stream "[ship ~A of ~A at (~D, ~D) moving (~D, ~D)]"
(ship-name struct)
(ship-player struct)
(ship-x-pos struct)
(ship-y-pos struct)
(ship-x-vel struct)
(ship-y-vel struct)))))
(name "unnamed")
player
(x-pos 0.0)
(y-pos 0.0)
(x-vel 0.0)
(y-vel 0.0))
How can i understand this part:
(lambda (struct stream depth)
(declare (ignore depth))
why declare to ignore the depth? I feel quite confused, why not write lambda as
(lambda (struct stream)
.....)
Thanks
You cannot simply ignore arguments in Common Lisp - unlike, for example, javascript. That is, if you write a function such as
(defun foo (bar baz)
(list bar baz))
you cannot call it with any other number of arguments:
(foo 'a 'b) ; correct number of arguments
=> (a b)
(foo 'a) ; too few arguments
=> error
(foo 'a 'b 'c) ; too many arguments
=> error
As the printer functions are called with three arguments - the object, stream and depth - you must also define all printers with exactly three arguments. The declaration simply removes a warning message by indicating to the compiler you are intentionally leaving the parameter unused.
The Common Lisp standard says this:
If the :print-function option is used, then when a structure of type
structure-name is to be printed, the designated printer function is
called on three arguments:
the structure to be printed (a generalized instance of structure-name).
a stream to print to.
an integer indicating the current depth. The magnitude of this integer may vary between
implementations; however, it can reliably be compared against
*print-level* to determine whether depth abbreviation is appropriate.
So it is a three argument function. We need to write a function which takes three arguments then.
As usual, if our code does not use all arguments, we can declare them to be ignored, so that the compiler will not print a warning. Here the user has not used the variable depth.
Example: in the following function it is not clear if we forgot to use b or if not using it is on purpose.
CL-USER 21 > (defun foo (a b)
(list a))
FOO
CL-USER 22 > (compile 'foo)
;;;*** Warning in FOO: B is bound but not referenced
FOO
Now we can tell the compiler that we chose not to use b.
CL-USER 23 > (defun foo (a b)
(declare (ignore b))
(list a))
FOO
No warnings during compilation:
CL-USER 24 > (compile 'foo)
FOO
NIL
NIL
How can i specialize a generic function to take symbols designating subclasses of given class.
For example:
(defclass a () ())
(defclass b (a) ())
(defclass c (b) ())
(defclass d () ())
(defgeneric fun (param))
(defmethod fun ((param (<subclass of> a)))
(format t "~a is a subclass of A~%" param))
(fun 'c) ;-> "C is a subclass of A"
(fun 'd) ;-> Error: not found method for generic function call (fun 'd)
Is such dispatching possible with CLOS? And if it is, what should I write instead of "subclass of"?
Note that Common Lisp has the function SUBTYPEP:
CL-USER 15 > (subtypep 'd 'a)
NIL
T
CL-USER 16 > (subtypep 'c 'a)
T
T
See the documentation of SUBTYPEP for the meaning of the two return values (first says if it is a subtype). Classes are also types.
Which means that your functionality is just this:
(defun fun (class-name)
(if (subtypep class-name 'a)
(format t "~a is a subclass of A~%" class-name)
(error "wtf")))
Remember: inheritance in method works over class inheritance. That means to use the inheritance you have to pass an instance of a certain class:
(defmethod fun ((param a))
(format t "~a is a subclass of A~%" (class-name (class-of param))))
Above takes an instance of class A.
Call it:
CL-USER 29 > (fun (make-instance 'a))
A is a subclass of A
NIL
CL-USER 30 > (fun (make-instance 'c))
C is a subclass of A
NIL
CL-USER 31 > (fun (make-instance 'd))
Error: No applicable methods for #<STANDARD-GENERIC-FUNCTION FUN 418001813C>
with args (#<D 40200011E3>)
1 (continue) Call #<STANDARD-GENERIC-FUNCTION FUN 418001813C> again
2 (abort) Return to level 0.
3 Return to top loop level 0.
Type :b for backtrace or :c <option number> to proceed.
Type :bug-form "<subject>" for a bug report template or :? for other options.
CL-USER 32 : 1 >
There is a way to simplify^h^h^h^h^h^h^h^h make it easier to call: You can make sure that the class is finalized using something like CLOS:FINALIZE-INHERITANCE and the use a class prototype as input (calling CLASS-PROTOTYPE). That way you won't need to make instances of the class for dispatching. One would just use the prototype instance.
The alternative, ugly, version would be to hard-code the values:
(defmethod fun0 ((param (eql 'b)))
T)
(defmethod fun0 ((param (eql 'c)))
T)
You won't be able to easily perform this exact task using only CLOS dispatching.
Before I continue, I think some brief notes on terminology is important.
The Common Lisp HyperSpec glossary defines "subclass" in this way:
a class that inherits from another class, called a superclass. (No
class is a subclass of itself.)
This definition, while intuitive, seems odd to me as I'd expect that to be the definition of a "proper subclass". However, all classes are types, and it defines "subtype" as:
a type whose membership is the same as or a proper subset of the membership of another type, called a supertype. (Every type is a subtype of itself.)
Note the parenthetical: "Every type is a subtype of itself."
It also defines a "proper subtype":
(of a type) a subtype of the type which is not the same type as the type (i.e., its elements are a ``proper subset'' of the type).
So, in your example, B and C are subclasses of A, and also subtypes. On the other hand B, C, and A are subtypes of A.
The thing one puts in defmethod is a "parameter specializer name". It can be a symbol, a class (which is a little hard to type), or a list starting with eql. If you provide a symbol, it specifies the class named by that symbol (which is, of course, a type). An eql list specifies a type consisting of objects which are eql to the thing in the list.
The method will match any object which is a member of the type the specializer specifies. And of course, a member of a subtype of X is also a member of X.
So your first problem is that you are passing symbol objects to your method; every symbol is of type SYMBOL. A symbol that happens to name a class is no different in this respect; it's only relationship to the class is that it is the class's name, which is not a subtype relation.
There are class objects (returned by find-class), but they're no better than symbols for method specialization here because the type of a class object is usually the same as the type of its subclasses' class objects.
So, you're left using instances or reading AMOP to learn how to create your own types of generic functions.
Once you have an instance, you can write the method like this:
(defmethod fun ((param a))
(if (eq (type-of param) 'a)
(call-next-method)
(format t "~a is a subclass of A~%" (type-of param))))
If you have an easy way to retrieve instances of your classes, you could write this wrapper:
(defmethod fun ((param symbol))
(fun (retrieve-instance param)))
Then you'll be able to pass symbols to fun and get the results you want.
If you want to use AMOP functions (which were not specified by the standard but are widely available, see Closer Project), you can define retrieve-instance like this:
(defun retrieve-instance (name)
(let ((class (find-class name)))
(unless (class-finalized-p class)
(finalize-inheritance class))
(class-prototype class)))
Note that method dispatch is just about the only thing the result of class-prototype is good for; don't try to modify it or anything like that.