レコードもどきを作る

プログラミング言語 Scheme にはレコードという機能がある。 他の言語で構造体などと呼ばれるようなものに似ている。 単に複数のオブジェクトの集合体ということであればリストやベクタで出来てしまうし、 SICP でレコードは用いられない (SICP が書かれた時代は R5RS までしかなく、 R5RS にはレコードはない) ということもあってか、レコードが軽視されている印象があるのだが、コードのわかりやすさにかなり貢献すると私は考えている。

レコードが欲しいとき

ではレコードがどんなときに欲しいか SICP の中からキューを例にとってみよう。

http://sicp.iijlab.net/fulltext/x332.html

SICP の 3.3.2 で定義されているキューはリスト、そしてそのリストの先頭要素と末尾要素を指すペアから成る。 キューのオブジェクトを生成する手続きはこうなっている。

(define (make-queue) (cons '() '()))

make-queue の生成するペアの car フィールドが先頭要素を、 cdr フィールドが末尾要素を指しているのだが、コンストラクタだけを見てもそれを読み取ることは出来ない。 更にアクセサを見て初めてそれぞれが意味するところがわかる。

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))

データのそれぞれが意味するところはデータを操作しているところを見るまでわからないので、データ構造をコードだけ見て理解しづらい。 データ構造やその要素に名前を付け、また同時にアクセサと関連付けたいと考えるのは自然なことではないだろうか。 データ構造とアクセサ、モディファイアは不可分なものだろう。

レコードを使ってみる

上で引用したコードについて R7RS の define-record-type を用いて書くなら以下のようになる。

(define-record-type <queue> (%make-queue front rear) queue?
  (front front-ptr set-front-ptr!)
  (rear  rear-ptr  set-rear-ptr!))

(define (make-queue) (%make-queue '() '()))

コンストラクタ、アクセサ、モディファイアが一度に定義され、関係がより明白だ。

ちなみに、残念ながら R7RS の define-record-type はデフォルト値を指定して要素を初期化する機能がないのでここでは二段階に分けたが、 R6RS の define-record-type はより高度な機能を持っていてこれを解決できる。

レコードの使い難さ

Scheme では、取り扱えるオブジェクトの一部をデータ値 (datum value) と呼んでいる。 仕様の中でこの用語を定義しているのは R6RS だけのようだが、概念的には R5RS や R7RS でも同じような考え方があるのでここではデータ値という用語を使うことにする。

データ値とは、 write 手続きで書出して read 手続きで読出したオブジェクトが書出し前の値と等しいことが保証されているオブジェクトである。 リテラル表記が可能な値と考えてもよいだろう。

具体的には

  • 真偽値
  • 数値
  • 文字
  • シンボル
  • 文字列
  • 以上を要素とするようなリストやベクタ

といったようなものだ。

Scheme の仕様上はレコードはデータ値ではない。 read で復元できないだけで、処理系によっては write で要素まで表示してくれることもあるが何も保証はないので移植性のある形でレコードを表示したいのであれば各要素を取出して表示する必要がある。

例えばこのようなコードを実行してみよう。

(import (scheme base) (scheme write))

(define-record-type alt-pair (kons x y) kons?
  (x kar set-kar!)
  (y kdr set-kdr!))

(write (kons 1 2))

Gauche はこのように表示する。

#<alt-pair 032a4660>

オブジェクトを一意に識別するアドレスを表示するだけでその内容までは表示してくれない。 Sagittarius でも同様である。

Foment は要素まで表示してくれる。

#<(alt-pair: #x9e0730 x: 1 y: 2)>

プログラムの完成段階であればともかく、試行錯誤の段階ではデータ構造を write ひとつで書出せると実に楽なので、レコードよりもリストを使ってしまいがちになる。

マクロで作るレコードもどき

データ値にレコードの構文をかぶせるマクロを作るという方法を私は考えた。

以下の実装による define-record-type は R7RS の define-record-type と同じ構文であるが、コンストラクタが生成するオブジェクトの実態はベクタである。 ベクタはもちろんデータ値なので write で内容を表示することが出来る。

レコード型を区別するためにベクタの最初の要素にリストを入れているが、これはレコード型を定義するときに生成するリストと eq? 的に等しいか否かで区別するので一旦 write で書き出しだものを read しても元と同じではないということには注意する必要がある。 あくまでレコードを簡単に表示できるので便利だというだけのものだ。

