-
Notifications
You must be signed in to change notification settings - Fork 0
/
LETEXT.rkt
197 lines (178 loc) · 6.57 KB
/
LETEXT.rkt
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
; LETEXT: Extended LET according to exercises
#lang racket
(require (lib "eopl.ss" "eopl"))
(define empty-env
(lambda () (list 'empty-env)))
(define extend-env
(lambda (var val env) (list 'extend-env var val env)))
(define apply-env
(lambda (env search-var)
(cond
((eqv? (car env) 'empty-env)
(eopl:error 'apply-env "No binding for ~s" search-var))
((eqv? (car env) 'extend-env)
(if (eqv? (cadr env) search-var)
(caddr env)
(apply-env (cadddr env) search-var)))
(else
(eopl:error 'apply-env "Bad environment: ~s" env)))))
(define scanner-spec
'((white-sp (whitespace) skip)
(comment ("%" (arbno (not #\newline))) skip)
(identifier (letter (arbno (or letter digit))) symbol)
(number (digit (arbno digit)) number)))
(define parser-spec
'((program (expression) a-program)
(expression (number) const-exp)
(expression ("minus" "(" expression ")") minus-exp)
(expression ("+" "(" expression expression ")") add-exp)
(expression ("-" "(" expression expression ")") diff-exp)
(expression ("*" "(" expression expression ")") mul-exp)
(expression ("/" "(" expression expression ")") div-exp)
(expression ("equal?" "(" expression expression ")") eq-exp)
(expression ("greater?" "(" expression expression ")") gt-exp)
(expression ("less?" "(" expression expression ")") lt-exp)
(expression ("zero?" "(" expression ")") zero-exp)
(expression ("cons" "(" expression expression ")") cons-exp)
(expression ("car" "(" expression ")") car-exp)
(expression ("cdr" "(" expression ")") cdr-exp)
(expression ("null?" "(" expression ")") null-exp)
(expression ("emptylist") empty-exp)
(expression ("if" expression "then" expression "else" expression) if-exp)
(expression ("cond" (arbno expression "==>" expression) "end") cond-exp)
(expression (identifier) var-exp)
(expression ("let" (arbno identifier "=" expression) "in" expression) let-exp)
(expression ("let*" (arbno identifier "=" expression) "in" expression) let*-exp)
(expression ("unpack" (arbno identifier) "=" expression "in" expression) unpack-exp)))
(sllgen:make-define-datatypes scanner-spec parser-spec)
(define scan&parse
(sllgen:make-string-parser scanner-spec parser-spec))
(define-datatype expval expval?
(num-val
(num number?))
(bool-val
(bool boolean?))
(list-val
(lis list?)))
(define expval->num
(lambda (val)
(cases expval val
(num-val (num)
num)
(else
(eopl:error 'expval->num "Bad conversion: ~s" val)))))
(define expval->bool
(lambda (val)
(cases expval val
(bool-val (bool)
bool)
(else
(eopl:error 'expval->bool "Bad conversion: ~s" val)))))
(define expval->list
(lambda (val)
(cases expval val
(list-val (lis)
lis)
(else
(eopl:error 'expval->list "Bad conversion: ~s" val)))))
(define init-env
(lambda ()
(extend-env 'i (num-val 1)
(extend-env 'v (num-val 5)
(extend-env 'x (num-val 10)
(empty-env))))))
(define let-new-env
(lambda (var exp env new-env)
(if (null? var)
new-env
(let-new-env (cdr var) (cdr exp) env
(extend-env (car var) (value-of (car exp) env) new-env)))))
(define unpack-new-env
(lambda (var val env)
(if (null? var)
(if (not (null? (expval->list val)))
(eopl:error 'unpack-exp "Numbers don't match")
env)
(unpack-new-env (cdr var) (list-val (cdr (expval->list val)))
(extend-env (car var) (car (expval->list val)) env)))))
(define value-of
(lambda (exp env)
(cases expression exp
(const-exp (num)
(num-val num))
(minus-exp (exp)
(num-val (- (expval->num (value-of exp env)))))
(add-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(num-val (+ num1 num2))))
(diff-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(num-val (- num1 num2))))
(mul-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(num-val (* num1 num2))))
(div-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(num-val (/ num1 num2))))
(eq-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(bool-val (= num1 num2))))
(gt-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(bool-val (> num1 num2))))
(lt-exp (exp1 exp2)
(let ([num1 (expval->num (value-of exp1 env))]
[num2 (expval->num (value-of exp2 env))])
(bool-val (< num1 num2))))
(zero-exp (exp)
(if (zero? (expval->num (value-of exp env)))
(bool-val #t)
(bool-val #f)))
(cons-exp (exp1 exp2)
(let ([val1 (value-of exp1 env)]
[val2 (value-of exp2 env)])
(list-val (cons val1 (expval->list val2)))))
(car-exp (exp)
(car (expval->list (value-of exp env))))
(cdr-exp (exp)
(cdr (expval->list (value-of exp env))))
(null-exp (exp)
(bool-val (null? (expval->list (value-of exp env)))))
(empty-exp ()
(list-val '()))
(if-exp (exp1 exp2 exp3)
(if (expval->bool (value-of exp1 env))
(value-of exp2 env)
(value-of exp3 env)))
(cond-exp (lis1 lis2)
(if (null? lis1)
(eopl:error 'cond-exp "No true value in cond-exp")
(if (expval->bool (value-of (car lis1) env))
(value-of (car lis2) env)
(value-of (cond-exp (cdr lis1) (cdr lis2)) env))))
(var-exp (var)
(apply-env env var))
(let-exp (var exp1 exp2)
(value-of exp2 (let-new-env var exp1 env env)))
(let*-exp (var exp1 exp2)
(if (null? var)
(value-of exp2 env)
(value-of (let*-exp (cdr var) (cdr exp1) exp2)
(extend-env (car var) (value-of (car exp1) env) env))))
(unpack-exp (var exp1 exp2)
(value-of exp2 (unpack-new-env var (value-of exp1 env) env))))))
(define value-of-program
(lambda (pgm)
(cases program pgm
(a-program (exp)
(value-of exp (init-env))))))
(define run
(lambda (str)
(value-of-program (scan&parse str))))
(run "let u = 7 in unpack x y = cons (u cons (3 emptylist)) in - (x y)")