Chain Of Responsibility

日記などを振り返ると、CLOSの勉強をしていたのが今からちょうど1年前だったようです。忘れまくり。。。
復習しなくてはなりません。なぜなら僕はジェダイだから・・・！（ジェダイの復習
どうせなのでGoFのパターンとメタプログラミングをごちゃ混ぜにして脳の筋トレをしよう、ということで、気が向いた時（主に息抜きしたい時か現実逃避したい時）に気が向いたパターンをCLOSで書いてみようかと思います。
今回はその第一回目としてChain Of Responsibility.
ちなみに@id:uskz さんのわんくまでの発表に若干影響されました。（でもC++分からないので・・・っていう

;; ネーミングはGoFから拝借しています
CL-USER> (defclass Handler ()
           ((successor :initarg :Successor))) ;; :initargはmake-instance時に値を初期化できるようになる
CL-USER> (defclass ConcreteHandler1 (Handler) ()) ;; 継承するだけでスロットは空
CL-USER> (defclass ConcreteHandler2 (Handler) ())
CL-USER> (defclass ConcreteHandler3 (Handler) ())

;; 各メソッドの構造が同じなのでメタる。
;; （自分が対処できないデータは次に押し付ける、というメソッド）
CL-USER> (defmacro define-HandleRequest (type var pred then)
           `(defmethod HandleRequest ((h ,type) ,var)
             (if ,pred
                 ,then
                 (HandleRequest (slot-value h 'successor) ,var))))

;; どのように展開されるかと言うと・・・
CL-USER> (macroexpand-1 '(define-HandleRequest ConcreteHandler1 x
                          (eq x 'one) "one !"))
; -> (DEFMETHOD HANDLEREQUEST ((H CONCRETEHANDLER1) X)
;      (IF (EQ X 'ONE) "one !" (HANDLEREQUEST (SLOT-VALUE H 'SUCCESSOR) X)))
; => T

;; マクロを使ってメソッドを定義する
CL-USER> (define-HandleRequest ConcreteHandler1 x
           (eq x 'one) "one !")
CL-USER> (define-HandleRequest ConcreteHandler2 x
           (eq x 'two) "two !!")
CL-USER> (define-HandleRequest ConcreteHandler3 x
           (eq x 'three) "three !!!")


;; 親(Handler)クラスが持つsuccessorスロットにどんどん入れる
CL-USER> (setq chain
               (make-instance 'ConcreteHandler1
                              :Successor (make-instance 'ConcreteHandler2
                                                        :Successor (make-instance 'ConcreteHandler3))))

;; 実験
CL-USER> (HandleRequest chain 'one)
"one !"
CL-USER> (HandleRequest chain 'two)
"two !!"
CL-USER> (HandleRequest chain 'three)
"three !!!"
CL-USER> (HandleRequest chain 'four) ;; successorが空っぽのため
; Evaluation aborted