Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-11-01

CLとデザインパターン - Interpreter

| 14:25 | CLとデザインパターン - Interpreter - わだばLisperになる を含むブックマーク はてなブックマーク - CLとデザインパターン - Interpreter - わだばLisperになる

次に学ぶ対象とするパターンを物色しているのですが、ざっと眺めてみても、まず概念がぱっと理解できないことが多く、随分逡巡しています。

そんなこんななのですが、昨日公開された(no title)を読んで何となくInterpreterパターンのコンセプトは理解できた気がしたので、早速CLで実習してみました。

とはいえ、Obj-Cの読み方が全然分からないので、何となくの雰囲気で写経しています。

とりあえず、一つの動作に一つのクラスを対応させてみるということが骨子なんでしょうか。

これまで、自分が眺めてみた3パターンは、どれも動作の切り替えにクラスを利用するもので、この系統しか理解できてない気もしますが、クラスってこういう風にも使って良いんだということを学べたのは収穫じゃないかと思っています。

でも、Interpreterパターンは、あんまり使わなそうですね…。

(defpackage :design-patterns 
  (:use :cl))

;; boole
(defclass boolean-exp () ())

(defgeneric evaluate (type context))
(defmethod evaluate ((type boolean-exp) context)
  :nop)

;; and
(defclass and-exp (boolean-exp)
  ((operand1 :initarg :operand1 :reader operand1)
   (operand2 :initarg :operand2 :reader operand2)))

(defun make-and-exp (op1 op2)
  (make-instance 'and-exp :operand1 op1 :operand2 op2))

;; or
(defclass or-exp (boolean-exp)
  ((operand1 :initarg :operand1 :reader operand1)
   (operand2 :initarg :operand2 :reader operand2)))

(defun make-or-exp (op1 op2)
  (make-instance 'or-exp :operand1 op1 :operand2 op2))

;; not
(defclass not-exp (boolean-exp)
  ((operand :initarg :operand :reader operand)))

(defun make-not-exp (op)
  (make-instance 'not-exp :operand op))

;; 定数
(defclass constant (boolean-exp)
  ((value :initarg :value :reader value)))

(defun make-constant (value)
  (make-instance 'constant :value value))

;; 変数
(defclass variable-exp (boolean-exp)
  ((name :initarg :name :reader name)))

(defun make-variable-exp (name)
  (make-instance 'variable-exp :name name))

;; 評価器
(defmethod evaluate ((type and-exp) context)
  (and (evaluate (operand1 type) context)
       (evaluate (operand2 type) context)))

(defmethod evaluate ((type or-exp) context)
  (or (evaluate (operand1 type) context)
      (evaluate (operand2 type) context)))

(defmethod evaluate ((type not-exp) context)
  (not (evaluate (operand type) context)))

(defmethod evaluate ((type constant) context)
  (value type))

(defmethod evaluate ((type variable-exp) context)
  (lookup/name context (name type)))

;; コンテクスト
(defclass context () 
  ((namedict :accessor namedict
             :initform (make-hash-table))))

(defgeneric lookup/name (context name))
(defmethod lookup/name ((c context) name)
  (gethash name (namedict c)))

(defgeneric assign-value (context name value))
(defmethod assign-value ((c context) name value)
  (setf (gethash name (namedict c)) value))

;;;
;;; 動作
;;;

;;; (YES and x) or (y and (not x)) の評価
(let* (
       ;; 変数'x'と'y'を作成する
       (x (make-variable-exp 'x))
       (y (make-variable-exp 'y))
       
       ;; 定数'YES'を作成する。
       (yes (make-constant 'T))   
       
       ;; 'not x'を表す式を作成する。
       (not-exp (make-not-exp x))
       
       ;; 'YES and x'を表す式を作成する。
       (and-exp1 (make-and-exp yes x))    
       
       ;; 'y and not(x)'を表す式を作成する。
       (and-exp2 (make-and-exp y not-exp))
       
       ;; '(YES and x) or (y and not(x))'を表す式を作成する。
       (exp (make-or-exp and-exp1 and-exp2))
       (context (make-instance 'context))
       )
  ;; 変数'x'にYESを、変数'y'にNOを設定する。
  (assign-value context 'x 'T)
  (assign-value context 'y nil)

  ;; 評価
  (evaluate exp context) )
;=> T

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20081101