blob: 8f83b7401813ac96d4e52c133073c92299415c74 (
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
|
;;;; Separating analysis from execution.
;;; Generic analysis, but not prepared for
;;; extension to handle nonstrict operands.
(define (eval exp env)
((analyze exp) env))
(define analyze
(make-generic-operator 1
(lambda (exp)
(cond ((application? exp)
(analyze-application exp))
(else
(error "Unknown expression type"
exp))))))
(define (analyze-self-evaluating exp)
(lambda (env) exp))
(defhandler analyze analyze-self-evaluating self-evaluating?)
(define (analyze-quoted exp)
(let ((qval (text-of-quotation exp)))
(lambda (env) qval)))
(defhandler analyze analyze-quoted quoted?)
(define (analyze-variable exp)
(lambda (env) (lookup-variable-value exp env)))
(defhandler analyze analyze-variable variable?)
(define (analyze-if exp)
(let ((pproc (analyze (if-predicate exp)))
(cproc (analyze (if-consequent exp)))
(aproc (analyze (if-alternative exp))))
(lambda (env)
(if (true? (pproc env)) (cproc env) (aproc env)))))
(defhandler analyze analyze-if if?)
(define (analyze-lambda exp)
(let ((vars (lambda-parameters exp))
(bproc (analyze (lambda-body exp))))
(lambda (env)
(make-compound-procedure vars bproc env))))
(defhandler analyze analyze-lambda lambda?)
(define (analyze-application exp)
(let ((fproc (analyze (operator exp)))
(aprocs (map analyze (operands exp))))
(lambda (env)
(execute-application (fproc env)
(map (lambda (aproc) (aproc env))
aprocs)))))
(define execute-application
(make-generic-operator 2
(lambda (proc args)
(error "Unknown procedure type" proc))))
(defhandler execute-application
apply-primitive-procedure
strict-primitive-procedure?)
(defhandler execute-application
(lambda (proc args)
((procedure-body proc)
(extend-environment
(procedure-parameters proc)
args
(procedure-environment proc))))
compound-procedure?)
(define (analyze-sequence exps)
(define (sequentially proc1 proc2)
(lambda (env) (proc1 env) (proc2 env)))
(define (loop first-proc rest-procs)
(if (null? rest-procs)
first-proc
(loop (sequentially first-proc (car rest-procs))
(cdr rest-procs))))
(if (null? exps) (error "Empty sequence"))
(let ((procs (map analyze exps)))
(loop (car procs) (cdr procs))))
(defhandler analyze
(lambda (exp)
(analyze-sequence (begin-actions exp)))
begin?)
(define (analyze-assignment exp)
(let ((var (assignment-variable exp))
(vproc (analyze (assignment-value exp))))
(lambda (env)
(set-variable-value! var (vproc env) env)
'ok)))
(defhandler analyze analyze-assignment assignment?)
(define (analyze-definition exp)
(let ((var (definition-variable exp))
(vproc (analyze (definition-value exp))))
(lambda (env)
(define-variable! var (vproc env) env)
'ok)))
(defhandler analyze analyze-definition definition?)
;;; Macros (definitions are in syntax.scm)
(defhandler analyze (compose analyze cond->if) cond?)
(defhandler analyze (compose analyze let->combination) let?)
|
