#:g1: メソッドコンビネーションでFizzBuzz (2)

Posted 2008-11-11 14:19:00 GMT

前回、メソッド修飾子を数値で表現して、それでFizzBuzzできるんじゃないかと考えてみましたが、CLtL2のdefine-method-combinationの説明用のコードが元ネタになります。
内容としては、まず、メソッド修飾子をmethod-qualifiersで集めて、修飾子が数値なので順番にソートしたものが優先順位として並べられるというものみたいです。
修飾子は、

(method-qualifiers (find-method #'fizzbuzz '(1) (list (find-class 'one))))
みたいにして取得できます。
それで、前回と比べてあまりかわりばえしないのですが、
(defclass one () ())
(defmethod fizzbuzz 1 ((obj one))
  (format t "~A~%" 1))

(defclass two (one) ()) (defmethod fizzbuzz 2 ((obj two)) (format t "~A~%" 2))

みたいな定義を作って行くことになります。
しかし、クラスと修飾子の意味が被ってるので、ぱっとしないのがくやしい。
ちなみに、修飾子で順番を決めているので、:most-specific-firstであろうが、:most-specific-lastを指定しようが、1から順番に実行されます。
;;;
;;; 動作
;;;

;; 総称関数定義 (defgeneric fizzbuzz (cls) (:method-combination fizzbuzz))

(loop :for i :from 1 :to 100 :do (make-fizzbuzz#2 i))

;; 実行 (fizzbuzz (make-instance '|ONE HUNDRED|))

... 82 83 Fizz Buzz 86 Fizz 88 89 Fizz Buzz 91 92 Fizz 94 Buzz Fizz 97 98 Fizz Buzz

;; メソッドコンビネーションの定義 CLtL2参照(というかそのまま)
(define-method-combination fizzbuzz () 
        ((methods positive-integer-qualifier-p)) 
  `(progn ,@(mapcar #'(lambda (method) 
                        `(call-method ,method ())) 
                    (stable-sort methods #'< 
                      :key #'(lambda (method) 
                               (first (method-qualifiers 
                                        method))))))) 

(defun positive-integer-qualifier-p (method-qualifiers) (and (= (length method-qualifiers) 1) (typep (first method-qualifiers) '(integer 0 *))))

;; 型で振り分けるので型を定義 (deftype fizz () (let ((g (gensym))) (setf (symbol-function g) (lambda (x) (zerop (rem x 3)))) `(satisfies ,g)))

(deftype buzz () (let ((g (gensym))) (setf (symbol-function g) (lambda (x) (zerop (rem x 5)))) `(satisfies ,g)))

(deftype fizzbuzz () '(and fizz buzz))

;; 99 -> NINETY-NINE みたいなものを作成する (defun make-roman-number-symbol (n) (values (intern (format nil "~:@(~R~)" n))))

(defmacro make-fizzbuzz#2 (n) `(eval `(progn (defclass ,#1=(make-roman-number-symbol ,n) ,(if (zerop (1- ,n)) () `(,(make-roman-number-symbol (1- ,n)))) () ) (defmethod fizzbuzz ,(eval ,n) ((cls ,#1#)) (format T ,@(typecase ,n (fizzbuzz (list "Fizz Buzz~%")) (buzz (list "Buzz~%")) (fizz (list "Fizz~%")) (otherwise (list "~A~%" ,n))))))))


comments powered by Disqus