構造体

データを自然にグループ化したものを構造体と呼びます。 Scheme の合成データ型としてたとえば、ベクタ、リストをつかって 構造体を表現できます。たとえば、(生物学的な)樹木に関連した グループ化したデータを扱うとしましょう。このデータの個別の要素、 あるいはフィールドは、高さ胴まわり樹齢葉形葉色など、全部で 5 つのフィールドをつくるとしましょう。 このなデータは、5 要素のベクタで表現することができるでしょう。 それぞれのフィールドは vector-ref をつかってアクセスし、 vector-set! をつかって変更することもできるでしょう。 しかし、どのフィールドがどのインデックスに結びついているかを 覚えなくてはならないなんて面倒をしょいこむのは嫌ですよね。 それでは、ありがたくないですし、そのうち、フィールドが増えたり、減ったり すると、ひどく間違いの原因にもなってしまいます。

それ故、構造体データ型を定義するのに Scheme のマクロ defstruct を使います。これは基本的にはベクタですが、構造体のインスタンスを 生成し、フィールドにアクセスし、フィールドを変更する適切な手続き群を ともなっています。それゆえ、樹木構造体 tree は以下のように定義 できます。

(defstruct tree height girth age leaf-shape leaf-color)

こうすると make-tree という名前のコンストラクタ手続きと、 tree.heighttree.girth、などの名前の、各フィールドに アクセスする手続き、set!tree.heightset!tree.girth、などの 名前の変更用手続きができます。コンストラクタは次のように使います。

(define coconut 
  (make-tree 'height 30
             'leaf-shape 'frond
             'age 5))

コンストラクタの引数は二つ一組になっています。フィールド名と その後につづく初期値です。フィールドはどの順番でもよく、場合によっては なくてもかまいません。その場合にそのフィールドの値は未定義になります。

アクセサ手続きは以下のように呼び出します。

(tree.height coconut) =>  30
(tree.leaf-shape coconut) =>  frond
(tree.girth coconut) =>  <undefined>

tree.girth アクセサは未定義値を返します。それは、 coconut 木(tree)には、girth を指定しなかったからです。

変更子手続きは以下のように呼び出します。

(set!tree.height coconut 40)
(set!tree.girth coconut 10)

ここで、これらのフィールドに対応するアクセサ手続きでアクセスすると 新しい値が得られます。

(tree.height coconut) =>  40
(tree.girth coconut) =>  10

9.1  デフォルトの初期化

インスタンスごとではなくて、構造体そのものの定義中に初期化することが 可能です。それゆえ、leaf-shapeleaf-color がデフォルトで それぞれ、frondgreen であると仮定することができます。 これらのデフォルトの値は、make-tree 呼び出しのなかの明示的な 初期化あるいは、構造体のインスタンスを生成したのちに、変更子を つかっていつでも上書きが可能です。

(defstruct tree height girth age
                (leaf-shape 'frond)
                (leaf-color 'green))

(define palm (make-tree 'height 60))

(tree.height palm) 
=>  60

(tree.leaf-shape palm) 
=>  frond

(define plantain 
  (make-tree 'height 7
             'leaf-shape 'sheet))

(tree.height plantain) 
=>  7

(tree.leaf-shape plantain) 
=>  sheet

(tree.leaf-color plantain) 
=>  green

9.2  defstruct の定義

defstruct マクロの定義は以下のようになっています。

(define-macro defstruct
  (lambda (s . ff)
    (let ((s-s (symbol->string s)) (n (length ff)))
      (let* ((n+1 (+ n 1))
             (vv (make-vector n+1)))
        (let loop ((i 1) (ff ff))
          (if (<= i n)
            (let ((f (car ff)))
              (vector-set! vv i 
                (if (pair? f) (cadr f) '(if #f #f)))
              (loop (+ i 1) (cdr ff)))))
        (let ((ff (map (lambda (f) (if (pair? f) (car f) f))
                       ff)))
          `(begin
             (define ,(string->symbol 
                       (string-append "make-" s-s))
               (lambda fvfv
                 (let ((st (make-vector ,n+1)) (ff ',ff))
                   (vector-set! st 0 ',s)
                   ,@(let loop ((i 1) (r '()))
                       (if (>= i n+1) r
                           (loop (+ i 1)
                                 (cons `(vector-set! st ,i 
                                          ,(vector-ref vv i))
                                       r))))
                   (let loop ((fvfv fvfv))
                     (if (not (null? fvfv))
                         (begin
                           (vector-set! st 
                               (+ (list-position (car fvfv) ff)
                                  1)
                             (cadr fvfv))
                           (loop (cddr fvfv)))))
                   st)))
             ,@(let loop ((i 1) (procs '()))
                 (if (>= i n+1) procs
                     (loop (+ i 1)
                           (let ((f (symbol->string
                                     (list-ref ff (- i 1)))))
                             (cons
                              `(define ,(string->symbol 
                                         (string-append
                                          s-s "." f))
                                 (lambda (x) (vector-ref x ,i)))
                              (cons
                               `(define ,(string->symbol
                                          (string-append 
                                           "set!" s-s "." f))
                                  (lambda (x v) 
                                    (vector-set! x ,i v)))
                               procs))))))
             (define ,(string->symbol (string-append s-s "?"))
               (lambda (x)
                 (and (vector? x)
                      (eqv? (vector-ref x 0) ',s))))))))))