How to portablely create a class at run time in Common-Lisp CLOS

I need to create a class at runtime, possibly without resorting to eval. Knowing that the metaclass protocol is not fully standardized in Common-Lisp, after looking at the General Lisp MetaObject Object System Protocol , I tried the following code to create a class, instantiate it, and set the value of the instance slot to a number:

(defparameter *my-class*
  (make-instance 'standard-class
                 :name 'my-class
                 :direct-slots '((:name x :readers (get-x) :writers ((setf get-x))))))

(defparameter *my-instance* (make-instance *my-class*))

(setf (get-x *my-instance*) 42) ;; => 42

Unfortunately, this code works correctly on SBCL, but not on CCL where the class is created, but instantiating (make-instance *my-class*)causes the following error:

There is no applicable method for the generic function:
  #<STANDARD-GENERIC-FUNCTION INITIALIZE-INSTANCE #x30200002481F>
when called with arguments:
  (#<error printing CONS #x302001A9F6A3>
   [Condition of type CCL:NO-APPLICABLE-METHOD-EXISTS]

closer-mop , , - , .

, : , CLOS?

+4
2

, CCL , .

(defparameter *my-class*
  (make-instance 'standard-class
                 :name 'my-class
                 :direct-slots '((:name x :readers (get-x) :writers ((setf get-x))))
                 :direct-superclasses (list (find-class 'standard-object))))
+3

ENSURE-CLASS. ENSURE-CLASS - DEFCLASS. , DEFCLASS, , .

MAKE-INSTANCE, , , . ENSURE-CLASS-USING-CLASS.

standard-class, CCL , , , .

, , .

CCL:

? (ensure-class 'my-class
                :direct-slots '((:name x
                                 :readers (get-x)
                                 :writers ((setf get-x))))
                :direct-superclasses (list (find-class 'standard-object)))
#<STANDARD-CLASS MY-CLASS>
? (find-class 'my-class)
#<STANDARD-CLASS MY-CLASS>
? (let ((foo (make-instance 'my-class)))
    (setf (get-x foo) 10)
    (incf (get-x foo) 32)
    (get-x foo))
42

LispWorks . standard-class, - standard-object.

CL-USER 25 > (clos:ensure-class 'foobar
                 :direct-slots '((:name x
                                  :readers (get-x)
                                  :writers ((setf get-x)))))
#<STANDARD-CLASS FOOBAR 4020001713>

CL-USER 26 > (class-direct-superclasses *)
(#<STANDARD-CLASS STANDARD-OBJECT 40E018E313>)
+3

Source: https://habr.com/ru/post/1656687/


All Articles