(define-library (vrecord)
  (export define-record-type)
  (import (except (scheme base) define-record-type))

  (begin

    (define (make-accessor tag count)
      (lambda(record)
        (if (and (vector? record)
                 (< 0 (vector-length record))
                 (eq? (vector-ref record 0) tag))
            (vector-ref record count))))

    (define (make-modifier tag count)
      (lambda(record obj)
        (if (and (vector? record)
                 (< 0 (vector-length record))
                 (eq? (vector-ref record 0) tag))
            (vector-set! record count obj))))

    (define (make-predicate tag)
      (lambda(record)
        (and (vector? record)
             (< 0 (vector-length record))
             (eq? (vector-ref record 0) tag))))

    (define-syntax duplicate-check
      (syntax-rules ()
        ((_) #f)
        ((_ p r ...)
         (letrec-syntax
             ((foo (syntax-rules (r ...)
                     ((_  r) (syntax-error "duplicated field-name" p))
                     ...
                     ((_  x) (duplicate-check r ...)))))
           (foo p)))))

    (define-syntax contained-in-fields?
      (syntax-rules ()
        ((_ fs (f ...)) #f)
        ((_ fs (f ...) i . is)
         (let-syntax ((foo (syntax-rules (f ...)
                             ((_ f) (contained-in-fields? fs fs . is))
                             ...
                             ((_ g) (syntax-error "unrecognized field-name" i)))))
           (foo i)))))

    (define-syntax make-constructor
      (syntax-rules ()
        ((_ tag (a ...) (i ...) ())
         (lambda(i ...) (vector tag a ...)))
        ((_ tag (a ...) (i ...) (f fr ...))
         (let-syntax ((foo (syntax-rules (i ...)
                             ((_ tag t e i is r) (make-constructor tag t is r))
                             ...
                             ((_ tag t e j is r) (make-constructor tag e is r)))))
           (foo tag (a ... f) (a ... (if #f #t)) f (i ...) (fr ...))))))

    (define-syntax foo
      (syntax-rules ()
        ((_ n tag (pn ...) (pb ...) idx)
         (define-values (pn ...)
           (let ((tag (list 'record 'n)))
             (values pb ...))))
        ((_ n tag (pn ...) (pb ...) idx (fx ax) r ...)
         (foo n tag (pn ... ax) (pb ... (make-accessor tag idx)) (+ 1 idx) r ...))
        ((_ n tag (pn ...) (pb ...) idx (fx ax mx) r ...)
         (foo n tag (pn ... ax mx)
              (pb ... (make-accessor tag idx) (make-modifier tag idx))
              (+ 1 idx)
              r ...))))

    (define-syntax define-record-type
      (syntax-rules ()
        ((_ n (c i ...) p (f a m ...) ...)
         (begin
           (duplicate-check f ...)
           (duplicate-check i ...)
           (contained-in-fields? (f ...) (f ...) i ...)
           (foo n tag (c p)
                ((make-constructor tag () (i ...) (f ...))
                 (make-predicate tag))
                1 (f a m ...) ...)))))
    ))

レコードもどきを使ってみる

では作ってみたレコードもどきを使ってみる。

(import (except (scheme base) define-record-type)
        (scheme write)
        (vrecord))

(define-record-type alt-pair (kons x y) kons?
  (x kar set-kar!)
  (y kdr set-kdr!))

(let ((k (kons 1 2)))
  (write k)
  (newline)
  (write (kons? k))
  (write (kons? (cons 1 2)))
  (write (kar k))
  (write (kdr k))
  (set-kar! k 3)
  (write (kar k))
  (newline)
  (write k))

この実行例を実行した結果は以下のように表示されるはずだ。

#((record alt-pair) 1 2)
#t#f123
#((record alt-pair) 3 2)

R7RS の define-record-type と干渉しないように import のときに except を指定することを忘れないように気を付けて欲しい。

ちなみに、ほんの少しだけ修正すれば R5RS でも使えるはずなので R7RS 用のコードを R5RS に移植するような場合にも利用できるだろう。

Document ID: 42a50ddec93f9d61b6d6e6736487d0b0