Gauche のリファレンスに、
たとえば、同じスロット名のスロットオプションはどれかが他のものをシャドウしますが、これをマージすることができるようにメタクラスを書くことができます。
とあるので、書いてみた。が、わからなかった。
Lingr で、compute-slots を定義する。とアドバイスをいただいたので、
(use util.list)
(use srfi-1)
(define-class <append-slot-options-meta> (<class>)
())
(define-method compute-slots ((class <append-slot-options-meta>))
(letrec ((cpl (slot-ref class 'cpl))
(slots '())
(delete-keyword* (lambda (keys kv-list)
(if (null? keys)
kv-list
(delete-keyword* (cdr keys) (delete-keyword (car keys) kv-list)))))
(slot-marge (lambda (old new)
(append new (delete-keyword* (filter keyword? new) (cdr old))))))
(for-each (lambda (c)
(for-each (lambda (slot)
(if (assq (car slot) slots)
(assq-set! slots (car slot) (cdr (slot-marge slot (assq (car slot) slots))))
(set! slots (cons slot slots))))
(slot-ref c 'direct-slots)))
cpl)
(reverse slots)))
(define-class <append-slot-options-mixin> ()
()
:metaclass <append-slot-options-meta>)
としてみたが、
(use gauche.mop.validator)
(define-class <v> (<validator-mixin>)
((a :accessor a-of
:validator (lambda (obj value) (x->string value)))
(b :accessor vb-of)))
(define-class <w> (<v> <append-slot-options-mixin>)
((b :accessor wb-of
:validator (lambda (obj value) (x->string value)))))
(define test (make <v>))
(slot-set! test 'a 'foo)
(slot-ref test 'a)
(slot-set! test 'b 'bar)
(wb-of test) ;; returns ERROR ... OK
(vb-of test) ;; returns 'bar ... OK
(define test (make <w>))
(slot-set! test 'a 'foo)
(slot-ref test 'a)
(slot-set! test 'b 'bar)
(wb-of test) ;; returns "bar" ... OK
(vb-of test) ;; returns "bar" ... ERROR. I hope return ERROR.
(set! (wb-of test) 'hoge)
(set! (vb-of test) 'fuga)
(wb-of test) ;; return "fuga"
(vb-of test) ;; return "fuga"
(class-slots <v>) ;; ((a :accessor a-of :validator #<closure #f>) (b :accessor vb-of)) ...OK
(class-slots <w>) ;; ((b :accessor wb-of :validator #<closure #f>) (a :accessor a-of :validator #<closure #f>)) ...OK
となって、うまくいかなかった。
正直、煮詰まってきているので、だれかヒントください。
意図としてはvalidatorを経由しないパスを残しておきたいということかと思うのですが、....は、
cplで決定されるメソッドの適応先オブジェクトは、cplでマッチしたクラスに対してではなく、cplでマッチすれば、あくまでそのメソッドが引数の束縛されているインスタンスに対して適応されるという事ですよね。(もっと高次元な話なのだとは思うけど)
(define-class <v> ()
((a :accessor a-of)
(b :accessor vb-of)))
(define-class <w> (<append-slot-options-mixin> <validator-mixin> <v>)
((b :accessor wb-of
:validator (lambda (obj value) (x->string value)))))
(d vb-of) ;; methods : (#<method (vb-of <v>)>)
(class-precedence-list <w>) ;; returns (#<class <w>> #<class <append-slot-options-mixin>>
;; #<class <validator-mixin>> #<class <v>> #<class <object>> #<class <top>>)
としたとき、総称関数 vb-of は、cplに従って、<v>のインスタンスであるtestに適応される。これも当然。でもなんか勉強になった気がするので書いておこうっと。