#:g1: Flavorsのメソッドコンビネーションを眺めたり再現してみよう: :pass-on

Posted 2018-12-12 19:45:24 GMT

Lisp メソッドコンビネーション Advent Calendar 2018 13日目 》

前回に引き続き、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションを眺めたり再現してみたりしようと思います。

メソッドの返り値を順繰りに次のメソッドに送っていく:pass-onの再現がしたくて苦戦していましたが、なんとか形にできました。

Flavorsの:pass-onの挙動を確認してみる

とりあえず、LMI Lambdaのエミュレータで挙動が確認できたのですが、こんな感じでした。

(defflavor a () ()
  (:method-combination (:pass-on (:base-flavor-last) :m)))

(defflavor b () (a))

(defmethod (a :m) (x y) (values (list :a x) (1+ y)))

(defmethod (b :m) (x y) (values (list :b x) y))

(send (make-instance 'b) :m 0 1)(:a (:b 0)) 2

aを継承するbという2つのflavorに、それぞれm:pass-onで定義し、bのインスタンスでmを呼び出すと、b.mの返り値をa.mが受け取るようになります。
:base-flavor-lastなのでbaの順番ですが、:base-flavor-firstにすれば、逆にもできます。

:pass-onが多値で返す意味が分からなかったのですが、良く考えると、メソッドの引数が複数になる場合は、多値かリストにして対応するしかなく、リストだと受取側の引数のインターフェイスを変更しないといけないので、多値で返すしかないですね。なるほど。

Common Lispで再現してみる

MOPのmake-method-lambdacompute-effective-methodあたりでどうにかできないか検討しましたが、call-methodフォームを作成して、また分解して、という感じになってしまうので、call-methodをスルーして、メソッドの関数をmethod-functionで取り出して直接呼ぶことにしました。

(ql:quickload :closer-mop)

;; LispWorks/Allegro CL (define-method-combination :pass-on () ((ms ())) (:arguments &rest args) (let ((vs (gensym "vars-"))) `(let* ((,vs ,args) ,@(loop :for m :in ms :collect `(,vs (multiple-value-list (apply ,(c2mop:method-function m) ,vs))))) (declare (dynamic-extent ,vs)) (values-list ,vs))))

しかし、メソッドの引数情報が欲しいので、define-method-combination:argumentsを指定しているのですが、SBCLだと:argumentsがちゃんと実装されていないようなので&restが使えません。

また、method-functionが返す関数の引数は、argsnext-methodsの筈なので、(funcall method-function vs nil)とするのが正しそうですが、LispWorksとAllegro CLでは、(apply method-function vs)でないと上手く動かない謎。

そんなこんなで、まともに動くものができているとは言い難いですが、こんな感じに書けます。

(defclass a () ())

(defclass b (a) ())

(defgeneric m (o x y) (:method-combination :pass-on))

(defmethod m ((o a) x y) (values o (list :a x) (1+ y)))

(defmethod m ((o b) x y) (values o (list :b x) y))

(m (make-instance 'b) 0 1) → #<b 40205BA353> (:a (:b 0)) 2

メソッドコンビネーションの展開はこんな感じで別段変なことはしていませんが、どの処理系も何かしらおかしい感じです。
まあ、LispWorksとAllegro CLで動くので良しとしましょう。

(mc-expand #'m :pass-on nil (make-instance 'b) 0 1)(let* ((#:|vars-131621| args)
       (#:|vars-131621|
        (multiple-value-list (apply #<Function (method m (b t t)) 4140032074>
                                    #:|vars-131621|)))
       (#:|vars-131621|
        (multiple-value-list (apply #<Function (method m (a t t)) 41400320FC>
                                    #:|vars-131621|))))
  (declare (dynamic-extent #:|vars-131621|))
  (values-list #:|vars-131621|)) 

まとめ

HyperSpecによると、define-method-combination:argumentsでは、&restの他に&wholeも使えたりするみたいですが、メジャーな処理系を試してみたところ、まともに:argumentsの機能を実装しているものは無いように思えます。

SBCLは、ソースを眺める限り&restを処理できていないのですが、今後修正されれば、今回の:pass-onも動くんじゃないかなと思います。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus