diff options
Diffstat (limited to 'main.scm')
-rw-r--r-- | main.scm | 92 |
1 files changed, 87 insertions, 5 deletions
@@ -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)])) | ||