additional properties to slot definition
Asked Answered
W

1

5

http://mop.lisp.se/concepts.html says:

An implementation is free to add additional properties to the canonicalized slot specification provided these are not symbols accessible in the common-lisp-user package, or exported by any package defined in the ANSI Common Lisp standard.

with example:

(defclass sst (plane)
     ((mach mag-step 2
            locator sst-mach
            locator mach-location
            :reader mach-speed
            :reader mach))
  (:metaclass faster-class)
  (another-option foo bar))

But when i try:

(defclass a () ((x my-option 123)))

SBCL compile it with error:

Invalid initialization argument: MY-OPTION in call for class

                SB-MOP:STANDARD-DIRECT-SLOT-DEFINITION>.    

[Condition of type SB-PCL::INITARG-ERROR]

So the question. How can I add additional properties (like "my-option") to the slot definition?

Whitehead answered 24/2, 2014 at 11:52 Comment(0)
S
9

An implementation can do that. But the user can't add random properties. If a Common Lisp implementation supports the Meta-Object Protocol, one can add it via a custom Metaclass. But this means that one also needs to provide ways to compute slots, etc.

That's advanced Lisp. The Book The Art of the Metaobject Protocol has an example in chapter 3, Extending the Language.

A simple example (works in LispWorks):

(defclass foo-meta-class (standard-class) ())

(defclass foo-standard-direct-slot-definition (standard-direct-slot-definition)
  ((foo :initform nil :initarg :foo)))

(defclass foo-standard-effective-slot-definition (standard-effective-slot-definition)
  ((foo :initform nil :initarg :foo)))

(defmethod clos:direct-slot-definition-class ((class foo-meta-class) &rest initargs)
  (find-class 'foo-standard-direct-slot-definition))

(defmethod clos:effective-slot-definition-class ((class foo-meta-class) &rest initargs)
  (find-class 'foo-standard-effective-slot-definition))

Let's use it in an user-defined class:

(defclass foo ()
  ((a :initarg :a :foo :bar))
  (:metaclass foo-meta-class))

The slot-definition object then will have a slot foo with content bar.

CL-USER 10 > (find-class 'foo)
#<FOO-META-CLASS FOO 42200995AB>

CL-USER 11 > (class-direct-slots *)
(#<FOO-STANDARD-DIRECT-SLOT-DEFINITION A 42200B4C7B>)

CL-USER 12 > (describe (first *))

#<FOO-STANDARD-DIRECT-SLOT-DEFINITION A 42200B4C7B> is a FOO-STANDARD-DIRECT-SLOT-DEFINITION
FOO                     :BAR
READERS                 NIL
WRITERS                 NIL
NAME                    A
INITFORM                NIL
INITFUNCTION            NIL
TYPE                    T
FLAGS                   1
INITARGS                (:A)
ALLOCATION              :INSTANCE
DOCUMENTATION-SLOT      NIL

Obviously there is more to it, if the property should have any real meaning.

Snuck answered 24/2, 2014 at 12:46 Comment(5)
Thanks! This example works fine with lispworks. But with SBCL and closer-mop it return an error: "The class #<STANDARD-CLASS STANDARD-OBJECT> was specified as a super-class of the class #<FOO-META-CLASS FOO>, but the meta-classes #<STANDARD-CLASS STANDARD-CLASS> and #<STANDARD-CLASS FOO-META-CLASS> are incompatible. Define a method for SB-MOP:VALIDATE-SUPERCLASS to avoid this error. [Condition of type SIMPLE-ERROR]"Whitehead
You just need to do exactly what it says: (defmethod validate-superclass ((class foo-meta-class) (superclass standard-class)) t) (documentation)Indign
@user1312837: LispWorks needs validate-superclass only when the foo-meta-class meta class is NOT a subclass of standard-class. Which makes sense. For SBCL just add the method as mentioned by Philipp.Snuck
@RainerJoswig interestingly, when doing this in SBCL at least, I can obtain the value of the foo slot on the direct slot definition, however the value of foo on the effective slot definition remains nil. The defclass form doesn't seem to properly initialize foo in the effective slots.Winner
Also confirmed this in LispWorks personal 6.1.1. I'll have to trawl AMOP for clues.Winner

© 2022 - 2024 — McMap. All rights reserved.