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

Posted 2018-12-17 14:20:30 GMT

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

契約プログラミングをメソッドコンビネーションを表現するネタは既にあるのですが、

もうちょっと簡潔に書けそうな気がしてきたので、試しにD風の契約プログラミングの仕組みを書いてみることにしました。

Dには契約プログラミングが組み込み機能ですが、in節で事前条件のチェック、body節は本体、out節で事後条件をチェックするようになっています。

継承がからんだ場合は、事前条件は、基底クラスから条件をorのでチェック、事後条件は、基底クラスからandでチェック、のようです。

out節で返り値を受け取ってチェックするというのをどう表現するのか厄介ですが、outはチェック関数を返して、プライマリの返り値をチェックすることにしました。

(define-method-combination ddbc ()
  ((in* (:in))
   (out* (:out))
   (pri* () :required T))
  (let ((results (gensym "results-")))
    `(progn
       (or ,@(loop :for in :in (reverse in*) :collect `(call-method ,in))
           (error "in"))
       (let ((,results (multiple-value-list (call-method ,(car pri*) ,(cdr pri*)))))
         (declare (dynamic-extent ,results))
         (or (and ,@(loop :for out :in (reverse out*) :collect `(apply (call-method ,out) ,results)))
             (error "out"))
         (values-list ,results)))))

これでこんな風に書くと、

(defgeneric integer->integer->integer (x y)
  (:method-combination ddbc))

(defmethod integer->integer->integer :in ((x number) (y number)) (and (integerp x) (integerp y) (not (zerop y))))

(defmethod integer->integer->integer ((x number) (y number)) (/ x y))

(defmethod integer->integer->integer :out ((x integer) (y integer)) #'integerp)

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

(mc-expand #'integer->integer->integer 'ddbc nil 1 2)(progn
  (or (call-method
       #<standard-method integer->integer->integer (:in) (number
                                                          number) 414009E67B>)
      (error "in"))
  (let ((#:|results-166692|
         (multiple-value-list (call-method
                               #<standard-method integer->integer->integer nil (number
                                                                                number) 414009E45B>
                               nil))))
    (declare (dynamic-extent #:|results-166692|))
    (or (and (apply (call-method
                     #<standard-method integer->integer->integer (:out) (integer
                                                                         integer) 40202D35A3>)
                    #:|results-166692|))
        (error "out"))
    (values-list #:|results-166692|)))

実行してみます

(defmacro run (form)
  "結果確認用ユーティリティ"
  `(multiple-value-bind (ans error)
                        (ignore-errors ,form)
     `(,',form :result ,ans :error 
               ,(and error
                     (format nil 
                             (simple-condition-format-control error)
                             nil
                             (simple-condition-format-arguments error))))))

(list (run (integer->integer->integer 1 8)) (run (integer->integer->integer 1 0)) (run (integer->integer->integer 10 2)) (run (integer->integer->integer 10 1/2)))(((integer->integer->integer 1 8) :result nil :error "out") ((integer->integer->integer 1 0) :result nil :error "in") ((integer->integer->integer 10 2) :result 5 :error nil) ((integer->integer->integer 10 1/2) :result nil :error "in"))

まあまあ、動いているようです。

不変条件は、クラスのスロット側にメソッドコンビネーションを付けることになりそうですが、間に合ってないので次回にします。


HTML generated by 3bmd in LispWorks 7.0.0

comments powered by Disqus