アクセサの生成

Scheme でオブジェクトシステムを作ろうとすると、 syntax-rules ではアクセサを自動で作れないという意見がある。

@cametan_001 Schemeは関数型ではないという僕の主張は横に置くとして、CでOOPをやってやれなくないことを考えればどうやるかによるのでは？TinyCLOSとかありますし。まぁ、アクセサの自動生成とかは不可能ですけど。

— Kei (@tk_riple) 2015, 7月 21

より厳密にいえばアクセサを作れないのではなく、アクセサの名前を作ることが出来ないという話だと思う。 R6RS の define-record-type ではレコード名とフィールド名をハイフンで繋げたものがデフォルトのアクセサ名になるが、そのようなことは syntax-rules では出来ない。 逆にいえば、アクセサに固有の名前を付けようとしなければアクセサを作ることは可能なのではないかということを考えた。

オブジェクトシステムを作るのはたいへんなので、とりあえずレコードを簡単にラッピングしてアクセサ生成の機能を付けたものを書いてみた。 レコードとは似て非なるもの (実態はレコードだが) なので、仮に struct と名付けている。 R7RS 向けである。

(define-library (struct)
  (export define-struct make-struct struct-ref struct-set! struct-type-of?)
  (import (scheme base))

  (begin
    (define-syntax flag-accessor (syntax-rules ()))
    (define-syntax flag-mutator (syntax-rules ()))
    (define-syntax flag-constructor (syntax-rules ()))
    (define-syntax flag-predicate (syntax-rules ()))

    (define-syntax %define-struct
      (syntax-rules ()
        ((_ name (var ...) () (a ...) (m ...))
         (begin
           (define-record-type tempname (constructor var ...) predicate
             (var a m) ...)
           (define-syntax name
             (syntax-rules
                 (flag-accessor flag-mutator
                  flag-predicate flag-constructor var ...)
               ((_ flag-accessor var) a) ...
               ((_ flag-mutator var) m) ...
               ((_ flag-predicate) predicate)
               ((_ flag-constructor) constructor)))))
        ((_ name (var ...) ((v a m) vs ...) (as ...) (ms ...))
         (%define-struct name (var ... v) (vs ...) (as ... a) (ms ... m)))
        ((_ name (var ...) ((v a) vs ...) (as ...) (ms ...))
         (%define-struct name (var ... v) (vs ...) (as ... a) (ms ... m)))
        ((_ name (var ...) ((v) vs ...) (as ...) (ms ...))
         (%define-struct name (var ... v) (vs ...) (as ... a) (ms ... m)))
        ((_ name (var ...) (v vs ...) (a ...) (m ...))
         (%define-struct name (var ... v) (vs ...) (a ... t1) (m ... t2)))))

    (define-syntax define-struct
      (syntax-rules ()
        ((_ name var ...)
         (%define-struct name () (var ...) () ()))))

    (define-syntax make-struct
      (syntax-rules ()
        ((_ struct args ...)
         ((struct flag-constructor) args ...))))

    (define-syntax struct-ref
      (syntax-rules ()
        ((_ struct field obj) ((struct flag-accessor field) obj))))

    (define-syntax struct-set!
      (syntax-rules ()
        ((_ struct field obj value) ((struct flag-mutator field) obj value))))

    (define-syntax struct-type-of?
      (syntax-rules ()
        ((_ struct obj) ((struct flag-predicate) obj))))
    ))

この定義における struct-ref が汎用のアクセサである。 構造体名とフィールド名を指定することで実際のアクセサを取出してオブジェクト内から値を取出すことが出来る。 定義時にアクセサの名前を与えておけばそれを使うことも出来る。

使用例は以下のようになる。 前回の記事でも取り上げたように、マクロによってトップレベル変数を作るのは処理系によって解釈が異なるので、ここでは let の中に入れてしまうことで解決を図っている。

(import (scheme base) (scheme write) (struct))

(let ()
  (define-struct animal
    sound
    (flyable animal-flyable-ref))

  (define (cry obj)
    (display (struct-ref animal sound obj))  ;; 汎用アクセサ struct-ref が使える
    (newline))

  (define (fly obj)
    (if (animal-flyable-ref obj) ;; 定義時にアクセサ名の指定ありならそれを使える
        (display "I can fly!\n")
        (display "I cannot fly...\n")))

  (define crow (make-struct animal "caw" #t))
  (define cat  (make-struct animal "meow" #f))

  (cry crow) ;; カラスはカーと鳴く
  (cry cat)  ;; 猫はミャオと鳴く
  (fly crow) ;; カラスは飛べる
  (fly cat)  ;; 猫は飛べない

  (struct-set! animal sound cat "nyaa")
  (cry cat)  ;; やっぱり猫はニャーと鳴く

  (display (struct-type-of? animal cat)) ;; 猫は動物？
  (display (struct-type-of? animal "cat")) ;; 文字列は動物じゃないよ
  )

隠れた変数とそれに展開されるようなマクロを組合わる方法は私が過去に書いたものでもたびたび使っている。 使い出のあるやり方だと思う。

Document ID: eb5ff02ae95f831cba37764cee2a90f8