blob: 2412500155cc3086714e7dc44c666ec1d8c08b25 (
plain)
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
;;; Modifications to provide for general procedures.
;;; Syntax extension: allow decorated parameter names.
(defhandler procedure-parameter-name car pair?)
;;; run-time-data extension
(define (delay expression environment)
(vector 'delayed expression environment))
(define (delay-memo expression environment)
(vector 'delayed-memo expression environment))
(define (delayed? x)
(and (vector? x)
(eq? (vector-ref x 0) 'delayed)))
(define (delayed-memo? x)
(and (vector? x)
(eq? (vector-ref x 0) 'delayed-memo)))
(define (deferred? x)
(or (delayed? x) (delayed-memo? x)))
(define (undelayed-memo? x)
(and (vector? x)
(eq? (vector-ref x 0) 'undelayed-memo)))
(define (delayed-expression x)
(vector-ref x 1))
(define (delayed-environment x)
(vector-ref x 2))
(define (undelay-memo! x value)
(vector-set! x 0 'undelayed-memo)
(vector-set! x 1 value)
(vector-set! x 2 the-empty-environment))
(define (undelayed-value x)
(vector-ref x 1))
;;; Evaluator extension -- change to IF:
;;; Must have actual predicate value to proceed from IF.
(defhandler eval
(lambda (expression environment)
(if (undelay!
(eval (if-predicate expression) environment))
(eval (if-consequent expression) environment)
(eval (if-alternative expression) environment)))
if?)
;;; Apply extension:
;;; Must have actual procedure to apply it.
(defhandler apply
(lambda (procedure operands calling-environment)
(apply (undelay! procedure)
operands
calling-environment))
deferred?)
;;; Must have values of arguments for strict primitives.
(define (evaluate-list operands calling-environment)
(cond ((null? operands) '())
((null? (rest-operands operands))
(list (undelay! (eval (first-operand operands)
calling-environment))))
(else
(cons (undelay! (eval (first-operand operands)
calling-environment))
(evaluate-list (rest-operands operands)
calling-environment)))))
(defhandler evaluate-procedure-operand
(lambda (parameter operand environment)
(delay operand environment))
lazy?)
(defhandler evaluate-procedure-operand
(lambda (parameter operand environment)
(delay-memo operand environment))
lazy-memo?)
(define undelay!
(make-generic-operator 1 (lambda (x) x)))
(defhandler undelay!
(lambda (object)
(undelay! (eval (delayed-expression object)
(delayed-environment object))))
delayed?)
(defhandler undelay!
(lambda (object)
(let ((value
(undelay! (eval (delayed-expression object)
(delayed-environment object)))))
(undelay-memo! object value)
value))
delayed-memo?)
(defhandler undelay!
undelayed-value
undelayed-memo?)
;;; For printing output
(defhandler write
(compose write undelay!)
deferred?)
(defhandler write-line
(compose write-line undelay!)
deferred?)
(defhandler pp
(compose pp undelay!)
deferred?)
(defhandler write
(compose write undelayed-value)
undelayed-memo?)
(defhandler write-line
(compose write-line undelayed-value)
undelayed-memo?)
(defhandler pp
(compose pp undelayed-value)
undelayed-memo?)
|
