about summary refs log tree commit diff stats
path: root/000organization.cc
blob: 0f2518f5bf3134e6fb3af4e4b2f775e0a57c5db4 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;;;;LAZY EVALUATOR FROM SECTION 4.2 OF
;;;; STRUCTURE AND INTERPRETATION OF COMPUTER PROGRAMS

;;;;Matches code in ch4.scm
;;;; Also includes enlarged primitive-procedures list

;;;;This file can be loaded into Scheme as a whole.
;;;;**NOTE**This file loads the metacircular evaluator of
;;;;  sections 4.1.1-4.1.4, since it uses the expression representation,
;;;;  environment representation, etc.
;;;;  You may need to change the (load ...) expression to work in your
;;;;  version of Scheme.

;;;;Then you can initialize and start the evaluator by evaluating
;;;; the expression (mce).


;;**implementation-dependent loading of evaluator file
;;Note: It is loaded first so that the section 4.2 definition
;; of eval overrides the definition from 4.1.1
(load "~/61a/Lib/mceval.scm")


;;  To run without memoization, reload the first version of force-it below


;;;SECTION 4.2.2

;;; Modifying the evaluator

(define (mc-eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((begin? exp) 
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (mc-eval (cond->if exp) env))
        ((application? exp)             ; clause from book
         (mc-apply (actual-value (operator exp) env)
		   (operands exp)
		   env))
        (
ne (actual-value exp env) (force-it (mc-eval exp env))) (define (mc-apply procedure arguments env) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure (list-of-arg-values arguments env))) ; changed ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) (list-of-delayed-args arguments env) ; changed (procedure-environment procedure)))) (else (error "Unknown procedure type -- APPLY" procedure)))) (define (list-of-arg-values exps env) (if (no-operands? exps) '() (cons (actual-value (first-operand exps) env) (list-of-arg-values (rest-operands exps) env)))) (define (list-of-delayed-args exps env) (if (no-operands? exps) '() (cons (delay-it (first-operand exps) env) (list-of-delayed-args (rest-operands exps) env)))) (define (eval-if exp env) (if (true? (actual-value (if-predicate exp) env)) (mc-eval (if-consequent exp) env) (mc-eval (if-alternative exp) env))) (define input-prompt ";;; L-Eval input:") (define output-prompt ";;; L-Eval value:") (define (driver-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (actual-value input the-global-environment))) (announce-output output-prompt) (user-print output))) (driver-loop)) ;;; Representing thunks ;; non-memoizing version of force-it (define (force-it obj) (if (thunk? obj) (actual-value (thunk-exp obj) (thunk-env obj)) obj)) ;; thunks (define (delay-it exp env) (list 'thunk exp env)) (define (thunk? obj) (tagged-list? obj 'thunk)) (define (thunk-exp thunk) (cadr thunk)) (define (thunk-env thunk) (caddr thunk)) ;; "thunk" that has been forced and is storing its (memoized) value (define (evaluated-thunk? obj) (tagged-list? obj 'evaluated-thunk)) (define (thunk-value evaluated-thunk) (cadr evaluated-thunk)) ;; memoizing version of force-it (define (force-it obj) (cond ((thunk? obj) (let ((result (actual-value (thunk-exp obj) (thunk-env obj)))) (set-car! obj 'evaluated-thunk) (set-car! (cdr obj) result) ; replace exp with its value (set-cdr! (cdr obj) '()) ; forget unneeded env result)) ((evaluated-thunk? obj) (thunk-value obj)) (else obj))) ;; A longer list of primitives -- suitable for running everything in 4.2 ;; Overrides the list in ch4-mceval.scm (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list 'list list) (list '+ +) (list '- -) (list '* *) (list '/ /) (list '= =) (list 'newline newline) (list 'display display) ;; more primitives )) 'LAZY-EVALUATOR-LOADED