[metacopy-devel] Re: another place where contextl is very handy

[Attila Lendvai]

>
>
> only 3 mails, but in summary: there's a generic copy-thing protocol which
> is a one-fits-all copy protocol. but one could easily build some macrology
> on top of it for customized copy protocols that are the
> extension/customizations of the generic copy-thing protocol and/or other
> copy protocols.
>
>
> Hm, of course I like it when people find uses for ContextL. However,
> wouldn't a separation into different copy functions be sufficient here? (So,
> having separate functions like deep-copy, shallow-copy, structure-copy, and
> so on?)
>
> Note: I don't enough about metacopy, so it's very likely that I am missing
> something here.
>


after some fighting with packages and asdf stuff here's what i came up with:

(progn
  (define-copy-protocol adder-copy)
  (define-copy-protocol subber-copy)
  (define-copy-protocol list-element-duplicating-copy)
  (define-copy-protocol adder-and-list-element-duplicating-copy (adder-copy
list-element-duplicating-copy))

  (define-copy-method (copy-one adder-copy) ((n number) ht)
    (1+ n))

  (define-copy-method (copy-one subber-copy) ((n number) ht)
    (1- n))

  (define-copy-method (copy-one list-element-duplicating-copy) ((list cons)
ht)
    (mapcan (lambda (el)
              (list (copy-thing el) (copy-thing el)))
            list))

  (deftestsuite contextual (metacopy-test)
    ()
    (:test ((ensure-same (adder-copy '(1 2)) '(2 3) :test #'equal)))
    (:test ((ensure-same (subber-copy '(2 3)) '(1 2) :test #'equal)))
    (:test ((ensure-same (list-element-duplicating-copy '(2 3)) '(2 2 3 3)
:test #'equal)))
    (:test ((ensure-same (adder-and-list-element-duplicating-copy '(2 3))
'(3 3 4 4) :test #'equal)))))

unfortunately the packaging took about 10 times the effort to do then the
copy-protocol code. the trick is to load the metacopy code twice into two
different packages, one is called metacopy-with-contextl. this way
defgeneric and define-layered-function can live happily next to each other
and everyone can chose between the contextl based, and therefore more
heavyweight, stuff or the old defmethod way.

i had to patch slime, asdf, and asdf-system-connections to make it work...
one problem is left though: the way i'm using asdf is either illegal or
there's some bug in asdf, because contextl and some other packages are
reloaded even though they are not changed since i've last generated my sbcl
core. it does not cause any problems, but...

Making ContextL optional is not straightforward because ContextL requires
> generic functions to be of the right metaclass, i.e., layered-function. In
> principle, CLOS specifices that you can change the metaclass of a generic
> function via change-class, but I am aware of only one CL implementation that
> actually implements this (that would be clisp), and I have doubts that this
> is a good idea in the first place.
>
> One idea would be to have a common entry point, roughly like this:
>
> (defun copy (&rest args)
>   (declare (dynamic-extent args))
>   #+layered-copy (apply #'layered-copy args)
>   #-layered-copy (apply #'generic-copy args))
>

this is the integration part:

(in-package #.(metacopy-system:metacopy-package))

#+with-contextl
(progn

  (defparameter *copy-protocols* nil "Holds a list of copy protocol names")

  (defun calculate-layer-name-from-protocol-name (name)
    (intern (concatenate 'string "%CPL-" (string name))))

  (defmacro define-copy-protocol (name &optional super-protocols &rest
options)
    "Define a copy protocol, which directly maps to a ContextL layer."
    `(progn
      (pushnew ',name *copy-protocols*)
      (deflayer ,(calculate-layer-name-from-protocol-name name)
          ,(mapcar #'calculate-layer-name-from-protocol-name
super-protocols)
        , at options)
      (defun ,name (thing)
        (with-copy-protocol ,name
          (copy-thing thing)))))

  (defmacro define-copy-function (name args &rest options)
    "A defgeneric, with or without contextl."
    `(define-layered-function ,name ,args
      , at options))

  (defmacro define-copy-method (name &rest body)
    "A defmethod, with or without contextl."
    (let ((protocol)
          (qualifiers)
          (args))
      (when (consp name)
        (assert (= (length name) 2))
        (setf protocol (calculate-layer-name-from-protocol-name (second
name)))
        (setf name (first name)))
      (loop for el :in body
            until (consp el) do
            (push (pop body) qualifiers))
      (setf args (pop body))
      `(define-layered-method ,name ,@(when protocol `(:in-layer ,protocol))
, at qualifiers ,args , at body)))

  (defmacro with-copy-protocol (name &body body)
    (setf name (calculate-layer-name-from-protocol-name name))
    `(with-active-layers (,name)
      , at body)))

#-with-contextl
(progn

  (defmacro define-copy-function (name args &rest options)
    "A defgeneric, with or without contextl."
    `(defgeneric ,name ,args
      , at options))

  (defmacro define-copy-method (name args &rest options)
    "A defmethod, with or without contextl."
    (assert (not (consp name)) (name) "You can only define layered
copy-methods with the metacopy-with-contextl package")
    `(defmethod ,name ,args
      , at options)))

Gary, i hope you'll like it and help tailor out the asdf glitches (i forward
some methods from one system to another after rebinding a variable without
too deep asdf internals knowledge). i'll play a bit more with this and send
you the patches, but it'll take some time until all the patches get into the
repos. if you want to play with this before that just drop me a mail and
i'll attach them all.

-- 
- attila

"- The truth is that I've been too considerate, and so became
unintentionally cruel...
- I understand.
- No, you don't understand! We don't speak the same language!"
(Ingmar Bergman - Smultronstället)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/metacopy-devel/attachments/20061016/a9d8a79e/attachment.html>