Re: [Sbcl-devel] Needed symbols from sb-pcl for sb-mop

[Kevin R. <ke...@ro...>]

Christophe Rhodes wrote:
> > sb-pcl::standard-direct-slot-definition
> > sb-pcl::standard-effective-slot-definition
> 
> These two, now that I've been pointed to Table 5.1 of AMOP, will
> probably become exported from the SB-MOP package before 0.8.0 is
> [...]

Great. That'll be nice.

> > sb-pcl::compute-effective-slot-definition-initargs
> 
> This one I don't know anything about... it doesn't seem to be
> mentioned in AMOP.  It doesn't have a docstring inside PCL, either
> (not that that's saying much...)  What does it do?  Do other
> instances
> of MOPs export it?

This function generates the initarg list for creating an instance of
an ESD given a list of DSDs. I use this when creating a subclassed
ESD and want to modify the values of the direct slots before storing
them in the effective slots. The code where I use this function
follows this message.

Lispworks, AllegroCL, CMUCL/SCL all have this function, but none of
them export it. The interface is the same for all of these
implementations except for Lispworks which takes an additional
argument compared to the other implementations.  Perhaps it is too
low-level and implementation dependent to export.

Thanks for the great MOP changes in 0.pre8

Kevin


(defmethod compute-effective-slot-definition :around ((cl
                                                       hyperobject-class)
                                                     #+(or allegro
                                                            lispworks)
                                                      name
                                                      dsds)
  #+allergo (declare (ignore name))
  (let* ((dsd (car dsds))
         (value-type (canonicalize-value-type (slot-value dsd
                                                          'value-type))))
    (multiple-value-bind (sql-type length) (value-type-to-sql-type
                                            value-type)
      (setf (slot-value dsd 'sql-type) sql-type)
      (setf (slot-value dsd 'type) (value-type-to-lisp-type
                                    value-type))
      (let ((ia (compute-effective-slot-definition-initargs
                 cl #+lispworks name dsds)))
        (apply
         #'make-instance 'hyperobject-esd
         :value-type value-type
         :sql-type sql-type
         :length length
         :print-formatter (slot-value dsd 'print-formatter)
         :subobject (slot-value dsd 'subobject)
         :hyperlink (slot-value dsd 'hyperlink)
         :hyperlink-parameters (slot-value dsd 'hyperlink-parameters)
         :description (slot-value dsd 'description)
         :user-name (slot-value dsd 'user-name)
         :index (slot-value dsd 'index)
         :value-constraint (slot-value dsd 'value-constraint)
         :null-allowed (slot-value dsd 'null-allowed)
         ia)))))