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

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

おわり

*1:本当は call-method の第2引数に循環リストを渡したかったのですが、call-next-methodでスタックオーバーフローしてしまうので泣く泣く回数制限をつけました。

eshamster’s diary

小ネタ: define-method-combinationで遊ぶ

Blackhole: 呼ぶと消える

Escher: 親の親は自分

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

FizzBuzz: 王道ネタ