#:g1: New Flavorsのwrapperとwhopperを再現してみよう

Posted 2018-12-15 11:24:57 GMT

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

前回、メソッドコンビネーション元祖のFlavorsのdefwrapperの定義と:aroundの比較をしてみましたが、今回は、New Flavorsで登場したwhopperも加えてCommon Lispで再現してみようと思います。

FlavorsとNew Flavorsの違いですが、New FlavorsはSymbolicsがFlavorsを改良したもので、sendでのメッセージパッシング構文から、総称関数ベースに変更になった所が目立った違いです。
といっても、send構文もオブジェクトをfuncallしていたので、ちょっとした発想の転換程度の変化にみえます。
なお、New Flavorsは総称関数、多重継承ですが、マルチメソッドではありません。

Flavorsは、MITで開発され、MACLISP系のLisp(Lisp Machine Lisp、MACLISP、Franz Lisp、Zetalisp、Common Lisp)に実装されましたが、方言を跨ぐオブジェクトシステムというもの良く考えると面白いです。

wrapper/whopperの違い

さて、とりあえず、wrapper、whopperの解説ですが、wrapperはこれまでの記事で解説したように、メソッドの周囲を包むマクロ群です。
whopperは、New Flavorsから登場したようですが、Symbolics Common Lisp(1986)のマニュアルを眺めるとCommon Lispの:aroundと挙動は全く同じようです。バーガーキングのワッパーと何か関係があるのでしょうか。
それはさておき、マニュアルでは、マクロのwhopperは再コンパイルが必要だったりして扱いが若干面倒なので極力関数のwhopperを使おうとあります。

wrapperもwhopperも同一の機能ですが、混ぜて使った場合の説明もあり、その場合はwrapperが最外周を取るようです。
wrapperは、マクロなのでほんのちょっと速くできるとありますが、whopperにもインライン展開の構文もあったりするので本当にそうだったのかは謎です。

wrapper/whopperを再現してみる

defwhopper

Common Lispはマルチメソッドなので、シングルメソッドのFlavorsとは若干引数のインターフェイスを変える必要がありますが、大体こんな感じにしました。

(defmacro defwhopper (name (&rest args) &body body)
  `(defmethod ,name :whopper (,@args)
     (flet ((continue-whopper (&rest args)
              (apply #'call-next-method args))
            (lexper-continue-whopper (&rest args)
              (apply #'apply #'call-next-method args)))
       ,@body)))

defwrapper

wrapperの方は、ボディにマクロ展開を記述するのですが、展開関数をメソッドとは別に管理すると面倒なので、式を展開するメソッドを:wrapperメソッドとして記録することにしてみました。

メソッドコンビネーションの展開時に、:wrapper修飾子のメソッドを集めて、残りのフォームを引数に展開していく方針です。

(defmacro defwrapper (name (margs &body mbody) &body body)
  (let ((form (gensym "form-")))
    `(defmethod ,name :wrapper (,@margs)
       (lambda (,form env)
         (declare (ignore env))
         (destructuring-bind ,mbody ,form
           ,@body)))))

メソッドコンビネーション定義

wrapperは最外周なのとマクロ展開させるので若干特殊な動きをしますが、standardメソッドコンビネーションの:around:whopperに置き換えたものをwrapperで包んでいく感じで大丈夫でしょう。

;;; Symbolics風のユーティリティ
(defmacro multiple-value-prog2 (form1 form2 &body body)
  `(progn
     ,form1
     (multiple-value-prog1 ,form2 ,@body)))

(define-method-combination :wrapper () ((whopper (:whopper)) (before (:before)) (primary () :required t) (after (:after)) (wrapper (:wrapper))) (flet ((call-methods (methods) (mapcar #'(lambda (method) `(call-method ,method)) methods))) (let* ((form (if (or before after (rest primary)) `(multiple-value-prog2 (progn ,@(call-methods before)) (call-method ,(first primary) ,(rest primary)) ,@(call-methods (reverse after))) `(call-method ,(first primary)))) (whopper (if whopper `(call-method ,(first whopper) (,@(rest whopper) (make-method ,form))) form))) (if wrapper (reduce (lambda (w ans) (let ((expander (funcall (method-function w) nil nil))) (funcall expander (list ans) nil))) wrapper :initial-value whopper :from-end T) whopper))))

使ってみる

まずは、プライマリを定義してみます

(defgeneric foo (x)
  (:method-combination :wrapper))

(defmethod foo (x) x)

(foo "42") → "42"

次にwrapperを定義。
stringはプライマリがありませんが、wrapperは動きます。

(defwrapper foo ((x) &body body)
  `(multiple-value-prog2 
     (format T "~A~%" '(foo t :wrapper :in))
     ,@body
     (format T "~A~%" '(foo t :wrapper :out))))

(defwrapper foo (((x string)) &body body) `(multiple-value-prog2 (format T "~A~%" '(foo string :wrapper :in)) ,@body (format T "~A~%" '(foo string :wrapper :out))))

(foo "42")(foo string wrapper in)(foo t wrapper in)(foo t wrapper out)(foo string wrapper out) → "42"

次にstringのプライマリを定義して実行してみます

(defmethod foo ((x string))
  (values (read-from-string x)))

(foo "42")(foo string wrapper in)(foo t wrapper in)(foo t wrapper out)(foo string wrapper out) → 42

次に、whopperを定義してみます。

(defwhopper foo ((x string))
  (let ((*read-base* 5.))
    (continue-whopper x)))

(foo "42")(foo string wrapper in)(foo t wrapper in)(foo t wrapper out)(foo string wrapper out) → 22

メソッドコンビネーションの展開はこんな感じです。
wrapperはcall-methodの連鎖にならずにベタ書きになっているのがわかります。

(mc-expand #'foo
           :wrapper
           nil
           "42")(multiple-value-prog2
  (format t "~A~%" '(foo string :wrapper :in))
  (multiple-value-prog2
    (format t "~A~%" '(foo t :wrapper :in))
    (call-method
     #<standard-method foo (:whopper) (string) 40E01F98B3>
     ((make-method
       (multiple-value-prog2 (progn)
         (call-method
          #<standard-method foo nil (string) 40E01C1253>
          (#<standard-method foo nil (t) 40E00E75EB>))))))
    (format t "~A~%" '(foo t :wrapper :out)))
  (format t "~A~%" '(foo string :wrapper :out)))

まとめ

New Flavorsのwrapper/whopperを再現してみましたが、マクロだったwrapperが使い易く関数のwhopperとしてまとめられ、そこからCommon Lispの:aroundへ統合されたらしいことがわかります。

define-method-combinationのインターフェイスは、New Flavors時代に固まったようですが、どうもwrapperの仕組みが念頭にあった設計に思えてしまいます。
MOP前提なら、もうちょっと違ったインターフェイスにできる気がするのですが、残念ながらANSI Common Lispでは、MOPが規格外になってしまったので、MOP前提ではないdefine-method-combinationのインターフェイスも生き残ったという所なのかもしれません。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus