コードを見直していたら、わざわざMOPを使う必要はないことに気づきました。
create-aggregateを (<symbol> <class> <class>) に対して定義すれば
いいだけですね。

(define-method create-aggregate (name (container <class>) (contained <class>))
  (let ((new-container (apply make (class-of container)
                              :name   (class-name container)
                              :supers (class-direct-supers container)
                              :slots `((,name :init-value ())
                                        ,@(class-slots container))
                              :defined-modules (ref container 'defined-modules)
                              (ref container 'initargs)))
        (new-contained (apply make (class-of contained)
                              :name   (class-name contained)
                              :supers (class-direct-supers contained)
                              :slots `((,(string->symbol #`",|name|-parent")
                                        :init-value #f)
                                       ,@(class-slots contained))
                              :defined-modules (ref contained 'defined-modules)
                              (ref contained 'initargs)))
        )
    (redefine-class! container new-container)
    (redefine-class! contained new-contained)
    (values new-container new-contained)))

等。

--shiro

--
ML: langsmith quickml.atdot.net
使い方: http://www.atdot.net/~ko1/quickml