Scheme - 超言語的抽象(Scheme の変形 - 遅延評価(遅延評価の解釈系(評価器の修正(サンクの表現(演算子の評価, eval, actual-value, 関数引数)))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の4(超言語的抽象)、4.2(Scheme の変形 - 遅延評価)、4.2.2(遅延評価の解釈系)、評価器の修正、サンクの表現、問題 4.28.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 4.28.

手続きを引数としてとる手続きを評価するときに、演算子の値を強制するため、evalではなくactual-valueを使う必要がある。

例として、

(define env the-global-environment)
(define (inc n) (+ n 1))
(define (f g) (g 10))
(f inc)

を評価する場合を考えてみる。

変数incの値は

(procedure (n) ((+ n 1)) env)

変数fの値は

(procedure (g) ((g 10)) env)

evalを使用した場合。

(apply (eval (operator (f inc)) env)
       (operands (f inc))
       env)

(apply (eval f env)
       (inc)
       env)

(apply (procedure (g) ((g 10)) env)
       (inc)
       env)

(eval-sequence
 ((g 10))
 (extend-environment
  (g)
  (list-of-delayed-args (inc) env)
  env))

(eval-sequence
 ((g 10))
 (extend-environment
  (g)
  ((delay-it inc env))
  env))

(eval-sequence
 ((g 10))
 (extend-environment
  (g)
  ((thunk inc env))
  env))

;; extended-environmentに変数g, 値(thunk inc env)が登録されている
(eval-sequence
 ((g 10))
 extended-environment)

(eval (g 10) extended-environment)

(apply (eval g extended-environment)
       10
       extended-environment)

(apply (thunk inc env)
       10
       extended-environment)
;; この評価で (thunk inc env)は、基本手続きでも合成手続きでもなく、エラーになる。

evalではなくactual-valueを使った場合

(apply (actual-value (operator (f inc)) env)
       (operands (f inc))
       env)

(apply (actual-value f env)
       (inc)
       env)

(apply (force-it (eval f env))
       (inc)
       env)

(apply (force-it (procedure (g) ((g 10)) env))
       (inc)
       env)

(apply (procedure (g) ((g 10)) env)
       (inc)
       env)

(eval-sequence
 ((g 10))
 (extend-environment
  (g)
  (list-of-delayed-args (inc) env)
  env))

(eval-sequence
 ((g 10))
  (extend-environment
   (g)
   ((delay-it inc env))
   env))

(eval-sequence
 ((g 10))
 (extend-environment
  (g)
  ((thunk inc env))
  env))

;; extended-environmentに変数g, 値(thunk inc env)が登録されている
(eval-sequence
 ((g 10))
 extended-environment)

(eval (g 10) extended-environment)

(apply (actual-value (operator (g 10))
                     extended-environment)
       (operands (g 10))
       extended-environment)

(apply (actual-value g extended-environment)
       (10)
       extended-environment)

(apply (force-it (eval g extended-environment))
       (10)
       extended-environment)

(apply (force-it (thunk inc env))
       (10)
       extended-environment)

(apply (actual-value (thunk-exp (thunk inc env))
                     (thunk-env (thunk inc env)))
       (10)
       extended-environment)

(apply (actual-value inc env)
       (10)
       extended-environment)

(apply (force-it (eval inc env))
       (10)
       extended-environment)

(apply (force-it (procedure (n) ((+ n 1)) env))
       (10)
       extended-environment)

(apply (procedure (n) ((+ n 1)) env)
       (10)
       extended-environment)

(eval-sequence
 (procedure-body (procedure (n) ((+ n 1)) env))
 (extend-environment
  (procedure-parameters (procedure (n) ((+ n 1)) env))
  (list-of-delayed-args (10) extend-environment)
  (procedure-environment (procedure (n) ((+ n 1)) env))))

(eval-sequence
 ((+ n 1))
 (extend-environment
  (n)
  ((delay-it 10 extend-environment))
  env))

(eval-sequence
 ((+ n 1))
 (extend-environment
  (n)
  ((thunk 10 extend-environment))
  env))

;; extended-environmentに変数n、値(thunk 10 extend-environment)が追加される。
(eval-sequence
 ((+ n 1))
 extended-environment2)

(eval (+ n 1) extended-environment2)

(apply (actual-value + extended-environment2)
       (n 1)
       extended-environment2)

(apply (force-it (eval + extended-environment2))
       (n 1)
       extended-environment2)

(apply (force-it (primitive +))
       (n 1)
       extended-environment2)

(apply (primitive +)
       (n 1)
       extended-environment2)

(apply-primitive-procedure
 (primitive +)
 (list-of-arg-values (n 1) extended-environment2))

(apply-primitive-procedure
 (primitive +)
 ((actual-value n extended-environment2)
  (actual-value 1 extended-environment2)))

(apply-primitive-procedure
 (primitive +)
 (force-it (eval n extended-environment2))
 (force-it (eval 1 extended-environment2)))

(apply-primitive-procedure
 (primitive +)
 ((force-it (thunk 10 extend-environment))
  (force-it 1)))

(apply-primitive-procedure
 (primitive +)
 ((actial-value 10 extend-environment)
  1))

(apply-primitive-procedure
 (primitive +)
 (force-it (eval 10 extend-environment))
 1)

(apply-primitive-procedure
 (primitive +)
 ((force-it 10)
  1))

(apply-primitive-procedure
 (primitive +)
 (10 1))

(apply-in-underlying-scheme
 (primitive-implementation (primitive +)) (10 1))

(apply-in-underlying-scheme + (10 1))

11

確認。

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./error_lazy_evaluator_without_analyzer.scm


;;; L-Eval input:
(define (inc n) (+ n 1))


;;; L-Eval value:
ok

;;; L-Eval input:
(define (f g) (g 10))


;;; L-Eval value:
ok

;;; L-Eval input:
(f inc)
gosh: "error": Unknown procedure type -- APPLY (thunk inc #0=(((f inc false true car cdr cons null? exit = + - * /) (procedure (g) ((g 10)) #0#) (procedure (n) ((+ n 1)) #0#) #f #t (primitive #<subr car>) (primitive #<subr cdr>) (primitive #<subr cons>) (primitive #<subr null?>) (primitive #<closure exit>) (primitive #<subr =>) (primitive #<subr +>) (primitive #<subr ->) (primitive #<subr *>) (primitive #<subr />))))
$ ./lazy_evaluator_without_analyzer.scm


;;; L-Eval input:
(define (inc n) (+ n 1))


;;; L-Eval value:
ok

;;; L-Eval input:
(define (f g) (g 10))


;;; L-Eval value:
ok

;;; L-Eval input:
(f inc)


;;; L-Eval value:
11

;;; L-Eval input:
(exit)
$