如何在Common-Lisp CLOS中

时间:2016-10-04 10:55:26

标签: common-lisp sbcl clos ccl

我需要在运行时创建一个类,可能不需要使用eval。在浏览了The Common Lisp Object System MetaObject Protocol之后,知道了元类协议在Common-Lisp中没有完全标准化,我尝试了以下代码来创建一个类,实例化它,并将实例的插槽值设置为一个数字: / p>

(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

不幸的是,此代码在SBCL上正常工作,但在CCL上没有,但是创建类似乎有效,但实例创建(make-instance *my-class*)会导致以下错误:

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的元类级别来实例化它?

2 个答案:

答案 0 :(得分:3)

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))))

答案 1 :(得分:3)

通常会使用ENSURE-CLASS来创建一个类。 ENSURE-CLASS的目的是DEFCLASS的功能等同物。减去特殊的特定于实现的事情DEFCLASS - 例如,支持开发环境的功能。

您可以使用MAKE-INSTANCE,但例如,它不会在其名称下注册该类。它也不会调用任何其他ENSURE-CLASS-USING-CLASS方法。

由于元类的默认值为standard-class,因此CCL还应计算直接超类的默认值,但不幸的是。

我希望 close-mop 修复这些不兼容性,但我还没有检查过。

在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>)