How to "cast" an instance to a subclass? - common-lisp

I have an instance of class message I'll call "msg". I have defined a class "my-message" and would like instance "msg" to now be of that class.
It sounds to me like it should be relatively straightforward, but I don't know how to do it. change-class gives me an error I don't understand.
(defclass my-message (message)
((account-name :accessor account-name :initform nil :initarg :account-name)))
(change-class msg 'my-message :account-name account-name)
ERROR :
While computing the class precedence list of the class named MW::MY-MESSAGE.
The class named MW::MESSAGE is a forward referenced class.
The class named MW::MESSAGE is a direct superclass of the class named MW::MY-MESSAGE.

The class named MW::MESSAGE is a forward referenced class.
A forward referenced class is a class that you reference but have not yet defined. If you look at the name of the class, it is MW::MESSAGE. I suppose you want to subclass another class named MESSAGE in another package; there might be something wrong with the symbols you import.
The class named MW::MESSAGE is a direct superclass of the class named MW::MY-MESSAGE.
Since the MW::MESSAGE class is not yet defined, you cannot make an instance of it. This is also why you cannot make an instance of any of its subclasses, such as MW::MY-MESSAGE.

This works for me:
CL-USER> (defclass message () ())
#<STANDARD-CLASS COMMON-LISP-USER::MESSAGE>
CL-USER> (defparameter *msg* (make-instance 'message))
*MSG*
CL-USER> (describe *msg*)
#<MESSAGE {1002FE43F3}>
[standard-object]
No slots.
CL-USER> (defclass my-message (message)
((account-name :accessor account-name
:initform nil
:initarg :account-name)))
#<STANDARD-CLASS COMMON-LISP-USER::MY-MESSAGE>
CL-USER> (change-class *msg* 'my-message :account-name "foo")
#<MY-MESSAGE {1002FE43F3}>
CL-USER> (describe *msg*)
#<MY-MESSAGE {1002FE43F3}>
[standard-object]
Slots with :INSTANCE allocation:
ACCOUNT-NAME = "foo"
Note that this is not a cast, since the object itself will be changed. It is now an instance of a different class. casting would usually mean that just the interpretation of the unchanged thing changes in some context. But here the instance is really changed and the old interpretation no longer applies.

Related

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

Access CLOS-object slots from used external package

I am learning to structure my CL programm and now having trouble to use the CLOS while programming in the large with packages.
package.lisp
(defpackage :my-project.a
(:use :cl)
(:export
create-my-object
my-object
; EXPORT SINGLE SLOTS?
my-slot-1
; my-slot-...
; my-slot-n
; OR EXPORT ALL ACCESSOR-FUNCTIONS?
my-slot-1-accessor
; my-slot-n-accessor...
))
(defpackage :my-project.b
(:use :cl :my-project.a)
(:export print-object-slot))
src.lisp
While the class MY-OBJECT is defined in MY-PROJECT.A
(in-package :my-project.a)
(defclass my-object ()
((my-slot-1 :accessor my-slot-1-accessor :initarg :my-slot-1)
;... more slots
; (my-slot-2 :accessor my-slot-2-accessor :initarg :my-slot-2)
; (my-slot-n :accessor my-slot-n-accessor :initarg :my-slot-n)
))
as some CREATOR function for the objects
(defun create-my-object ()
(make-instance 'my-object
:my-slot-1 "string"
;; further slots...
))
Having some function e.g. PRINT-OBJECT in the package MY-PROJECT.B,
which should handle the object instanciated from a function
(in-package :my-project.b)
(defun print-object-slot (slot-name object)
(format nil "slot-value: ~a" (SLOT-VALUE object slot-name)))
Problem
While executing following code doesn't work
(in-package :my-project.b)
(describe 'my-object) ; works
(print-object-slot
'my-slot-1 ; while this works: 'my-project.a:my-slot-1 [if slot is exported]
(create-my-object))
;; ==> slot MY-PROJECT.B:MY-SLOT-1 is missing from the object
;; MY-PROJECT.A:MY-OBJECT
To access my slots programmatically, in this situation I would need to merge the originating package-name with the slot-name, to get/setf the slot from external classes...
My understanding
The accessor-functions from CLOS objects are generic functions, belonging to the package, where they have been defined via DEFCLASS, in this case: MY-PROJECT.A
By (use-package :my-project.a) in MY-PROJECT.B, the exported symbols are imported, that's why DESCRIBE works. But the symbols of the generic-slot-accessor-functions aren't included.
Consideration:
The architecture of the programm should NOT be planned to share/export objects and slot-access. It's not well designed to bulk-import/export slots/accessor-functions.
Consideration:
You can build a custom function, which get/sets the slots via the slot-accessor-function inside their package, so there is just one interface function to export?
My question:
This way handling external CLOS objects doesnt seem to be the way to go.
How to export/import those accessor-functions in a sane way, without listing manually every single slot?
Edit/Solution
My terminolgy and use of slots vs. accessor-functions is a cause of this problem (thank you so much #RainerJoswig for clearing terminology up).
I did'nt use an exported version of MY-SLOT-1-ACCESSOR function, which would work as expected, but would need my to "bulk-export" them, if I would like to have access all slots in every other external package. #sds did a great job to show how to do this, and also at pointing out the general problem of my approach. Many thanks :)
In my mind, I wished to export just the object and gain full access to all the internal functions. But that's the wrong way for CLOS, since symbols and methods don't share direct bindings to the class/object, and I have to adapt better organisation of code.
Terminology
The question does not make the differences between a slot, slot-name and a slot accessor function clear. Conflating slot names and accessor functions is not that a good idea. You should be clear what is what.
(defpackage "GUI"
(:use "CL")
(:export
;; class
window
window-screen
window-width
window-height))
(defclass window ()
((screen :accessor window-screen :initarg :screen)
(width :accessor window-width :initarg :width :initform 640)
(height :accessor window-height :initarg :height :initform 400)))
Now screen is a slot name and window-screen is an accessor function.
The slot name is just a symbol. You can use any symbol for that. For example you can also write (just a random example, don't use):
(defpackage "SLOTS" (:use))
(defpackage "AC" (:use)
(:export
"WINDOW-SCREEN"
"WINDOW-WIDTH"
"WINDOW-HEIGHT"))
(defclass window ()
((slots::screen :accessor ac:window-screen :initarg :screen)
(slots::width :accessor ac:window-width :initarg :width :initform 640)
(slots::height :accessor ac:window-height :initarg :height :initform 400)))
Above would use slot names in a package slots and accessors in a package ac.
An accessor is a generic function.
So, when you write:
(defun foo (instance slot-name)
...)
I would expect that slot-name is a symbol, not an accessor function.
(defun foo (instance accessor)
...)
For above I would expect accessor to be a function, not a symbol.
If you really want to make the difference clear, you can write methods:
(defmethod foo (instance (path symbol))
(slot-value instance path))
(defmethod foo (instance (path function))
(funcall function instance))
What to export?
Usually I would export accessor names in a package, but not slot names.
Import?
But often I would not even import the package:
(defpackage "GUI-GAME"
(:use "CL"))
Above package does not import package gui. It could, but here it doesn't.
(defmethod describe-window ((w gui:window))
(format t "~% Window width:~a height:~a"
(gui:window-width w)
(gui:window-width h)))
The advantage is that I see two things in the source code:
gui:window is exported and thus part of a package interface
gui:window is actually from the package gui and there is no name
conflict with other symbols.
Just use the symbols for the class and the accessor functions with their package names prepended.
Exporting all accessors
You can use MOP to get the list of readers and
writers for your class and then export all of them, using
find-class
class-direct-slots
slot-definition-readers
export
like this:
(dolist (slot (class-direct-slots (find-class 'your-class-name)))
(dolist (reader (slot-definition-readers slot))
(export reader)))
Why is it so complicated?
Because you do not want to do that.
All code which needs indiscriminate access to all slots of a class
should be in the same package as the class.
The only symbols you export should be those you need to export, and
they should be explicitly vetted by you.
Your print-object-slot function is trying to call a function named literaly named slot-name, not the function named by the variable slot-name. You want to use funcall here.
(defun print-object-slot (slot-name object)
(format nil "slot-value: ~a" (funcall slot-name object)))

Is there a way to access slots in the superclass list in CLOS?

Is there a way to access slots of superclasses in CLOS?
E.g., in Objective C I can perform
- (void) frob {
[super frob]
}
This sends a message to the (sole) superclass of frob.
Perusing the CLOS documentation suggests that DEFCLASS merges all superclass information on class creation and thus this ability to communicate with the superclass is lost. Is this correct?
edit:
The scenario is somewhat unusual:
Given classes
(defclass animal ()
((behavior-types
:initform '(:eat :sleep :drink)
:reader behavior-types)))
(defclass cow (animal)
((behavior-types
:initform '(:moo :make-milk)
:reader behavior-types))
(defclass horse
((behavior-types
:initform '(:buck :gambol :neigh)
:reader behavior-types))
How to have a method, say, BEHAVIOR-TYPES or GET-BEHAVIOR that, when called with an object of type horse, returns '(:eat :sleep :drink :buck :gambol :neigh). That is to say, inheritance via a slot "adds" to the initform rather than replaces it.
An easy solution is, rather than to assign the data to the class, to have a generic method like so:
(defgeneric behavior-types (obj))
(defmethod behavior-types ((obj animal)) nil)
(defmethod behavior-types :around ((obj animal))
(append '(:eat :sleep :drink)
(call-next-method obj)))
(defmethod behavior-types :around ((obj horse))
(append '(:gambol :neigh :buck)
(call-next-method obj)))
However, this solution moves the data into the defgeneric rather than the class, where it properly belongs. So the motivation for the question came forth out of this.
At any rate - the question as asked reflected a misunderstanding of CLOS's design. It is not possible, as asked and within the normal framework, to perform this task. However, two separate approaches are given below using the MOP to solve the problem I posed.
The title of your question makes it sound like you're asking about how to access slots, but the code you show seems more like it's about calling methods that have been specialized for the superclass. If it's the latter that you're looking for, you should take a look at call-next-method, as well as 7.6 Generic Functions and Methods from the HyperSpec.
Calling “superclass methods”
In CLOS, methods don't belong to classes like they do in some other languages. Instead, there are generic functions on which specialized methods are defined. For a given argument list, a number of methods may be applicable, but only one is most specific. You can call the next most specific method with call-next-method. In the following transcript, there's a class FOO and a subclass BAR, and a generic function FROB which has methods specialized for FOO and BAR. In the method specialized for BAR, there's a call to call-next-method which, in this case, calls the method specialized for FOO.
CL-USER> (defclass foo () ())
;=> #<STANDARD-CLASS FOO>
CL-USER> (defclass bar (foo) ())
;=> #<STANDARD-CLASS BAR>
CL-USER> (defgeneric frob (thing))
;=> #<STANDARD-GENERIC-FUNCTION FROB (0)>
CL-USER> (defmethod frob ((foo foo))
(print 'frobbing-a-foo))
;=> #<STANDARD-METHOD FROB (FOO) {1002DA1E11}>
CL-USER> (defmethod frob ((bar bar))
(call-next-method)
(print 'frobbing-a-bar))
;=> #<STANDARD-METHOD FROB (BAR) {1002AA9C91}>
CL-USER> (frob (make-instance 'bar))
FROBBING-A-FOO
FROBBING-A-BAR
;=> FROBBING-A-BAR
Simulating it with method combinations
You can use method combinations to combine the results of the methods that are applicable to a list of arguments. For instance, you can define a method a with the method combination list that means when you call (a thing), all the methods on a applicable for the argument are called, and their results are combined into a list. If you give your slots in the different classes different names, and specialize methods on a that read those values, you can simulate the sort of thing you're looking for. This doens't prevent you from also using a traditional reader that accesses the slot, as well (e.g., get-a in the following example). The following code shows an example:
(defgeneric a (thing)
(:method-combination list))
(defclass animal ()
((animal-a :initform 'a :reader get-a)))
(defmethod a list ((thing animal))
(slot-value thing 'animal-a))
(defclass dog (animal)
((dog-a :initform 'b :reader get-a)))
(defmethod a list ((thing dog))
(slot-value thing 'dog-a))
(a (make-instance 'dog))
(get-a (make-instance 'animal))
;=> A
(get-a (make-instance 'dog))
;=> B
Using the MOP
This post from 1998 on Allegro CL archives is worth a read. It sounds like the author is looking for something similar to what you're looking for.
I need to define an inheritance behavior that concatenates
string-values of superclass-initforms with local slot initforms. E.g.
(defclass super()
((f :accessor f :initform "head")) (:metaclass user-class))
(defclass sub(super)
((f :accessor f :initform "tail")) (:metaclass user-class))
I'd like to get the following:
(f(make-instance'sub)) -> "head tail"
I didn't find a standard option in defclass slot-descriptions for
this. I'd like to define the concatenate combination for each
meta-class 'user-class'.
The response (by Heiko Kirschke, not me, but also see this response from Jon White with a similar approach), defines a new type of class:
(defclass user-class (standard-class) ())
and specializes clos:compute-effective-slot-definition to provide an initform that's computed from the slot definitions of the class and its superclass(es):
(defmethod clos:compute-effective-slot-definition
((the-class user-class) slot-name
;; The order of the direct slots in direct-slot-definitions may
;; be reversed in other LISPs (this is code written & tested with
;; ACL 4.3):
direct-slot-definitions)
(let ((slot-definition (call-next-method))
(new-initform nil))
(loop for slot in direct-slot-definitions
as initform = (clos:slot-definition-initform slot)
when (stringp initform)
do
;; Collecting the result string could be done perhaps more
;; elegant:
(setf new-initform (if new-initform
(concatenate 'string initform " "
new-initform)
initform)))
(when new-initform
;; Since at (call-next-method) both the initform and
;; initfunction of the effective-slot had been set, both must be
;; changed here, too:
(setf (slot-value slot-definition 'clos::initform) new-initform)
(setf (slot-value slot-definition 'clos::initfunction)
(constantly new-initform)))
slot-definition))
Then it's used like this:
(defclass super ()
((f :accessor f :initform "head"))
(:metaclass user-class))
(defclass sub(super)
((f :accessor f :initform "tail"))
(:metaclass user-class))
(f (make-instance 'sub))
==> "head tail"
This is getting into MOP functionality that's not specified by the spec, so you might have to adapt it for your particular implementation. There are some MOP compatibility layer packages out there that might be able to help you out, though.
There is no such concept as the instance slot of a superclass in CLOS.
If you create an instance, it has all slots. All slots from the class and its superclasses.
If a class has a slot FOO and some superclasses have also slots named FOO, all those are merged into one slot. Each instance of that CLOS class will have that slot.
Still you need to be more careful with your wording. Superclasses are objects themselves and they have slots themselves. But this has nothing to do with an instance having local slots and having superclasses with instance slots. The latter does not exist in CLOS.
CL-USER 18 > (defclass bar () (a b))
#<STANDARD-CLASS BAR 413039BD0B>
Above is then a superclass with two slots.
CL-USER 19 > (defclass foo (bar) (b c))
#<STANDARD-CLASS FOO 4130387C93>
Above is a class with two local and one inherited slot. The slot b is actually merged from this class and from the superclass.
CL-USER 20 > (describe (make-instance 'foo))
#<FOO 402000951B> is a FOO
B #<unbound slot>
C #<unbound slot>
A #<unbound slot>
Above shows that the instance has three slots and all can be directly accessed. Even the slot `a, which was defined in the superclass.
If we look at the actual superclass as an instance itself, we see its slots:
CL-USER 21 > (describe (find-class 'bar))
#<STANDARD-CLASS BAR 413039BD0B> is a STANDARD-CLASS
NAME BAR
DEFAULT-INITARGS NIL
DIRECT-DEFAULT-INITARGS NIL
DIRECT-SLOTS (#<STANDARD-DIRECT-SLOT-DEFINITION A 4020005A23> #<STANDARD-DIRECT-SLOT-DEFINITION B 4020005A93>)
DIRECT-SUBCLASSES (#<STANDARD-CLASS FOO 4130387C93>)
DIRECT-SUPERCLASSES (#<STANDARD-CLASS STANDARD-OBJECT 40F017732B>)
PRECEDENCE-LIST (#<STANDARD-CLASS BAR 413039BD0B> #<STANDARD-CLASS STANDARD-OBJECT 40F017732B> #<BUILT-IN-CLASS T 40F00394DB>)
PROTOTYPE NIL
DIRECT-METHODS NIL
WRAPPER #(1539 (A B) NIL #<STANDARD-CLASS BAR 413039BD0B> (#<STANDARD-EFFECTIVE-SLOT-DEFINITION A 4020005AFB> #<STANDARD-EFFECTIVE-SLOT-DEFINITION B 4020005B63>) 2)
LOCK #<MP::SHARING-LOCK "Lock for (STANDARD-CLASS BAR)" Unlocked 41303AD4E3>
DOCUMENTATION-SLOT NIL
PLIST (CLOS::COPYABLE-INSTANCE #<BAR 402000638B>)
POTENTIAL-INITARGS 0
MAKE-INSTANCE-FLAGS 509
OTHER-LOCK #<MP:LOCK "Lock for (OTHER STANDARD-CLASS BAR)" Unlocked 41303AD553>
REINITIALIZE-INITARGS 0
REDEFINE-INITARGS 0
DEPENDENTS NIL
This is really, really hasckish. I hope someone will step in and fix it, though it should illustrate the idea:
(defclass agent () ((behaviour :initform do-nothing :accessor behaviour-of)))
(defclass walk-agent (agent) ((behaviour :initform and-walk)))
(defclass talk-agent (walk-agent) ((behaviour :initform and-talk)))
(defmethod sb-mop:compute-effective-slot-definition
:after (class (name (eql 'behaviour)) sdlotds)
(setf *slot-def*
(loop
:for slot :in sdlotds :do
(format t "~&slot: ~s" (sb-mop:slot-definition-initform slot))
:collect (sb-mop:slot-definition-initform slot))))
(defmethod initialize-instance :before ((instance agent) &rest keyargs)
(declare (ignore keyargs))
(let (*slot-def*)
(declare (special *slot-def*))
(sb-mop:compute-slots (class-of instance))
(setf (behaviour-of instance) *slot-def*)))
;; (behaviour-of (make-instance 'talk-agent))
;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; slot: AND-TALK
;; slot: AND-WALK
;; slot: DO-NOTHING
;; (AND-TALK AND-WALK DO-NOTHING)
PS. I see that the function that computes the list of slots definitions in SBCL is in std-class.lisp, std-compute-slots. So it isn't something that MOP defines in some way... But this one would be really helpful here.

sbcl / CLOS Why do I have to add a "validate-superclass"-Method here?

In SBCL, when I define new metaclass
CL-USER> (defclass counting-class (standard-class)
((counter :initform 0)))
#<STANDARD-CLASS COUNTING-CLASS>
and add a method to the GF "make-instance":
CL-USER> (defmethod make-instance :after ((class counting-class) &key)
(incf (slot-value class 'counter)))
#<STANDARD-METHOD MAKE-INSTANCE :AFTER (COUNTING-CLASS) {25302219}>
I receive an error, if I try to create an Instance:
CL-USER> (defclass counted-point () (x y) (:metaclass counting-class))
The class #<STANDARD-CLASS STANDARD-OBJECT> was specified as a
super-class of the class #<COUNTING-CLASS COUNTED-POINT>, but
the meta-classes #<STANDARD-CLASS STANDARD-CLASS> and
#<STANDARD-CLASS COUNTING-CLASS> are incompatible. Define a
method for SB-MOP:VALIDATE-SUPERCLASS to avoid this error.
Now, if I add the required Definition:
CL-USER> (defmethod sb-mop:validate-superclass ((class counting-class)
(super standard-class))
t)
#<STANDARD-METHOD SB-MOP:VALIDATE-SUPERCLASS (COUNTING-CLASS STANDARD-CLASS) {26443EC9}>
It works:
CL-USER> (defclass counted-point () (x y) (:metaclass counting-class))
#<COUNTING-CLASS COUNTED-POINT>
My Question is: Why is this required?
From my POV it should be sufficient, to declare counting-class as an derivative of standard-class, as I did in the first step.
CLOS MOP spec for validate-superclass says that the default method returns t only in trivial cases and adds:
Defining a method on validate-superclass requires detailed knowledge
of of the internal protocol followed by each of the two class
metaobject classes. A method on validate-superclass which returns true
for two different class metaobject classes declares that they are
compatible.
You could consider your validate-superclass to be a declaration that you understand what you are doing.
Incidentally, I think you can define a class which would count its instances easier.
PS. Some implementations also return t in some other cases.

How to specialize generic function for subclasses of given class

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.

Resources