#:g1: メソッドコンビネーションでD風の契約プログラミング: その2

Posted 2018-12-19 12:47:24 GMT

Lisp メソッドコンビネーション Advent Calendar 2018 19日目 》

メソッドコンビネーションでD風の契約プログラミング: その1の続きですが、前回は、不変条件をメソッドコンビネーションでどう組むかというところまででした。

Dでは、不変条件は、クラス内でinvariantで定義され、

に設置されるらしいです。
総称関数でこれをどう表現するかというところですが、

位になるでしょうか。

定義してみる

とりあえず、こんなdateクラスがあったとして、

(defclass date () 
  ((year :initarg :year :accessor year)
   (month :initarg :month :accessor month)
   (day  :initarg :day :accessor day))
  (:default-initargs :year 1900 :month 1 :day 1))

(make-instance 'date) → #<date 402026FA73>

invariantメソッドが差し込んで使うようなメソッドコンビネーションを定義します。
andと同じような感じですが、基底クラスから順に適用してandの関係になるようにするので、継承順をreverseし、同じクラスに複数のメソッドを付けたいので、修飾子をワイルドカードにしました。

(define-method-combination invariant ()
  ((pri *))
  `(and ,@(loop :for m :in (reverse pri) :collect `(call-method ,m))))

これで、dateのスロットについてinvariantメソッドで不変条件を記述します。

(defmethod invariant year ((date date))
  (etypecase (year date)
    (integer T)))

(defmethod invariant month ((date date)) (etypecase (month date) ((integer 1 12) T)))

(defmethod invariant day ((date date)) (etypecase (day date) ((eql 29) (or (/= 2 (month date)) (leap-year-p (year date)))) ((eql 30) (/= 2 (month date))) ((eql 31) (typep (month date) '(member 1 3 5 7 8 10 12)))))

このinvariantをスロットに取り付けます。

(defmethod c2mop:slot-value-using-class ((date-class standard-class)
                                         (date date)
                                         slot)
  (invariant date)
  (multiple-value-prog1
    (call-next-method)
    (invariant date)))

(defmethod (setf c2mop:slot-value-using-class) (value (date-class standard-class) (date date) slot) (invariant date) (multiple-value-prog1 (call-next-method) (invariant date)))

これだけでいけるかなと思ったのですが、

(make-instance 'date :year 100 :month 2 :day -2)
→ #<date 4020118C13> 

あれ……?

インスタンス生成もチェックする

インスタンス生成はslot-value-using-classはスルーする(かもしれない)ようなので、clange-classのことも考えて、shared-initializeinvariantを設置しました(もうちょっと細かく設定した方が良いかもしれません)

(defmethod shared-initialize :after ((date date) slots &key)
  (invariant date))

これで生成系はエラーにできます。

(make-instance 'date :year 100 :month 2 :day -2)
>>> error

(defclass date2 () ((year :initform 1900 :initarg :year :accessor year) (month :initform 1 :initarg :month :accessor month) (day :initform 1 :initarg :day :accessor day)))

(change-class (make-instance 'date2 :year 100 :month 2 :day -2) 'date) >>> error

invariantメソッドコンビネーションの展開はこんな感じになります

(defclass datetime (date) 
  ((hour :initarg :hour :accessor hour)
   (minute :initarg :minute :accessor minute)
   (second  :initarg :second :accessor sec))
  (:default-initargs :hour 0 :minute 0 :second 0))

(defmethod invariant hour ((dt datetime)) (etypecase (hour dt) ((integer 0 24) T)))

(defmethod invariant minute ((dt datetime)) (etypecase (minute dt) ((integer 0 59) T)))

(defmethod invariant second ((dt datetime)) (etypecase (sec dt) ((integer 0 59) T)))

(mc-expand #'invariant 'invariant nil (make-instance 'datetime))(and (call-method #<standard-method invariant (year) (date) 41602356B3>) (call-method #<standard-method invariant (month) (date) 40D035A8B3>) (call-method #<standard-method invariant (day) (date) 40D035A113>) (call-method #<standard-method invariant (hour) (datetime) 40D04205BB>) (call-method #<standard-method invariant (minute) (datetime) 402025F913>) (call-method #<standard-method invariant (second) (datetime) 402027434B>))

これらinvariantを付加する作業をどうにかまとめたいのですが、MOPを使うかマクロて手続きを纏めるか悩む所です。 invariant手続きをdefclassで指定した方が良さそうなので、MOPになりそうです。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus