SICP 5.4.4 Running the Evaluator

ノート

ここに書いてあるドライバーループは既に実装として使っている。しかもExcersese 5.25では少し変更もしている。
Exercise 5.25の結果でもちゃんと例は動作する。

(define (append x y)
  (if (null? x)
      y
      (cons (car x)
            (append (cdr x) y))))

;;; EC-Eval value:
ok

;;; EC-Eval input:
(append '(a b c) '(d e f))

;;; EC-Eval value:
(a b c d e f)

;;; EC-Eval input:

ここでは、Racketで実装されたSchemeインタープリータでSchemeプログラムを実行しているので、Racketに直接プログラムを実行させるのよりはパーフォーマンスが劣る。

Monitoring the performance of the evaluator

テキストの通りスタックの状況をプリントしてみる。

;;; EC-Eval input:
(define (factorial n)
  (if (= n 1)
      1
      (* (factorial (- n 1)) n)))

(total-pushes = 3 maximum-depth = 3)
;;; EC-Eval value:
ok

;;; EC-Eval input:
(factorial 5)

(total-pushes = 144 maximum-depth = 28)
;;; EC-Eval value:
120

;;; EC-Eval input:

Exercise 5.26

n	n!	total-pushes	maximum-depth
3	6	134	10
4	24	169	10
5	120	204	10
6	720	239	10

a)
と言う訳で、maximum-depthは常に10。

b)
3!と4!の差が35、4!と5!の差も35、以下同文。また、35×3=105なので134との差は29。と言う訳で

Exercise 5.27

n	n!	total-pushes	maximum-depth
3	6	80	18
4	24	112	23
5	120	144	28
6	720	176	33

プッシュ回数は32ずつ、深さは5ずつ増えていく。

実装方法	maximum-depth	toal-pushes
再帰	5n+3	32n+16
反復	10	35n+29

Exercise 5.28

再帰的実装から：

n	n!	total-pushes	maximum-depth
3	6	86	27
4	24	120	35
5	120	154	43
6	720	188	51

次に反復的実装。

n	n!	total-pushes	maximum-depth
3	6	144	23
4	24	181	26
5	120	218	29
6	720	255	32

実装方法	maximum-depth	toal-pushes
再帰	8n+3	34n-16
反復	3n+14	37n+33

Exercise 5.29

n	fib(n)	total-pushes	maximum-depth
2	1	72	13
3	2	128	18
4	3	240	23
5	5	408	28
6	8	688	33

a)
5ずつ増えて、n=0を仮定すると3になるので

b)
S(4)=240、S(3)=128、S(2)=72から考えるとS(4)=S(3)+S(2)+40。
この式からS(5)を予想すると、S(5)=240+128+40=408。合ってる。
S(6)を予想すると、S(6)=408+240+40=688。合っていそう。
と言う訳で、

S(2)をで表す。72=2a+b。S(3)から128=3a+b。
連立方程式を解くとa=56、b=-40。つまり
S(4)を予測すると、
S(5)を予測すると、

Exercise 5.30

a)
インタープリタのコードがエラーで止まる箇所は以下の通り。

make-register/dispatch	レジスタに対する未定義のメッセージを送った
make-stack/pop	既にからのスタックからポップしようとした
make-stack/dispatch	スタックに対する未定義のメッセージを送った
make-new-machine/allocate-register	既に定義されたレジスタ名を再定義しようとした
make-new-machine/dispatch	マシンに対する未定義のメッセージを送った
lookup-label	未定義のラベルを参照した
make-execution-procedure	未定義の命令を実行しようとした
make-test	test命令の文法が間違っている
make-branch	branch命令の文法が間違っている
make-goto	goto命令の文法が間違っている
make-perform	perform命令の文法が間違っている
make-primitive-exp	プリミティブ命令の文法が間違っている
lookup-prim	未定義のプリミティブを実行しようとした
extend-evaluation	環境に登録する名前と値の数が一致しない
lookup-variable-value	未定義の名前を参照しようとした
set-variable-value	未定義の名前の値を変更しようとした

lookup-variable-valueでのエラーだけはユーザーの入力によって起こり得るが、それ以外は全てインタープリタのコードのバグでしか起こり得ない。インタープリタのバグの場合はREPLから抜けるのは適切な対応と言えるので、対応すべきはlookup-variable-valueでのエラーへの対処のみと言って良い。

まずはlookup-variable-valueがerrorで停止している部分を改造。
Racketのdictionaryを使った現在の実装。

(define (lookup-variable-value var env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (dict-ref (first-frame env) var (lambda () (env-loop (enclosing-environment env))))))
  (env-loop env))

変数の値としては何でも取り得るので、Maybe型の様な（タグ＋値）と言うタプルを返したい所。そうすると変数が見つかった時に直ぐに戻ってしまう今の形では無理。これを以下の様に変更して、更に補助関数も用意。

(define (lookup-variable-value var env)
  (define (env-loop env)
    (cond ((eq? env the-empty-environment) (cons 'unbound '()))
          ((dict-has-key? (first-frame env) var) (cons 'bound (dict-ref (first-frame env) var)))
          (else (env-loop (enclosing-environment env)))))
  (env-loop env))
(define (bound? result)
  (eq? (car result) 'bound))
(define (bound-value result)
  (cdr result))

動作確認

> (lookup-variable-value 'x (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '()))
'(bound . 1)
> (lookup-variable-value 'z (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '()))
'(unbound)
> (lookup-variable-value 'b (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '()))
'(bound . "b")
> (bound? (lookup-variable-value 'x (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '())))
#t
> (bound? (lookup-variable-value 'z (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '())))
#f
> (bound-value (lookup-variable-value 'x (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '())))
1
> (bound-value (lookup-variable-value 'b (list #hash((x . 1) (y . 2)) #hash((a . "a") (b . "b")) '())))
"b"
> 

補助関数をオペレータとして追加

(define eceval-operations
  (list (list 'self-evaluating? self-evaluating?)
        …
        (list 'bound? bound?)
        (list 'bound-value bound-value)
        ))

ev-variableの部分は以下のように変更

     ev-variable
     (assign val (op lookup-variable-value) (reg exp) (reg env))
     (test (op bound?) (reg val))
     (branch (label bound-variable))
     (goto (label unbound-variable))
     bound-variable
     (assign val (op bound-value) (reg val))
     (goto (reg continue))

エラー処理部分は

     unbound-variable
     (assign val (const unbound-variable-error))
     (goto (label signal-error))

動作させてみる。

;;; EC-Eval input:
(define x 1)

;;; EC-Eval value:
ok

;;; EC-Eval input:
x

;;; EC-Eval value:
1

;;; EC-Eval input:
y
unbound-variable-error

;;; EC-Eval input:

REPLに戻っている。

b)

;;; EC-Eval input:
(/ 1 0)
. . /: division by zero
> 

現状ではプリミティブのエラーはインタープリタの実行が止まってしまう。

ベースのSchemeとして使用しているRacketではwith-handlersと言う関数を使って例外処理ができるので、プリミティブのエラーは例外を補足する事で取り敢えず実現できる。

> (with-handlers ([exn:fail? (lambda (exn) exn)]) (/ 1 0))
(exn:fail:contract:divide-by-zero "/: division by zero" #<continuation-mark-set>)
> 

これを使ってapply-primitive-procedureからwith-handlersを呼び出す様に変更する。結果はタプルで成否を示す#t/#fと、成功した時には戻り値を、失敗のときには飛ばされた例外のペアにする。またこのタプルにアクセスする補助関数を用意する。

(define (apply-primitive-procedure proc args)
  (with-handlers ([exn:fail? (lambda (exn) (cons #f exn))])
    (cons #t (apply-in-underlying-scheme (primitive-implementation proc) args))))
(define (primitive-apply-succeeded? result)
  (car result))
(define (primitive-apply-result result)
  (cdr result))

…

(define eceval-operations
  (list (list 'self-evaluating? self-evaluating?)
        …
        (list 'primitive-apply-succeeded? primitive-apply-succeeded?)
        (list 'primitive-apply-result primitive-apply-result)
        ))

primitive-applyはapply-primitive-procedureを呼び出した後に成否をチェックする。

     primitive-apply
     (assign val (op apply-primitive-procedure)
             (reg proc)
             (reg argl))
     (test (op primitive-apply-succeeded?) (reg val))
     (branch (label primitive-apply-succeeded))
     (goto (label primitive-apply-failed))
     primitive-apply-succeeded
     (assign val (op primitive-apply-result) (reg val))
     (restore continue)
     (goto (reg continue))

エラーハンドリングでも投げられた例外を表示するようにする。

     primitive-apply-failed
     (assign val (op primitive-apply-result) (reg val))
     (goto (label signal-error))

実行してみる。

;;; EC-Eval input:
(/ 10 5)

;;; EC-Eval value:
2

;;; EC-Eval input:
(/ 1 0)
#(struct:exn:fail:contract:divide-by-zero /: division by zero #<continuation-mark-set>)

;;; EC-Eval input:
(car 'a)
#(struct:exn:fail:contract car: contract violation
  expected: pair?
  given: 'a #<continuation-mark-set>)

;;; EC-Eval input:
(cons 'a)
#(struct:exn:fail:contract:arity cons: arity mismatch;
 the expected number of arguments does not match the given number
  expected: 2
  given: 1
  arguments...:
   'a #<continuation-mark-set>)

;;; EC-Eval input:

もう少し気の利いた出力が出来ると良いが、取り敢えずこれで目的は達成している。