summaryrefslogtreecommitdiff
path: root/main.scm
diff options
context:
space:
mode:
Diffstat (limited to 'main.scm')
-rw-r--r--main.scm92
1 files changed, 87 insertions, 5 deletions
diff --git a/main.scm b/main.scm
index 8db3289..7476efb 100644
--- a/main.scm
+++ b/main.scm
@@ -44,7 +44,7 @@
44 [(cond-else? (car clauses)) (cond-consequent (car clauses))] 44 [(cond-else? (car clauses)) (cond-consequent (car clauses))]
45 [(last-clause? clauses) (make-if (cond-predicate (car clauses)) 45 [(last-clause? clauses) (make-if (cond-predicate (car clauses))
46 (cond-consequent (car clauses)) 46 (cond-consequent (car clauses))
47 '())] 47 'false)]
48 [else (make-if (cond-predicate (car clauses)) 48 [else (make-if (cond-predicate (car clauses))
49 (cond-consequent (car clauses)) 49 (cond-consequent (car clauses))
50 (cond->if (make-cond (cdr clauses))))]))) 50 (cond->if (make-cond (cdr clauses))))])))
@@ -64,16 +64,56 @@
64 64
65;;; assignment 65;;; assignment
66(define (assignment? expr) (tagged? expr 'set!)) 66(define (assignment? expr) (tagged? expr 'set!))
67(define (assignment-name expr) (cadr expr))
68(define (assignment-value expr) (caddr expr))
69
70;;; definition
71(define (definition? expr) (tagged? expr 'define))
72(define (definition-name expr) (cadr expr))
73(define (definition-value expr) (caddr expr))
74
75;;; lambda
76(define (lambda-form? expr) (tagged? expr 'lambda))
77(define (lambda-params expr) (cadr expr))
78(define (lambda-body expr) (cddr expr))
79(define (make-lambda params body) (cons 'lambda (cons params body)))
80
81;;; begin
82(define (begin-form? expr) (tagged? expr 'begin))
83(define (begin-actions begin-form) (cdr begin-form))
84(define (last-action? actions) (null? (cdr actions)))
85(define (make-begin actions) (cons 'begin actions))
86(define (sequence->expr actions)
87 (cond
88 [(null? actions) '()]
89 [(last-action? actions) (car actions)]
90 [else (make-begin actions)]))
91
92;;; let
93(define (let-form? expr) (tagged? expr 'let))
94(define (let-bindings expr) (cadr expr))
95(define (let-body expr) (cddr expr))
96(define (let-binding-variables bindings) (map car bindings))
97(define (let-binding-values bindings) (map cadr bindings))
98(define (let->lambda expr)
99 (let ([bindings (let-bindings expr)])
100 (make-lambda (let-binding-variables bindings)
101 (let-body expr))))
67 102
68(define (eval-expr expr env) 103(define (eval-expr expr env)
69 (cond 104 (cond
70 [(self-evaluating? expr) expr] 105 [(self-evaluating? expr) expr]
106 [(variable? expr) (lookup-variable-value expr env)]
71 [(if-else? expr) (eval-if expr env)] 107 [(if-else? expr) (eval-if expr env)]
108 [(begin-form? expr) (eval-sequence (begin-actions expr) env)]
109 [(lambda-form? expr) (make-lambda (lambda-params expr)
110 (lambda-body expr))]
111 [(let-form? expr) (eval-let expr env)]
112 [(assignment? expr) (eval-assignment expr env)]
113 [(definition? expr) (eval-definition expr env)]
72 [(cond-form? expr) (eval-cond expr env)] 114 [(cond-form? expr) (eval-cond expr env)]
73 [(quote-form? expr) (quotation-text expr)] 115 [(quote-form? expr) (quotation-text expr)]
74 [(function-application? expr) 116 [(function-application? expr) (eval-function-application expr env)]))
75 (apply-expr (operator expr)
76 (list-of-values (operands expr) env))]))
77 117
78(define (eval-if expr env) 118(define (eval-if expr env)
79 (if (true? (eval-expr (if-predicate expr) env)) 119 (if (true? (eval-expr (if-predicate expr) env))
@@ -83,6 +123,43 @@
83(define (eval-cond expr env) 123(define (eval-cond expr env)
84 (eval-expr (cond->if expr) env)) 124 (eval-expr (cond->if expr) env))
85 125
126(define (eval-sequence exprs env)
127 (cond
128 [(last-action? exprs) (eval-expr (car exprs) env)]
129 [else (begin
130 (eval-expr (car exprs) env)
131 (eval-sequence (cdr exprs) env))]))
132
133(define (eval-let expr env)
134 (eval-function-application (cons (let->lambda expr)
135 (let-binding-values (let-bindings expr)))
136 env))
137
138(define (eval-assignment expr env)
139 (set-variable-value!
140 (assignment-name expr)
141 (eval-expr (assignment-value expr) env)
142 env))
143
144(define (eval-definition expr env)
145 (define-variable!
146 (definition-name expr)
147 (eval-expr (definition-value expr) env)
148 env))
149
150(define (eval-function-application expr env)
151 (let ([proc (operator expr)]
152 [args (list-of-values (operands expr) env)])
153 (cond
154 [(primitive? proc) (apply-primitive-proc proc args)]
155 [else
156 (let ([compound-proc (eval-expr proc env)])
157 (eval-sequence
158 (lambda-body compound-proc)
159 (extend-env (lambda-params compound-proc)
160 args
161 env)))])))
162
86(define (primitive? proc) 163(define (primitive? proc)
87 (is-elem-assoc-list proc primitives)) 164 (is-elem-assoc-list proc primitives))
88 165
@@ -113,4 +190,9 @@
113 (driver-loop)))))) 190 (driver-loop))))))
114 191
115(define (show-lisp-expr object) 192(define (show-lisp-expr object)
116 (display object)) 193 (cond
194 [(tagged? object 'lambda)
195 (display "#<procedure ")
196 (display (lambda-params object))
197 (display ">")]
198 [else (display object)]))