Lisp メソッドコンビネーション Advent Calendar 2018の4日目の記事です。

枠が空きそうな雰囲気だったので、前日の define-method-combination 解説記事を書いていて思い付いた小ネタを供養しておきます。

Blackhole: 呼ぶと消える

一度呼んだら消えてしまう儚いメソッドを定義できるメソッドコンビネーションです。

( define-method-combination blackhole () (( primary ())) ( :generic-function gen ) `( list ,@ ( mapcar # '( lambda ( method ) ` ( prog1 ( call-method , method ) ( remove-method ,gen , method ))) primary ) ) ) ( defgeneric vanish ( a ) ( :method-combination blackhole )) ( defmethod vanish ( a ) "a is any type" ) ( defmethod vanish (( a number )) "a is number" ) ( defmethod vanish (( a fixnum )) "a is fixnum" ) ( defun call-vanish ( a ) ( handler-case ( vanish a ) ( error ( e ) ( print e ) nil )))

呼んでみます。

CL-USER> ( call-vanish 10.0 ) ( "a is number" "a is any type" ) CL-USER> ( call-vanish 10.0 ) #<NO-APPLICABLE-METHOD-EXISTS #x302000E4A6AD > NIL CL-USER> ( call-vanish 10 ) ( "a is fixnum" ) CL-USER> ( call-vanish 10 ) #<NO-APPLICABLE-METHOD-EXISTS #x302000E11F0D > NIL

defgeneric の引数で別の generic-function を指定できるようにして、 そこに add-method することでメソッドが移動するホワイトホールとか、それをお互いに指定することで呼ぶ度に相手に移動する惑星メソッドとかできるんじゃないかと考え始めた辺りでやめました。

Escher: 親の親は自分

call-next-method で親？メソッドを辿っていくと自分自身に行きつくメソッドを定義できるメソッドコンビネーションです*1。

( define-method-combination escher ( &optional ( num-repeat 100 )) (( primary ())) ( let (( shifted ( append ( rest primary ) ( list ( first primary ))))) `( call-method , ( first primary ) , ( loop :for i :from 0 :below num-repeat :append shifted ) ) )) ( defgeneric fact ( a ) ( :method-combination escher 100 )) ( defmethod fact ( a ) ( format t "in root: ~a~%" a ) ( if ( and ( numberp a ) ( > a 1 )) ( * a ( call-next-method ( 1- a ))) 1 )) ( defmethod fact (( a fixnum )) ( format t "in fixnum: ~d~%" a ) ( if ( > a 1 ) ( * a ( call-next-method ( 1- a ))) 1 ))

呼んでみます。

CL-USER> ( fact 5 ) in fixnum: 5 in root: 4 in fixnum: 3 in root: 2 in fixnum: 1 120

Increment: 呼んだらインクリメント

呼び出す度にインクリメントする関数の定義というと、クロージャの説明で良く利用されますね。

メソッドコンビネーションで同じようなことをやってみます。呼び出す度に defmethod で定義し直す力業です。

( ql:quickload :closer-mop ) ( define-method-combination increment () (( primary ())) ( :generic-function gen ) ( let (( method ( first primary ))) `( let* (( result ( call-method , method )) ( next ( if ( typep result ' fixnum ) ( 1+ result ) 0 ))) ( defmethod , ( closer-mop:generic-function-name gen ) ( &optional ( a next )) a ) result ) )) ( defgeneric inc ( &optional a ) ( :method-combination increment )) ( defmethod inc ( &optional a ) :start )

呼んでみます。

CL-USER> ( dotimes ( i 10 ) ( print ( inc ))) :START 0 1 2 3 4 5 6 7 8 NIL

オプショナル引数を利用することで、任意の値から再開することもできます。

CL-USER> ( inc 100 ) 100 CL-USER> ( inc ) 101

最早コンビネーション感がありません。

FizzBuzz: 王道ネタ

Incrementのマイナーチェンジですが、せっかくなのでFizzBuzzしてみます。

なお、メソッドコンビネーションによるFizzBuzzには下記の先行研究があります。

( ql:quickload :closer-mop ) ( define-method-combination fizz-buzz () (( primary ())) ( :generic-function gen ) ( let (( method ( first primary ))) `( multiple-value-bind ( result real-value ) ( call-method , method ) ( let (( next ( if ( typep real-value ' fixnum ) ( 1+ real-value ) 1 ))) ( defmethod , ( closer-mop:generic-function-name gen ) ( &optional ( a next )) ( if ( typep a ' fixnum ) ( values ( cond (( = ( mod a 15 ) 0 ) "Fizz Buzz" ) (( = ( mod a 5 ) 0 ) "Buzz" ) (( = ( mod a 3 ) 0 ) "Fizz" ) ( t a )) a ) ( values 1 1 ))) result ) ) )) ( defgeneric fz ( &optional a ) ( :method-combination fizz-buzz )) ( defmethod fz ( &optional ( a )) :start )

呼んでみます。内部の defmethod は多値を返すように定義していますが、表からは見えない辺りが気持ち悪くて良い感じです。

CL-USER> ( dotimes ( i 20 ) ( print ( fz ))) :START 1 2 "Fizz" 4 "Buzz" "Fizz" 7 8 "Fizz" "Buzz" 11 "Fizz" 13 14 "Fizz Buzz" 16 17 "Fizz" 19 NIL

こちらも、オプショナル引数を渡すことで任意位置からの再開ができます。

CL-USER> ( fz 3 ) "Fizz" CL-USER> ( fz ) 4

メソッドコンビネーションがなんだか分からなくなってきました。

おわり