L.i.S.P 写経(その2)、3章
<full-env> はスロットだけ定義されているクラスなのだろうと考えられます。（メソッドを定義する意味が良くわからない。）インスタンスを作られないことにするという方法がありそうだけれど。
と書いたけれども、 block/return-from は <block-env> を使ってアドホックに実現しようとしているので必要になる、ということなのでした。 evaluate に渡される r はレキシカルな環境の（言い方が悪いが）ごった煮で、値に使われるし、 block name にも使われます。
The block named name has lexical scope and dynamic extent.
前の章までのインタープリタでは、新たな環境を実現するのに、例えば fenv を evaluate の引数に追加する、の方法が用いたのだけれども、今回はそうでは無いということ。ジェネリック関数 block-lookup では <block-env> に実装しておいて、他の <full-env> では 'others を辿るだけの実装にしてあって。 lookup の <full-env> にも同様に実装しておいてある、と。
block は name は評価しないのだけれども、これが特徴かしら。 catch と比較するために引用します。
tag---a catch tag; evaluated.
name---a symbol.
evaluated とわざわざ書いてあります、対して block の方に置けるのはシンボルのみ、比較してみると興味深いです。
block-lookup は ;** Modified ** と記述があるけれども、変更されていないように見えるけれども、どうなのだろう。動いているところは確認できます。
(is '("foocleanup" . bar) (let1 r #f (cons (with-output-to-string (lambda () (set! r (eval~ '(block bar (unwind-protect (begin (display "foo") (return-from bar 'bar) (display "more-foo")) (display "cleanup"))))))) r))) ;;>> test `is', expects ("foocleanup" . bar) ==> ok
以下は本文では error! ということなのだけれども、確かにこれどうするんだ？、という気がします。
(catch 1 (catch 2 (unwind-protect (throw 1 'foo) (throw 2 'bar))))
CLHS には undefined consequences という記述があります。
;;; The following has undefined consequences because the catch of B is ;;; passed over by the first THROW, hence portable programs must assume ;;; its dynamic extent is terminated. The binding of the catch tag is not ;;; yet disestablished and therefore it is the target of the second throw. (catch 'a (catch 'b (unwind-protect (throw 'a 1) (throw 'b 2))))
Exercise 3.6の解答の evaluate-lambda が 3.4 で使ったやつそのままなので動かない、あと invoke も extend-env をローカルに定義しなくても良い気がする。 names と values どちらも null? になることがないから、ということかな。それを言ってしまうと、exercise 3.4 の時にも、 シンボルになることはなかったはずで…と思うのだけれども。
両方とも invoke メソッドの中に定義してしまえ、というわけで以下。
(define-method invoke ((f <function-with-arity>) v* r k) (define (%extend-env env names values) (if (pair? names) (make <variable-env> :name (car names) :value (car values) :others (%extend-env env (cdr names) (cdr names))) env)) (if (= (~ f 'arity) (length v*)) (let ((env (%extend-env (~ f 'env) (~ f 'variables) v*))) (evaluate-begin (~ f 'body) env k)) (wrong "Incorrect arity" (~ f 'variables) v*))) ... (define-method invoke ((f <function-nadic>) v* r k) (define (%extend-env env names values) (if (pair? names) (make <variable-env> :name (car names) :value (car values) :others (%extend-env env (cdr names) (cdr values))) (make <variable-env> :name names :value values :others env))) (if (>= (length v*) (~ f 'arity)) (let ((env (%extend-env (~ f 'env) (~ f 'variables) v*))) (evaluate-begin (~ f 'body) env k)) (wrong "Incorrect arity" (~ f 'variables) v*)))
シンボルで終わっているかを見て分岐するのが以下のコード。 <formals> (lambda-list) がシンボルの時にも対応するので常に cons した上で last-pair の cdr を見ている。成程なあ。
話を戻して。こうするので、上で見たように、 %extend-env はそれぞれのメソッド内に定義できる、と考えました。
(define (evaluate-lambda n* e* r k) (define (len n*) (if (pair? n*) (+ 1 (len (cdr n*))) 0)) (define (make-function class) (make class :variables n* :body e* :env r :arity (len n*))) (resume k (if (null? (cdr (last-pair (cons 'n n*)))) (make-function <function-with-arity>) (make-function <function-nadic>))))
前回は call/cc の実装に、 <continuation> に直接メソッドを追加したけれども、これに対して、 <reified-continuation> を作ってそこにメソッドを足すというのはどうか、というのが Exercise 3.8。
(defclass <reified-continuation> (<value>) (k)) (definitial call/cc (make <primitive> :name 'call/cc :address (lambda (v* r k) (if (= (length v*) 1) (invoke (car v*) (list (make <reified-continuation> :k k)) r k))))) (define-method invoke ((f <reified-continuation>) v* r k) (if (= (length v*) 1) (resume (~ f 'k) (car v*)) (wrong "Continuations expect one argument" v* r k)))
<continuation> に直接メソッドを足すわけではなく、それ用のクラスを作ります。実装の内部で使っているクラスを生々しく晒すのを避けることができる、という感触で、後続の章でも使うことができるような手法なのかな、と考えられます。