動的変数

ISLISP には動的変数 (ダイナミックスコープの変数) の仕組みがある。 名前空間が分離されており、参照には特殊演算子 dynamic を用いる。 この方式であれば Scheme で再現するのは簡単そうだと思えたのでやってみた。

(library (dynamic-variables)
  (export dynamic-let defdynamic dynamic set-dynamic)
  (import (rnrs)
          (rnrs control (6))
          (rnrs exceptions (6))
          (rnrs conditions (6))
          (rnrs mutable-pairs (6)))
  
  (define dynamic-chain '())
  (define global-dynamic-variables '())

  (define (add-dynamic-variables vars)
    (set! dynamic-chain (cons vars dynamic-chain)))

  (define (chop-dynamic-variables)
    (set! dynamic-chain (cdr dynamic-chain)))
  
  (define-syntax dynamic-let
    (lambda(stx)
      (syntax-case stx ()
        ((_ ((var val) ...) body0 body1 ...)
         (with-syntax (((tmp ...) (generate-temporaries #'(var ...))))
           #'(let* ((tmp val) ...)
               (dynamic-wind
                 (lambda()
                   (add-dynamic-variables (list (cons 'var tmp) ...)))
                 (lambda() body0 body1 ...)
                 chop-dynamic-variables)
                 ))))))

  (define (lookup-dynamic-variable var)
    (or
     (exists (lambda(x)(assq var x)) dynamic-chain)
     (assq var global-dynamic-variables)
     (raise
      (condition
       (make-undefined-violation)
       (make-message-condition
        (string-append "Unbound dynamic variable: " (symbol->string var)))))))

  (define (%defdynamic var val)
    (set! global-dynamic-variables
          (cons (cons var val) global-dynamic-variables))
    var)
  
  (define-syntax defdynamic
    (syntax-rules ()
      ((_ var val)
       (%defdynamic 'var val))))

  (define-syntax dynamic
    (syntax-rules ()
      ((_ var)
       (cdr (lookup-dynamic-variable 'var)))))

  (define-syntax set-dynamic
    (syntax-rules ()
      ((_ form var)
       (set-cdr! (lookup-dynamic-variable 'var) form))))
  )

使い方の要領は説明するより例示した方がわかりやすいだろう。 詳細が知りたければ ISLISP の仕様を読んで欲しい。

(import (rnrs) (dynamic-variables))

(defdynamic *color* 'red)

(display (dynamic *color*))
(newline)

(define (what-color)
  (dynamic *color*))

(display (what-color))
(newline)

(dynamic-let ((*color* 'green))
  (display (what-color))
  (newline)
  (set-dynamic 'blue *color*)
  (display (what-color))
  (newline))

ISLISP においては、本来は動的変数への代入に一般化代入が使えるのだが、それをうまく再現するのは難しいのでとりあえず set-dynamic だけ用意した。
ところで、 set-dynamic の引数の順序に納得がいかないのだけれど、何か理由があるのだろうか。
Document ID: 7d9a4d844cf960e724b04ce7e9616581