Posted 2018-12-09 20:59:45 GMT
《 Lisp メソッドコンビネーション Advent Calendar 2018 10日目 》
組み込みのメソッドコンビネーションの紹介も尽きてきたので、メソッドコンビネーション元祖のFlavorsに標準装備されていたメソッドコンビネーションの再現でもしてみましょう。
Flavorsのcaseメソッドコンビネーションと題しつつオリジナルの挙動が確認できていないのですが、どうもFlavorsとNew Flavorsで挙動が違うようです。
再現したつもりなのは、New Flavorsの方ですが、もしかすると、第二修飾子がメソッドの引数に現れた場合のディスパッチにcase
を使うのかもしれません。
作成してみたものは、メソッドの引数を安直にcase
に展開するもので、第二修飾子がcase
のマッチ対象になります。
(define-method-combination case ()
((case-clauses (case . *)))
(:arguments a)
(loop :for c :in case-clauses
:if (equal '(case otherwise) (method-qualifiers c))
:collect c :into otherwise
:else
:collect `(,(cadr (method-qualifiers c)) (call-method ,c nil)) :into clauses
:finally
(return
`(case ,a
,@clauses
,@(and otherwise
`((otherwise
,(reduce (lambda (m ms)
`(call-method ,m ,(and ms `((make-method ,ms)))))
otherwise
:initial-value nil
:from-end T))))))))
(defgeneric fib (n)
(:method-combination case))(defmethod fib case 0 (n) n)
(defmethod fib case 1 (n) n)
(defmethod fib case otherwise ((n number))
(+ (fib (1- n)) (fib (- n 2))))
(defmethod fib case otherwise ((n integer))
(call-next-method))
(fib 20)
→ 6765
展開を確認してみるとこんな感じです
(mc-expand #'fib
'case
nil
20)
→
(case a
(1 (call-method #<standard-method fib (case 1) (t) 41E00640EB> nil))
(0 (call-method #<standard-method fib (case 0) (t) 41E00641C3> nil))
(otherwise
(call-method
#<standard-method fib (case otherwise) (integer) 41E0061D63>
((make-method
(call-method
#<standard-method fib (case otherwise) (number) 41E0059333>
nil))))))
eql
特定子をメソッドコンビネーションで実装してしまっている感がありますが、汎用化を推し進めると、filtered-functionみたいなことになるのかなと思います。
今後、Flavors、New Flavorsのcase
メソッドコンビネーションの挙動が確認できたら、オリジナルに忠実なものも作成してみようと思います。
■
HTML generated by 3bmd in LispWorks 7.0.0