Slots in layers, was Re: [closer-devel] ContextL design question...

[Drew Crampsie]

Pascal Costanza wrote:

>
> I haven't extended the with-active-layers construct, though. Here are  
> the reasons:
> - It would really only look neat when used with initargs instead of  
> accessors. However, the mapping of initargs to actual slots can be  
> changed at runtime in CLOS, so I would have to emit code with quite  
> some overhead here that would determine the current mapping of an  
> initarg to its actual slot. Worse, an initarg could actually be  
> mapped to more than one slot, which would complicate the code even  
> further, with very little reward. I wanted to avoid that.

Sounds like my WITH-SPECIAL-INITARGS construct, which has all the 
drawbacks you mentioned, but simplifies the implementation of 
Lisp-on-Lines significantly.

it's used like this like this :

(with-special-initargs (object :some-initarg value :some-other-initarg 
another-value)
  ...)

Below is the implementation. Use it however you want :)


(defmethod initargs.slot-names (object)
  "Returns ALIST of (initargs) . slot-name."
  (nreverse (mapcar #'(lambda (slot)
          (cons (closer-mop:slot-definition-initargs slot)
            (closer-mop:slot-definition-name slot)))
      (closer-mop:class-slots (class-of object)))))

(defun find-slot-names-from-initargs-plist (object initargs-plist)
  "returns (VALUES SLOT-NAMES VALUES), Given a plist of initargs such as 
one would pass to :DEFAULT-INITARGS.
SLOT-NAMES contains the slot-names specified by the initarg, and VALUES 
the corresponding VALUE."
  (let (slot-names values
    (initargs.slot-names-alist (initargs.slot-names object)))
    (loop for (initarg value) on initargs-plist
      do (let ((slot-name
            (cdr (assoc-if #'(lambda (x) (member initarg x))
                   initargs.slot-names-alist))))
           (when slot-name ;ignore invalid initargs. (good idea/bad idea?)
         (push slot-name slot-names)
         (push value values)))
      finally (return (values slot-names values)))))

(defun funcall-with-special-initargs (object initargs function &rest args)
  "Call FUNCTION with dynnamic bindings of the slots in OBJECT specified 
by the INITARGS plist"
  (multiple-value-bind (slot-names values)
    (find-slot-names-from-initargs-plist object initargs)
      (special-symbol-progv
      (with-symbol-access
        (loop for slot-name in slot-names
          collect (slot-value object slot-name)))
      values
    (apply function args))))

(defmacro with-special-initargs ((object &rest initargs) &body body)
  `(funcall-with-special-initargs ,object ,initargs
    #'(lambda ()
    , at body)))