データを自然にグループ化したものを構造体と呼びます。
Scheme の合成データ型としてたとえば、ベクタ、リストをつかって
構造体を表現できます。たとえば、(生物学的な)樹木に関連した
グループ化したデータを扱うとしましょう。このデータの個別の要素、
あるいはフィールドは、高さ、胴まわり、樹齢、
葉形、葉色など、全部で 5 つのフィールドをつくるとしましょう。
このなデータは、5 要素のベクタで表現することができるでしょう。
それぞれのフィールドは vector-ref
をつかってアクセスし、
vector-set!
をつかって変更することもできるでしょう。
しかし、どのフィールドがどのインデックスに結びついているかを
覚えなくてはならないなんて面倒をしょいこむのは嫌ですよね。
それでは、ありがたくないですし、そのうち、フィールドが増えたり、減ったり
すると、ひどく間違いの原因にもなってしまいます。
それ故、構造体データ型を定義するのに Scheme のマクロ defstruct
を使います。これは基本的にはベクタですが、構造体のインスタンスを
生成し、フィールドにアクセスし、フィールドを変更する適切な手続き群を
ともなっています。それゆえ、樹木構造体 tree
は以下のように定義
できます。
(defstruct tree height girth age leaf-shape leaf-color)
こうすると make-tree
という名前のコンストラクタ手続きと、
tree.height
、tree.girth
、などの名前の、各フィールドに
アクセスする手続き、set!tree.height
、set!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
インスタンスごとではなくて、構造体そのものの定義中に初期化することが
可能です。それゆえ、leaf-shape
や leaf-color
がデフォルトで
それぞれ、frond
や green
であると仮定することができます。
これらのデフォルトの値は、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
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))))))))))