From: Marc Dzaebel
Subject: defclass slot with method-combination?
Date:
Message-ID: <35EEAE1A.AF27CD93@rose.de>
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'.
Any idea? Thanks in advance!
Yours, Marc Dzaebel
From: Marc Dzaebel
Subject: Re: defclass slot with method-combination?
Date:
Message-ID: <35EFD1F0.4F41744C@rose.de>
Marc Dzaebel wrote:
>
> 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'.
>
> Any idea? Thanks in advance!
>
> Yours, Marc Dzaebel
From: Marc Dzaebel
Subject: Re: defclass slot with method-combination?
Date:
Message-ID: <35EFE38D.3044AC03@rose.de>
Marc Dzaebel wrote:
>
> 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'.
>
> Any idea? Thanks in advance!
>
> Yours, Marc Dzaebel
Dear Heiko,
once again this is an amazingly perfect answer. Even for bigger
class hierarchies this creates concatenated strings according
to the class precedence list. It appears I should have looked
in Chapter B of Allegros MOP-Concepts. It's a pitty that we
can't develop such things portable from scratch as it's not
yet standardized.
Thank you again for transfering you PLOB experience
(http://www.lisp.de/software/plob) to me ;-)
Yours, Marc
>>>>> "Marc" == Marc Dzaebel <····@rose.de> writes:
Marc> I need to define an inheritance behavior that concatenates
Marc> string-values of superclass-initforms with local slot
Marc> initforms. E.g.
Marc> (defclass super() ((f :accessor f :initform "head"))
Marc> (:metaclass user-class)) (defclass sub(super) ((f :accessor
Marc> f :initform "tail")) (:metaclass user-class))
Marc> I'd like to get the following:
Marc> (f(make-instance'sub)) -> "head tail"
Marc> I didn't find a standard option in defclass
Marc> slot-descriptions for this. I'd like to define the
Marc> concatenate combination for each meta-class 'user-class'.
Marc> Any idea? Thanks in advance!
Marc> Yours, Marc Dzaebel
The Metaobject Protocol (MOP) will extend CLOS in the way you want,
but I don't see a trivial way to do it.
You essentially need to write a masking method (with no call next
method) of the footprint:
(defmethod clos::compute-effective-slot-definition ((class user-class)
name
direct-slot-definitions)
...
You need to mask the existing clos::compute-effective-slot-definition
such that if the type of the slot represented by the first
direct-slot-definitions member is string, you need to cull the
direct-slot-definitions and compute the initform by concatenating all
the strings. That part is easy, but then you need to reinvent the code
for initializing the rest of the effective-slot-definition slots.
Perhaps the MOP needs another generic function, called something like
compute-effective-slot-defintion-slot-combinator that would do something
vaguely akin to varying method combination type - as you alluded to.
It would be defined in the present case something like:
(defmethod compute-effective-slot-defintion-slot-combinator
((initarg (eql :initforms))
inherited-direct-slot-definition-slot-contents-list)
...
and would be called as follows in the present case as follows:
(compute-effective-slot-defintion-slot-combinator :initforms '("tail" "head"))
It would return in the present case the initform "head tail",
but it could also be used for nifty things like combining all the documentation
strings in the heirarch in some useful way - or combining types in new
ways (I seem to remember KEE having sove different and useful ways
to combine slot types with their inherited types).
...or maybe I'm overlooking some simpler or more elegant way to do
what you want.
You can't just write an :after method on
compute-effective-slot-definition that overwrites
slot-definition-initform in the effective-slot-definition, because it
appears that Allegro has interpreted the MOP to mean that you can't
rewrite slots of slot definition metaobjects. I assume that the
reference that they are using is: "A slot definition metaobject cannot
be redefined" p 203 AMOP. or maybe I overlooked some more specific
reference.
If I were certain that there isn't another more specific AMOP
reference disallowing overwriting slot definition slots I might
quibble with them over their interpretation. It would make getting
what you want a ton easier. But you would have to change the
slot-definition-initform slot before you create any instances of
metaclass user-class or suffer the consequeces of having your data
inconsistanly initialized.
Cheers!
-Eric
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon
From: Marc Dzaebel
Subject: Re: defclass slot with method-combination?
Date:
Message-ID: <35F4E982.949FA6F5@rose.de>
Eric Peterson wrote:
> (defmethod clos::compute-effective-slot-definition ((class user-class)
> name
> direct-slot-definitions)
> ...
I got serveral replies on this topic. Unfortunately they only appeared
in
lisp mailing lists. Here are some approaches which are very similar to
yours.
Jon L White <····@harlequin.com> and ··············@poet.de
(defclass user-class (standard-class) ())
;;; ###### JonL: AMOP requires that sub-Metaclasses must defaultly be
;;; assumed to be NOT of a compatible representation; thus when
;;; compatibility is assured, the class designer has to put the
;;; following sort of method on VALIDATE-SUPERCLASS.
(defmethod validate-superclass ((class user-class) (super
standard-class))
t)
(defmethod clos:compute-effective-slot-definition
((the-class user-class)
;; ###### JonL: There is no SLOT-NAME argument in AMOP's
specification.
#-Liquid 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
)
#-Liquid
(declare (ignore slot-name))
(let ((slot-definition (call-next-method))
(new-initform nil))
;; ###### JonL: LCL's caller of this function, COMPUTE-SLOTS,
produces
;; one entry for every class in the Class-Precedence-List (in CPL
order)
;; so that some entries will be NIL instead of a slot-definition
object;
;; hence the NOT NULL test in the loop below. I don't think this
is part
;; of the standard, but was probably considered helpful for
coordinating
;; fixed-slot-index layout schemes.
(loop with initform
for slot in direct-slot-definitions
when (and (not (null slot))
(setq initform (clos:slot-definition-initform slot))
(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))
(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))
Michael Kappert <···@iitb.fhg.de>:
(defclass super () ((f :accessor f :initform "foo")))
(defclass sub (super) ((f :accessor f :initform "bar")))
(defmethod initialize-instance ((c super) &rest args)
(let* ((x (call-next-method))
(cpl (clos:class-precedence-list (class-of c)))
(initval))
(dolist (sc cpl)
(dolist (slot (clos:class-direct-slots sc))
(if (eq 'f (clos:slot-definition-name slot))
(push (clos:slot-definition-initform slot) initval))))
(setf (slot-value x 'f) initval)
x))
(f (make-instance 'sub))
==> ("foo" "bar")
(defclass sub1 (sub) ())
(defclass sub2 (sub1) ((f :accessor f :initform "baz")))
(f (make-instance 'sub2))
==> ("foo" "bar" "baz")
However, there are a lot of different remarks on the mailing list
···@lavielle.com.
Yours, Marc Dzaebel (http://members.xoom.com/dzaebel)
>>>>> "Marc" == Marc Dzaebel <····@rose.de> writes:
In article <·················@rose.de> Marc Dzaebel <····@rose.de> writes:
Marc> Eric Peterson wrote:
>> (defmethod clos::compute-effective-slot-definition ((class
>> user-class) name direct-slot-definitions) ...
Marc> I got serveral replies on this topic. Unfortunately they
Marc> only appeared in lisp mailing lists. Here are some
Marc> approaches which are very similar to yours.
Marc> Jon L White <····@harlequin.com> and ··············@poet.de
Jon L's code is wise and true. He conditionalized for multiple
implementations, but since I saw this post on comp.lang.lisp.franz, I
should point out that that call to
(setf (slot-value slot-definition 'clos::initform) new-initform)
won't work under Allegro because they don't allow altering slot
contents of slot definition objects.
I grumbled about this when I first I discovered this, but I'm now
leaning toward liking Franz's AMOP interpretation. It makes it more
difficult to solve this problem at hand, but should we consider it
proper sw engineering to let CLOS's default machinery go to the
trouble of computing a metaobject's slot contents and then overwrite
this information with our augmenting code? This could cause
inefficiency; it also seems that some would-be CLOS augmentor could
come along afterwards and provide this same slot an altered value via
an initarg. Her hard work would then be thwarted by the person who
mutated the slot contents after initialization.
Anyway regardless of whether you follow or agree with my arguments
or not, it seems to me that it would greatly benefit us to take steps
toward standardization of our MOP and get it ANSII-ready. Although I
have my preference on how to handle the present MOP issue, I prefer to
have it settled the other way than to not be settled and not be able
to use others MOP code.
YMMV,
-Eric
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon
>>>>> "Marc" == Marc Dzaebel <····@rose.de> writes:
In article <·················@rose.de> Marc Dzaebel <····@rose.de> writes:
Marc> Eric Peterson wrote:
>> (defmethod clos::compute-effective-slot-definition ((class
>> user-class) name direct-slot-definitions) ...
Marc> I got serveral replies on this topic. Unfortunately they
Marc> only appeared in lisp mailing lists. Here are some
Marc> approaches which are very similar to yours.
Hi Marc,
The code you posted will work under Allegro with one slight #+ tweak
but I'm going to pick at one possible nit anyway:
(setf (slot-value slot-definition 'clos::initform) new-initform)
is not strictly portable (although it seems to be de-facto portable).
The AMOP MOP doesn't specify or even know about slot names, therefore
portable programs can't know about MOP implementation slot names.
Allegro doesn't provide a writer for this slot under their interpretation
of the AMOP MOP.
The AMOP MOP seems to argue both for and against their interpretation:
________________________________________________________________________
(p 203 Initialization of Slot Definition Metaobjects)
"The value can then be accessed by calling the appropriate accessor as shown in
Table 6.4"
Table 6.4 refers to "accessors"
________________________________________________________________________
The fact that they use the term accessor seems to suggest that one should expect to
be able to write as well as read.
On the other hand ...
________________________________________________________________________
p 197 (Initialization of Generic Function Metaobjects)
"A generic function metaobject can be redefined by calling
reinitialize-instance"
________________________________________________________________________
This seems to suggest that mere slot tweaking is redefinition as
prohibited below:
________________________________________________________________________
p 203 (Initialization of Slot Definition Metaobjects)
"A slot definition metaobject cannot be redefined; calling
reinitialize-instance signals an error"
________________________________________________________________________
One interpretation consistent with both views is to say that the term
"accessor"
was used loosely.
I grumbled about Allegro's interpretation when I first I discovered
it, but I'm now leaning toward liking it. Their interpretation makes
it more difficult to solve this problem at hand, but should we
consider it proper sw engineering to let CLOS's default machinery go
to the trouble of computing a metaobject's slot contents and then
overwrite this information with our augmenting code? This could cause
inefficiency; it also seems that some would-be CLOS augmentor could
come along afterwards and provide this same slot an altered value via
an initarg. Her hard work would then be thwarted by the person who
mutated the slot contents after initialization.
Anyway - regardless of whether you follow or agree with my arguments
I'm claiming that portable code can't overwrite slot definition object
initialized values.
So the solution seems to become the more complicated code that I've
included below.
Note that I am still recomputing slot contents as I argued against
above, but COMPUTE-EFFECTIVE-SLOT-DEFINITION doesn't allow overriding
methods (Bullet 3 page 144 AMOP - 5.3.1 Restrictions on implementations).
________________________________________________________________________
(in-package :user)
;;;Didn't port beyond Allegro 'cause that's where the question appeared.
;;;Left as an exercise to the reader ;^)
(defclass user-class (standard-class) ())
(defclass user-effective-slot-definition
(clos:standard-effective-slot-definition)
())
(defparameter *initialization-string* nil
"Can't find another way to communicate with initialize-instance")
(defmethod clos:compute-effective-slot-definition
((class user-class)
name
direct-slot-definitions
&aux
(*initialization-string* ""))
(declare (ignore name))
(typecase (clos:slot-definition-initform
(first direct-slot-definitions))
(string
;; nifty empowerment from John L. White:
(loop for (direct-slot-definition . rest-of-deffs)
on direct-slot-definitions
do (setf *initialization-string*
(concatenate 'string
*initialization-string*
(clos:slot-definition-initform direct-slot-definition)
(if rest-of-deffs
" "
""))))))
(call-next-method))
(defmethod clos:effective-slot-definition-class
((class user-class)
&rest
initargs)
(declare (ignore initargs))
(find-class 'user-effective-slot-definition))
(defmethod initialize-instance
((slot-def user-effective-slot-definition) &rest initargs)
(when *initialization-string*
;;I hate mutating precomputed values, but I don't see another choice.
;;compute-effective-slot-definition doesn't allow overriding methods
;;(Bullet 3 page 144 AMOP - 5.3.1 Restrictions on implementations)
(setf (getf initargs :initform) *initialization-string*)
(setf (getf initargs :initfunction)
(let ((initialization-string *initialization-string*))
#'(lambda () initialization-string))))
(apply #'call-next-method slot-def initargs))
#|
(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))
|#
________________________________________________________________________
-Eric
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon
>>>>> "Marc" == Marc Dzaebel <····@rose.de> writes:
In article <·················@rose.de> Marc Dzaebel <····@rose.de> writes:
Marc> Eric Peterson wrote:
>> (defmethod clos::compute-effective-slot-definition ((class
>> user-class) name direct-slot-definitions) ...
Marc> I got serveral replies on this topic. Unfortunately they
Marc> only appeared in lisp mailing lists. Here are some
Marc> approaches which are very similar to yours.
Hi Marc,
The code you posted will work under Allegro with one slight #+ tweak
but I'm going to pick at one possible nit anyway:
(setf (slot-value slot-definition 'clos::initform) new-initform)
is not strictly portable (although it seems to be de-facto portable).
The AMOP MOP doesn't specify or even know about slot names, therefore
portable programs can't know about MOP implementation slot names.
Allegro doesn't provide a writer for this slot under their interpretation
of the AMOP MOP.
The AMOP MOP seems to argue both for and against their interpretation:
________________________________________________________________________
(p 203 Initialization of Slot Definition Metaobjects)
"The value can then be accessed by calling the appropriate accessor as shown in
Table 6.4"
Table 6.4 refers to "accessors"
________________________________________________________________________
The fact that they use the term accessor seems to suggest that one should expect to
be able to write as well as read.
On the other hand ...
________________________________________________________________________
p 197 (Initialization of Generic Function Metaobjects)
"A generic function metaobject can be redefined by calling
reinitialize-instance"
________________________________________________________________________
This seems to suggest that mere slot tweaking is redefinition as
prohibited below:
________________________________________________________________________
p 203 (Initialization of Slot Definition Metaobjects)
"A slot definition metaobject cannot be redefined; calling
reinitialize-instance signals an error"
________________________________________________________________________
One interpretation consistent with both views is to say that the term
"accessor"
was used loosely.
I grumbled about Allegro's interpretation when I first I discovered
it, but I'm now leaning toward liking it. Their interpretation makes
it more difficult to solve this problem at hand, but should we
consider it proper sw engineering to let CLOS's default machinery go
to the trouble of computing a metaobject's slot contents and then
overwrite this information with our augmenting code? This could cause
inefficiency; it also seems that some would-be CLOS augmentor could
come along afterwards and provide this same slot an altered value via
an initarg. Her hard work would then be thwarted by the person who
mutated the slot contents after initialization.
Anyway - regardless of whether you follow or agree with my arguments
I'm further claiming that portable code can't overwrite slot definition object
initialized values because it won't work under Allegro.
So the solution seems to become the more complicated code that I've
included below.
Note that I am still recomputing slot contents as I argued against
above, but COMPUTE-EFFECTIVE-SLOT-DEFINITION doesn't allow overriding
methods (Bullet 3 page 144 AMOP - 5.3.1 Restrictions on implementations).
________________________________________________________________________
(in-package :user)
;;;Didn't port beyond Allegro 'cause that's where the question appeared.
;;;Left as an exercise to the reader ;^)
(defclass user-class (standard-class) ())
(defclass user-effective-slot-definition
(clos:standard-effective-slot-definition)
())
(defparameter *initialization-string* nil
"Can't find another way to communicate with initialize-instance")
(defmethod clos:compute-effective-slot-definition
((class user-class)
name
direct-slot-definitions
&aux
(*initialization-string* ""))
(declare (ignore name))
(typecase (clos:slot-definition-initform
(first direct-slot-definitions))
(string
;; nifty empowerment from John L. White:
(loop for (direct-slot-definition . rest-of-deffs)
on direct-slot-definitions
do (setf *initialization-string*
(concatenate 'string
*initialization-string*
(clos:slot-definition-initform direct-slot-definition)
(if rest-of-deffs
" "
""))))))
(call-next-method))
(defmethod clos:effective-slot-definition-class
((class user-class)
&rest
initargs)
(declare (ignore initargs))
(find-class 'user-effective-slot-definition))
(defmethod initialize-instance
((slot-def user-effective-slot-definition) &rest initargs)
(when *initialization-string*
;;I hate mutating precomputed values, but I don't see another choice.
;;compute-effective-slot-definition doesn't allow overriding methods
;;(Bullet 3 page 144 AMOP - 5.3.1 Restrictions on implementations)
(setf (getf initargs :initform) *initialization-string*)
(setf (getf initargs :initfunction)
(let ((initialization-string *initialization-string*))
#'(lambda () initialization-string))))
(apply #'call-next-method slot-def initargs))
#|
(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))
|#
________________________________________________________________________
-Eric
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon
--
Eric L. Peterson; MITRE Corp.; Artificial Intelligence Technologies Center
1820 Dolley Madison Blvd.; McLean, VA 22102-3481
····@ai.mitre.org http://www.cs.umd.edu/users/ericp
"I never meta-class I didn't like" -anon