EoPL reading (55) 2.2 An Abstraction for Inductive Data Type

scheme EoPL

述語な手続きを確認。
ってその前に以下って何だ、と

       (define Type-name
         (cons '(Variant-name ...)
           '((Variant-name Field-name ...) ...)))

gosh で確認。

$ gosh
gosh> (add-load-path ".")
("." "/usr/share/gauche/site/lib" "/usr/share/gauche/0.8.13/lib")
gosh> (load "define-datatype")
define-datatype.scm version J3 2002-01-02 10:55
#t
gosh> (define-datatype bintree bintree?
  (leaf-node
   (datum number?))
  (interior-node
   (key symbol?)
   (left bintree?)
   (right bintree?)))
interior-node
gosh> bintree
((leaf-node interior-node) (leaf-node datum) (interior-node key left right))
gosh>

なるほど。確かにそうなってますね。で、次の述語ですが定義の先頭部分が以下。

       (define Type-name?
         (if (symbol? 'Type-name)
           (lambda args
             (if (null? args)
               (define-datatype:report-error 'Type-name? "expects 1 argument, not 0.")

Type-name が symbol じゃないケイスってどうなるのか、と言いつつ以下

gosh> (define-datatype "xxx" bintree?
  (leaf-node
   (datum number?))
  (interior-node
   (key symbol?)
   (left bintree?)
   (right bintree?)))
*** ERROR: Compile Error: syntax-error: (#<identifier user#define> "xxx" (#<identifier user#cons> (#0=#<identifier user#quote> (leaf-node interior-node)) (#0# ((leaf-node datum) (interior-node key left right)))))
"(stdin)":11:(define-datatype "xxx" bintree? (lea ...

Stack Trace:
_______________________________________
gosh>

これって上記の

((leaf-node interior-node) (leaf-node datum) (interior-node key left right))

なリストを "xxx" の束縛させようとしてエラーになっているように見えます。scheme って symbol 以外のものにオブジェクトの束縛を、なソレって文法エラーなレベルなのであれば

       (define Type-name?
         (if (symbol? 'Type-name)
           (lambda args
             (if (null? args)

上記のエラーチェックな分岐は不要なのでしょうか。うーん。

とりあえず

ここはスルーでそれ以降のナニを確認。まずここ

             (if (null? args)
               (define-datatype:report-error 'Type-name? "expects 1 argument, not 0.")

定義が

       (define Type-name?
         (if (symbol? 'Type-name)
           (lambda args

ってなっているので args が null ってのは引数が無い場合、と。一応 gosh にて確認。

gosh> (define f (lambda args args))
f
gosh> (f)
()
gosh> (f 1)
(1)
gosh>

ふむふむ。通常 (lambda (args) とかってヤるので最初戸惑いました。あるいは直後に

               (if (null? (cdr args))

というチェキが入ってます。これは引数一つ限定ね、な確認な模様。

gosh> (cdr (f 1))
()
gosh> (cdr (f 1 2 3))
(2 3)
gosh>

一つなら '() ですが、それ以外はそうでない、と。で、引数一つが確認できたら

                 (let ((variant (car args)))
                   (let ((type-info Type-name)) 
                     (if (and (pair? type-info) (list? (car type-info)))
                       (and (pair? variant)
                         (memq (car variant) (car type-info)) #t)

がある意味本体。なるほど、bintree なオブジェクトの car 要素は

  • leaf-node
  • interior-node

しか無いですね。なんつーか凄いな。とりあえずここまでの試験を書いてもう少し読み進めて cases を確認、な方向で。

試験書いてみる

上記のナニで言えば

(test* "predicate procedure needs 1 argument"
       *test-error*
       (bintree?))

引数ナシの述語はダウト。結果が以下 (一部のみ

test predicate procedure needs 1 argument, expects #<error> ==> ok

あるいは

(test* "predicate procedure needs 1 argument"
       *test-error*
       (bintree? 1 2))

同様にパス。

test predicate procedure needs 1 argument, expects #<error> ==> ok

あるいは引数がペアじゃないと駄目。

(test* "predicate procedure needs pair"
       *test-error*
       (bintree? 1))

これは駄目でした。引数一つでもペアになるのか。

$ make
Testing define-datatype ...                                      failed.
discrepancies found.  Errors are:
test predicate procedure needs pair: expects #<error> => got #f
$

あ、違うや。

                     (if (and (pair? type-info) (list? (car type-info)))

な条件がダウトなのか。あ、違う。逆か。ここは bintree? とか使ってしまうと自動でパスしてしまうのか。どうやってここをパスしない試験を書けば良いのかが微妙。
で、最後の

                       (and (pair? variant)
                         (memq (car variant) (car type-info)) #t)

は明日確認します。