問題を理解するために、ちょっとMOPを使って書いてみました。実装はGaucheです。
もとのWさんの 
  Aggregate P, A, B
が、
  (define-aggregate P A B)
になります。
コード自体は40行ほどですが、実行例もついているので、まとめて下に貼っておきます。

実行とコンパイルのフェーズがC++ほど分離していないので
クラス再定義を明示的に呼び出したりしてますが、実装の詳細は本筋
ではないと思うので、ユーザから見た使用感についてコメントします。

Aggregate文のメリットは関係性を別に管理できることだと思うの
ですが、シンプルな例だとやはりメリットが見えなさそうです。
今回の例の場合、Bookの定義を読む人は当然Publisherがあることを
期待しますが、それはBookの定義には無くて、Aggregate文の方を
見ないといけませんよね。そういう点、本質的に密な関係に
適用するよりは、後付けの補助的な関係に適用すると良さそうに
思えました。デバッグ情報とか、あるいは既存のBookクラスライブラリ
に対して、自分の書棚情報をかぶせるとか。

そのようなAOP的な使い方をするなら、結構応用範囲はあるように
思えます。m-to-nにした場合の一貫性の確保なども、展開したコードに
含めることができるでしょう。(下の例では、parentが変わった時に
古いparentからchildの情報を除いていますが、似たような要領で
実装できるのではないかと思います---その部分をユーザ拡張可能に
するには、関係性の変更というメソッドをオーバライド可能なように
しておけば良いと思います。)

あと記述面で欲しいなと思ったのは、逆方向ポインタの名前指定とか
(book -> authorへのポインタはauthored-byにしたい、とか)。

ただ、Wさんもおっしゃっているように、本当にこういうのが力を
発揮しそうなのは3つ以上のクラスが絡んでくる時のように思えます。

--shiro



以下、コード：

=====================
;;
;; define-aggregate using MOP
;;
(use srfi-1)

(define-class <aggregatable-meta> (<class>)
  ())

(define-method create-aggregate (name
                                 (container <aggregatable-meta>)
                                 (contained <aggregatable-meta>))
  (let ((new-container (apply make <aggregatable-meta>
                              :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 <aggregatable-meta>
                              :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)))

(define-macro (define-aggregate name container contained)
  (let ((parent-slot (string->symbol #`",|name|-parent"))
        (adder       (string->symbol #`",|name|-add!"))
        (parent      (gensym))
        (child       (gensym))
        )
    `(begin
       (set!-values (,container ,contained)
                    (create-aggregate ',name ,container ,contained))
       (define-method ,adder ((,parent ,container) (,child ,contained))
         (cond ((ref ,child ',parent-slot)
                => (lambda (old-parent)
                     (update! (ref old-parent ',name)
                              (cut delete! ,child <>)))))
         (push! (ref ,parent ',name) ,child)
         (set!  (ref ,child ',parent-slot) ,parent)))
    ))

;;
;; 実行例
;;

;; クラス定義
(define-class <publisher> ()
  ((name    :init-keyword :name)
   (address :init-keyword :address))
  :metaclass <aggregatable-meta>)

(define-class <book> ()
  ((title   :init-keyword :title)
   (pages   :init-keyword :pages))
  :metaclass <aggregatable-meta>)

(define-class <author> ()
  ((name    :init-keyword :name))
  :metaclass <aggregatable-meta>)

;; 関係の定義
(define-aggregate books <publisher> <book>) ;; 出版リスト
(define-aggregate authoring <author> <book>) ;; 著作本リスト
(define-aggregate dedicated-authors <publisher> <author>) ;; 専属契約


;; for convenience
(define-method write-object ((pub <publisher>) out)
  (format out "#<publisher ~s>" (ref pub 'name)))
(define-method write-object ((book <book>) out)
  (format out "#<book ~s>" (ref book 'title)))
(define-method write-object ((author <author>) out)
  (format out "#<author ~s>" (ref author 'name)))


;; オブジェクトの作成
(define p0 (make <publisher>
             :name "Lambda Publishing, Inc."
             :address "1357 Lambda Blvd. Ste. 246, Boston MA 10031"))
(define p1 (make <publisher>
             :name "OOBooks, LLC"
             :address "2345 Object Av., Palo Alto CA 93029"))
(define a0 (make <author> :name "Pur E. Functional"))
(define a1 (make <author> :name "Prag M. Atist"))

(define b0 (make <book>
             :title "The Art of Laziness"
             :pages 128))
(define b1 (make <book>
             :title "Functional Recipes"
             :pages 256))
(define b2 (make <book>
             :title "On Objects"
             :pages 512))

;; 関係性の初期化
(books-add! p0 b0)
(books-add! p0 b1)
(books-add! p1 b2)
(authoring-add! a0 b0)
(authoring-add! a0 b1)
(authoring-add! a1 b2)
(dedicated-authors-add! p0 a0)
(dedicated-authors-add! p1 a1)

#|
;;; 確認
(ref p0 'books)
;; => (#<book "Functional Recipes"> #<book "The Art of Laziness">)
(ref p1 'books)
;; => (#<book "On Objects">)
(ref b0 'books-parent)
;; => #<publisher "Lambda Publishing, Inc.">
(ref a0 'authoring)
;; => (#<book "Functional Recipes"> #<book "The Art of Laziness">)
(ref b2 'authoring-parent)
;; => #<author "Prag M. Atist">
(ref p1 'dedicated-authors)
;; => (#<author "Prag M. Atist">)

;;; 衝撃の移籍！
(dedicated-authors-add! p0 a1)

(ref p0 'dedicated-authors)
;; => (#<author "Prag M. Atist"> #<author "Pur E. Functional">)
(ref p1 'dedicated-authors)
;; => ()
|#

=====================
コード終り。


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