-
Notifications
You must be signed in to change notification settings - Fork 0
/
hw5.rkt
162 lines (132 loc) · 5.94 KB
/
hw5.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
#lang racket
(provide (all-defined-out)) ;; so we can put tests in a second file
;; definition of structures for MUPL programs - Do NOT change
(struct var (string) #:transparent) ;; a variable, e.g., (var "foo")
(struct int (num) #:transparent) ;; a constant number, e.g., (int 17)
(struct add (e1 e2) #:transparent) ;; add two expressions
(struct ifgreater (e1 e2 e3 e4) #:transparent) ;; if e1 > e2 then e3 else e4
(struct fun (nameopt formal body) #:transparent) ;; a recursive(?) 1-argument function
(struct call (funexp actual) #:transparent) ;; function call
(struct mlet (var e body) #:transparent) ;; a local binding (let var = e in body)
(struct apair (e1 e2) #:transparent) ;; make a new pair
(struct fst (e) #:transparent) ;; get first part of a pair
(struct snd (e) #:transparent) ;; get second part of a pair
(struct aunit () #:transparent) ;; unit value -- good for ending a list
(struct isaunit (e) #:transparent) ;; evaluate to 1 if e is unit else 0
;; a closure is not in "source" programs; it is what functions evaluate to
(struct closure (env fun) #:transparent)
;; Problem 1
(define (racketlist->mupllist xs)
(if (null? xs)
(aunit)
(apair (car xs) (racketlist->mupllist (cdr xs))
)))
(define (mupllist->racketlist xs)
(if (aunit? xs)
null
(cons (apair-e1 xs) (mupllist->racketlist (apair-e2 xs)))
))
;; Problem 2
;; lookup a variable in an environment
;; Do NOT change this function
(define (envlookup env str)
(cond [(null? env) (error "unbound variable during evaluation" str env)]
[(equal? (car (car env)) str) (cdr (car env))]
[#t (envlookup (cdr env) str)]))
;; Do NOT change the two cases given to you.
;; DO add more cases for other kinds of MUPL expressions.
;; We will test eval-under-env by calling it directly even though
;; "in real life" it would be a helper function of eval-exp.
(define (eval-under-env e env)
(cond [(var? e)
(envlookup env (var-string e))]
[(add? e)
(let ([v1 (eval-under-env (add-e1 e) env)]
[v2 (eval-under-env (add-e2 e) env)])
(if (and (int? v1)
(int? v2))
(int (+ (int-num v1)
(int-num v2)))
(error "MUPL addition applied to non-number")))]
;; CHANGE add more cases here
[(int? e) e]
[(ifgreater? e)
(let ([v1 (eval-under-env (ifgreater-e1 e) env)]
[v2 (eval-under-env (ifgreater-e2 e) env)])
(if (and (int? v1)
(int? v2))
(if (> (int-num v1) (int-num v2))
(eval-under-env (ifgreater-e3 e) env)
(eval-under-env (ifgreater-e4 e) env))
(error "ifgreater applied to nom-number")))]
[(fst? e)
(let ([pr (eval-under-env (fst-e e) env)])
(if (apair? pr)
(eval-under-env (apair-e1 pr) env)
(error "FST applied to non-pair" e pr)))]
[(snd? e)
(let ([pr (eval-under-env (snd-e e) env)])
(if (apair? pr)
(eval-under-env (apair-e2 pr) env)
(error "SND applied to non-pair" e pr)))]
;;[(snd? e) (cond [(apair? (snd-e e)) (eval-under-env (apair-e2 (snd-e e)) env)]
;; [#t (error "SND applied to non-pair")])]
[(aunit? e) e]
[(apair? e) (apair (eval-under-env (apair-e1 e) env) (eval-under-env (apair-e2 e) env))]
[(isaunit? e)
(if (aunit? (eval-under-env (isaunit-e e) env))
(int 1)
(int 0))]
[(mlet? e)
(let ([val (eval-under-env (mlet-e e) env)])
(eval-under-env (mlet-body e) (cons (cons (mlet-var e) val) env)))]
[(closure? e) e]
[(call? e)
(let ([mclosure (eval-under-env (call-funexp e) env)]
[arg (eval-under-env (call-actual e) env)])
(if (closure? mclosure)
(let* ([mfun (closure-fun mclosure)]
[mclosure-env (closure-env mclosure)]
[body (fun-body mfun)]
[forma (fun-formal mfun)])
(if (string? (fun-nameopt mfun))
(eval-under-env (mlet forma arg (mlet (fun-nameopt mfun) mclosure body)) mclosure-env)
(eval-under-env (mlet forma arg body) mclosure-env)))
(error "vall applied to non-closour")))]
[(fun? e) (closure env e)]
[#t (error (format "bad MUPL expression: ~v" e))]))
;; Do NOT change
(define (eval-exp e)
(eval-under-env e null))
;; Problem 3
(define (ifaunit e1 e2 e3) (ifgreater (isaunit e1) (int 0) e2 e3))
(define (mlet* lstlst e2)
(if (null? lstlst)
e2
(mlet (car (car lstlst)) (cdr (car lstlst)) (mlet* (cdr lstlst) e2))))
(define (ifeq e1 e2 e3 e4)
(let ([v1 (var "_x")]
[v2 (var "_y")])
(mlet "_x" e1 (mlet "_y" e2
(ifgreater (add (ifgreater v1 v2 (int 1) (int 0)) (ifgreater v2 v1 (int 1) (int 0))) (int 0) e4 e3)))))
;; Problem 4
(define mupl-map
(fun #f "f"
(fun "mfun" "xs"
(ifaunit (var "xs") (aunit) (apair (call (var "f") (fst (var "xs"))) (call (var "mfun") (snd (var "xs")) )))) ))
(define mupl-mapAddN
(mlet "map" mupl-map
(fun #f "add" (call (var "map") (fun #f "x" (add (var "x") (var "add")))))
))
;; Challenge Problem
(struct fun-challenge (nameopt formal body freevars) #:transparent) ;; a recursive(?) 1-argument function
;; We will test this function directly, so it must do
;; as described in the assignment
;;(define (compute-free-vars e) "CHANGE")
;; Do NOT share code with eval-under-env because that will make
;; auto-grading and peer assessment more difficult, so
;; copy most of your interpreter here and make minor changes
;;(define (eval-under-env-c e env) "CHANGE")
;; Do NOT change this
;;(define (eval-exp-c e)
;; (eval-under-env-c (compute-free-vars e) null))