[cells-devel] make-instance, initarg, c-in

[Ramarren]

Hello,

Not that I think this is a really good idea, but you can do it using
the infamous MOP, using http://www.cliki.net/closer-mop as a
compatibility layer:

(defmodel auto-cin-model ()
  ())

(defun class-initargs (class)
  (let ((slots (closer-mop:class-slots class)))
    (let ((class-initargs
           (mapcar #'closer-mop:slot-definition-initargs slots)))
      (remove-if #'(lambda (x)
                     (= (length x) 1))
                 (mapcar #'list* slots class-initargs)))))

(defmethod shared-initialize :after ((instance auto-cin-model)
slot-names &rest initargs)
  (declare (ignore slot-names))
  (let ((class-initargs (class-initargs (class-of instance)))
        (leftmost-initargs (make-hash-table)))
    (loop for (init-arg init-value) on initargs by #'cddr
          for init-slot = (car (rassoc init-arg class-initargs :test #'member))
          for slot-name = (closer-mop:slot-definition-name init-slot)
          do (when (and (not (gethash init-slot leftmost-initargs))
                        (cells::md-slot-cell-type (class-name
(class-of instance)) slot-name)
                        (not (typep init-value 'cell)))
               (setf (slot-value instance slot-name) (c-in init-value)))
             (setf (gethash init-slot leftmost-initargs) t))))

Now all models inheriting from auto-cin-model will have this
behaviour. This is only marginally tested, so probably contains bugs.
For one thing, it overrides cells-created shared-initialize, but that
is only for checking for error which is impossible in this situation
anyway.

Regards,
Jakub Higersberger

On Tue, Jun 30, 2009 at 11:32 PM, Bastian Müller<turbo24prg at web.de> wrote:
> Hi,
>
> I'm currently using cells and it works very well,
> except one thing seems a little unhandy:
>
> When defining a model it's possible to use (c-in ..)
> as an initform to define a slot as a cell, but when
> instantiating a class you have to supply (c-in ...)
> instead the normal value, eg.
>
> (defmodel x ()
>  ((y :accessor y
>      :initarg :y
>      :initform (c-in nil))
>   ...))
>
> (let ((test (make-instance 'x :y (c-in 1))))
>  (setf (y test) 2))
>
> works, but instead sth like
>
> (let ((test (make-instance 'x :y 1)))
>  (setf (y test) 2))
>
> would be nice.
>
> I tried it with
>
> (defmethod initialize-instance ((self x) &rest rest)
>  (loop for slot in rest by #'cddr
>     do (let ((value (getf rest slot))
>              (name (intern (symbol-name slot))))
>          (setf (slot-value self name)
>                (c-in value)))))
>
> but I just get:
>
> The slot CELLS::.CELLS is unbound in the object #<X {10032D5FC1}>.
>   [Condition of type UNBOUND-SLOT]
>
> Is there any way to get this behavior?
>
> kind regards,
>  Bastian
>
> _______________________________________________
> cells-devel site list
> cells-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/cells-devel
>