CLOS: What I am doing here, setting a slot in the metaclass? - common-lisp

(ql:quickload :postmodern)
(defpackage :test-case
(:use :cl)
(:import :pomo))
(in-package :test-case)
;; (defclass dao-class (standard-class)
;; ((direct-keys :initarg :keys :initform nil :reader direct-keys)
;; (effective-keys :reader dao-keys)
;; (table-name)
;; (column-map :reader dao-column-map))
;; (:documentation "Metaclass for database-access-object classes."))
(defclass definition ()
((id :col-type serial :reader definition-id)
(content :col-type string :initarg :content :accessor definition-content)
(word :col-type string :initarg :word :accessor definition-word))
(:metaclass dao-class)
(:keys id))
(pomo:dao-keys 'definition)
;; => (ID)
;; What I am setting with :keys? a slot in the meta class?
https://gist.github.com/PuercoPop/5850773

dao-class has the slot direct-keys, whose :initarg is named :keys, so, if I understand your question correctly, the answer ist: "Yes, (:keys id) provides the value for the direct-keys slot in the meta-class dao-class."
EDIT To be more precise, here, since the wording is not quite clear... dao-class is a meta-class, i.e., a class, whose instances are classes themselves. In this case, the class definition is an instance of dao-class, which has the slot direct-keys (declared in dao-class), and the value of that slot in definition is initialized from the value supplied via the :keys option.

Related

Macro with a list of macros as argument in Common Lisp

In Common Lisp, how to define a “meta-macro” which takes as argument a list of macros (and other arguments) and composes these macros to produce the desired code.
The problem is equivalent to writing a “higher-order macro” which defines a macro out of a variable list of other macros.
The concrete situation prompting the question is for me an experiment with CLSQL, where I want to re-express the employee class from the CLSQL-testsuite
(clsql:def-view-class employee ()
((employee-id
:db-kind :key
:db-constraints (:not-null)
:type integer)
(first-name
:accessor employee-first-name
:type (string 30)
:initarg :first-name)
(last-name
:accessor employee-last-name
:type (string 30)
:initarg :last-name)
(email
:accessor employee-email
:type (string 100)
:initarg :email)
(company-id
:type integer
:initarg :company-id)
(company
:accessor employee-company
:db-kind :join
:db-info (:join-class company
:home-key companyid
:foreign-key companyid
:set nil))
(manager-id
:type integer
:nulls-ok t
:initarg :manager-id)
(manager
:accessor employee-manager
:db-kind :join
:db-info (:join-class employee
:home-key managerid
:foreign-key emplid
:set nil))))
as
(def-view-class-with-traits employee ()
(trait-mapsto-company trait-mapsto-manager)
((employee-id
:db-kind :key
:db-constraints (:not-null)
:type integer)
(first-name
:accessor employee-first-name
:type (string 30)
:initarg :first-name)
(last-name
:accessor employee-last-name
:type (string 30)
:initarg :last-name)
(email
:accessor employee-email
:type (string 100)
:initarg :email)))
Having this technique at hand would favour consistency and terseness when defining complex database schemas.
I defined the two traits I need as
(defmacro trait-mapsto-company (class super slots &rest cl-options)
(declare (ignore super slots cl-options))
(let ((company-accessor-name
(intern (concatenate 'string (symbol-name class) "-COMPANY"))))
`((company-id
:type integer
:initarg :company-id)
(company
:accessor ,company-accessor-name
:db-kind :join
:db-info (:join-class company
:home-key companyid
:foreign-key companyid
:set nil)))))
(defmacro trait-mapsto-manager (class super slots &rest cl-options)
(declare (ignore super slots cl-options))
(let ((manager-accessor-name
(intern (concatenate 'string (symbol-name class) "-MANAGER"))))
`((manager-id
:type integer
:initarg :manager-id)
(manager
:accessor ,manager-accessor-name
:db-kind :join
:db-info (:join-class manager
:home-key managerid
:foreign-key emplid
:set nil)))))
However my attempt to write the def-view-class-with-traits is foiled.
(defmacro def-view-class-with-traits (class super traits slots &rest cl-options)
(let ((actual-slots
(reduce (lambda (trait ax) (append (apply trait class super slots cl-options) ax))
traits
:initial-value slots)))
`(clsql:def-view-class ,class ,super ,actual-slots ,#cl-options)))
In the lambda used for reducing, the trait stands for a macro, and my use of apply does not make any sense to the Lisp – which is right! – but hopefully convey my intent to other programmers.
How to let def-view-class-with-traits process the list of macros traits in the appropriate way?
I would find it much less surprising if you defined the traits as classes themselves and used normal inheritance:
(def-view-class trait-mapsto-company ()
((company-id
:type integer
:initarg :company-id)
(company
:accessor company
:db-kind :join
:db-info (:join-class company
:home-key company-id
:foreign-key company-id
:set nil))))
(def-view-class trait-mapsto-manager ()
((manager-id
:type integer
:initarg :manager-id)
(manager
:accessor manager
:db-kind :join
:db-info (:join-class manager
:home-key managerid
:foreign-key emplid
:set nil)))
(def-view-class employee (trait-mapsto-company trait-mapsto-manager)
((employee-id
:db-kind :key
:db-constraints (:not-null)
:type integer)
(first-name
:accessor employee-first-name
:type (string 30)
:initarg :first-name)
(last-name
:accessor employee-last-name
:type (string 30)
:initarg :last-name)
(email
:accessor employee-email
:type (string 100)
:initarg :email)))
This certainly does not make the accessor name dependent on the name of the inheriting class, but do you really want that? My view is that this way to write it shows that that would actually break a decoupling principle.
The way to “call” a macro is with macroexpand-1:
(defmacro def-view-class-with-traits (class super traits slots
&rest cl-options
&environment env)
(let ((tslots
(loop for m in traits
append (macroexpand-1 (list* m class super slots options)
env))))
`(def-view-class ,class ,super (,#tslots ,#slots) ,#cl-options)))

Weird error when compiling Common Lisp code

I am getting the following error trying to compile some code:
Lambda list of method # is incompatible with that of the generic function
INITIALIZE-INSTANCE. Method's lambda-list : (PAT::E)
Generic-function's : (CCL::INSTANCE &REST CCL::INITARGS &KEY
&ALLOW-OTHER-KEYS)
Here is the code causing the error:
(defclass event ()
((timestamp
:initarg :timestamp
:accessor timestamp)
(value
:initarg :value
:accessor value)))
(defclass update (event)
((security
:initarg :sectype
:accessor sectype)))
(defclass prc (update)
((lastp
:accessor lastp)
(lastv
:accessor lastv)))
(defmethod initialize-instance :after ((e prc)) ; <- :(
(setf (lastp e) (first (value e)))
(when (second (value e))
(setf (lastv e) (second (value e)))))
Any hints as to what might be causing the error would be really appreciated.
You need to add &key at the end of the argument list to your initialize-instance method.
To quote from "Practical Common Lisp", chapter "17. Object Reorientation: Classes":
The &key in the parameter list is required to keep the method's parameter list congruent with the generic function's--the parameter list specified for the INITIALIZE-INSTANCE generic function includes &key in order to allow individual methods to supply their own keyword parameters but doesn't require any particular ones. Thus, every method must specify &key even if it doesn't specify any &key parameters.

Custom slot options don't apply any reduction to its argument

Say if I define a metaclass that enhances standard slots with a validator slot, when I pass :validator (clavier:valid-email "The email is invalid") as an option, instead of storing the result of of the expression, which is a funcallable, it stores the expression itself. Am I'm missing a step when extending the standard slots? How do I ensure the expression is evaluated before stored? I'm using SBCL 1.2.11 btw. Here is the code in question
(unless (find-package 'clavier)
(ql:quickload :clavier))
(unless (find-package 'c2mop)
(ql:quickload :c2mop))
(defpackage #:clos2web/validation
(:use #:cl)
(:import-from #:c2mop
#:standard-class
#:standard-direct-slot-definition
#:standard-effective-slot-definition
#:validate-superclass
#:direct-slot-definition-class
#:effective-slot-definition-class
#:compute-effective-slot-definition
#:slot-value-using-class))
(in-package #:clos2web/validation)
(defun true (value)
"Always return true."
(declare (ignore value))
t)
(defclass validation-class (standard-class)
()
(:documentation "Meta-class for objects whose slots know how to validate
their values."))
(defmethod validate-superclass
((class validation-class) (super standard-class))
t)
(defmethod validate-superclass
((class standard-class) (super validation-class))
t)
(defclass validation-slot (c2mop:standard-slot-definition)
((validator :initarg :validator :accessor validator :initform #'true
:documentation "The function to determine if the value is
valid. It takes as a parameter the value.")))
(defclass validation-direct-slot (validation-slot
standard-direct-slot-definition)
())
(defclass validation-effective-slot (validation-slot
standard-effective-slot-definition)
())
(defmethod direct-slot-definition-class ((class validation-class) &rest initargs)
(declare (ignore initargs))
(find-class 'validation-direct-slot))
(defmethod effective-slot-definition-class ((class validation-class) &rest initargs)
(declare (ignore initargs))
(find-class 'validation-effective-slot))
(defmethod compute-effective-slot-definition
((class validation-class) slot-name direct-slot-definitions)
(let ((effective-slot-definition (call-next-method)))
(setf (validator effective-slot-definition)
(some #'validator direct-slot-definitions))
effective-slot-definition))
(defmethod (setf slot-value-using-class) :before
(new (class validation-class) object (slot validation-effective-slot))
(when (slot-boundp slot 'validator)
(multiple-value-bind (validp msg)
(funcall (validator slot) new)
(unless validp
(error msg)))))
;; Example usage
(defclass user ()
((name :initarg :name)
(email :initarg :email :validator (clavier:valid-email "The email is invalid") :accessor email))
(:metaclass validation-class))
(let ((pepe (make-instance 'user :name "Pepe" :email "pepe#tumadre.com")))
(setf (email pepe) "FU!")) ;; should throw
The code fails when making an instance as (CLAVIER:VALID-EMAIL "The email is invalid") is not a funcallable.
(CLAVIER:VALID-EMAIL
"The email is invalid") fell through ETYPECASE expression.
Wanted one of (FUNCTION SYMBOL).
[Condition of type SB-KERNEL:CASE-FAILURE]
Like the comment above says, defclass does not evaluate arguments (it is a macro). While the usual advice is to avoid eval, I think that eval in this circumstance might be exactly what you want. While usually you would splice the form directly into some macro body, with defclass I think the answer is to eval the form in slot initialization and store the evaluation (if it has not yet been evaled).
This would probably occur in:
(defmethod initialize-instance :after ((obj validation-slot)
&key &allow-other-keys)
#| ... |#)
Optionally you could also store the :validation-message and :validation-fn as two separate arguments then call:
(multiple-value-bind (validp msg)
(funcall (funcall (validator-fn slot)
(validator-message slot))
new)
(unless validp
(error msg)))
Another alternative would be to store the evaluation of the form and pass that to the macro:
(defvar *email-validator* (CLAVIER:VALID-EMAIL "The email is invalid"))
(defun email-validator (val)
(funcall *email-validator* val))
Then pass email-validator to defclass.
Additionally I might suggest that your validation functions signal slot-validation-error type conditions instead of error type conditions. Then your condition could contain references to the validator that failed, the value, the slot and the instance. This could give you much better control than the raw error. You could also add some restarts (abort to skip setting the slot, use-value to provide a different value).
Depending on your setup, it might also make more sense for your validation function to signal these directly instead of returning multiple values that are then coerced to signals.

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.

How can I convert a keyword to a symbol suitable to access a slot?

I have a class with a number of slots. I also have a builder function to make objects of that class such that passing the following list '(:id "john" :name "John Doe" :age 42) to that function will construct a new object with those slots values. I will use that function to generate more than one object, using a list of lists.
How can I convert from a keyword like :id to a slot name that SLOT-VALUE can use?
Thanks.
If the keywords are the initargs for the class, then you just can call MAKE-INSTANCE via APPLY:
(defclass person ()
((id :initarg :id )
(name :initarg :name)
(age :initarg :age )))
CL-USER > (mapcar
(lambda (initargs)
(apply #'make-instance 'person initargs))
'((:id "john" :name "John Doe" :age 42)
(:id "mary" :name "Mary Doe" :age 42)))
(#<PERSON 402027AB7B> #<PERSON 402027AC33>)
The find-symbol and symbol-name functions will be helpful to you. If defclass and slot-value happen in the same package, you can use those functions as follows:
(defclass person ()
((id :initarg :id)
(name :initarg :name)
(age :initarg :age)))
(slot-value (make-instance 'person :id "john" :name "John Doe" :age 42)
(find-symbol (symbol-name :id)))
If defclass and slot-value happen in two different packages, you need to give find-symbol the name of the package where defclass happens:
(in-package #:common-lisp-user)
(defpackage #:foo
(:use #:common-lisp)
(:export #:person))
(defpackage #:bar
(:use #:common-lisp #:foo))
(in-package #:foo)
(defclass person ()
((id :initarg :id)
(name :initarg :name)
(age :initarg :age)))
(in-package #:bar)
(slot-value (make-instance 'person :id "john" :name "John Doe" :age 42)
(find-symbol (symbol-name :id) 'foo))
(find-symbol name &optional (package (sane-package)))
Function: Return the symbol named STRING in PACKAGE. If such a symbol is found then the second value is :INTERNAL, :EXTERNAL or :INHERITED to indicate how the symbol is accessible. If no symbol is found then both values are NIL.
(symbol-name symbol)
Function: Return SYMBOL's name as a string.
I realize that this is quite old, but I think that the most important point to be made here is:
Don't use slot-value like that!
In order to get an accessor, use the :accessor or :reader slot options, and for passing values to the constructor, use :initarg:
(defclass foo ()
((bar :accessor foo-bar :initarg :bar)))
This means: create a getter method and a setf expander named foo-bar, and use a keyword argument named :bar to make-instance to initialize this slot's value.
Now you can instantiate such an object like this:
(make-instance 'foo :bar "quux")
or, if you get a property list of initargs (as Rainer had already shown):
(let ((initargs (list :bar "quux"))) ; getting this from somewhere
(apply #'make-instance 'foo initargs))
You can then get the value like this:
(foo-bar some-foo)
And set it with setf as usual:
(setf (foo-bar some-foo) "wobble")
If you use :reader instead of :accessor, setting is not allowed. This is often useful to communicate intent of immutability.
Slot-value is really for special situations in the lifetime of an object, such as when playing around with methods for initialize-instance. That is an advanced topic.
My solution to this stupidity of CL was:
(defun locate-symbol
(inst kw)
(let* ((slot-name (symbol-name kw))
(slot-def (find slot-name
(clos:compute-slots (class-of inst))
:test #'(lambda (name sd)
(string= name
(symbol-name (clos:slot-definition-name sd)))))))
(if slot-def
(clos:slot-definition-name slot-def)
(error "Can't find a slot definition named ~s." slot-name))))
(defun gets
(self slot-name)
"Get a value of a slot by its name (keyword)"
(slot-value self (locate-symbol self slot-name)))
(defun sets!
(self slot-name value)
"Set a value of a slot by its name (keyword)"
(setf (slot-value self (locate-symbol self slot-name))
value))
So now you can do:
(defvar obj (make-instance '<some-class>))
(sets! obj :some-slot "some value")
(format t "-> ~a~%" (gets obj :some-slot))

Resources