Skip to content

Commit 0707dac

Browse files
dvanhorndvanhorn
committed
Merge branch 'main' of github.com:cmsc430/www
2 parents 2f06214 + bdb8cc8 commit 0707dac

3 files changed

Lines changed: 121 additions & 9 deletions

File tree

‎langs/iniquity-plus/ast.rkt‎

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,3 +62,112 @@
6262
(struct Var (x) #:prefab)
6363
(struct App (f es) #:prefab)
6464
(struct Apply (f es e) #:prefab)
65+
66+
;; Prog -> Void
67+
(define (check-syntax p)
68+
(match p
69+
[(Prog ds e)
70+
(let ((dr (defined-ids ds)))
71+
(check-syntax-unique-defines ds)
72+
(check-syntax-defines ds dr)
73+
(check-syntax-e e dr '()))]))
74+
75+
;; [Listof Defn] -> [Listof Id]
76+
(define (defined-ids ds)
77+
(map (λ (d) (match d [(Defn f _) f]))
78+
ds))
79+
80+
;; [Listof Defn] -> Void
81+
(define (check-syntax-unique-defines ds)
82+
(unless (= (length ds)
83+
(length (remove-duplicates ds #:key Defn-f)))
84+
(error "duplicate definition for function")))
85+
86+
;; [Listof Defn] [Listof Id] -> Void
87+
(define (check-syntax-defines ds r)
88+
(for-each (λ (d) (check-syntax-define d r)) ds))
89+
90+
;; Defn [Listof Id] -> Void
91+
(define (check-syntax-define d dr)
92+
(match d
93+
[(Defn f (FunPlain xs e))
94+
(check-unique (cons f xs))
95+
(check-syntax-e e dr xs)]
96+
[(Defn f (FunRest xs x e))
97+
(check-unique (cons f (cons x xs)))
98+
(check-syntax-e e dr (cons x xs))]
99+
[(Defn f (FunCase '()))
100+
(void)]
101+
[(Defn f (FunCase (cons c cs)))
102+
(check-syntax-define (Defn f c) dr)
103+
(check-syntax-define (Defn f (FunCase cs)) dr)]))
104+
105+
;; [Listof Id] -> Void
106+
(define (check-unique xs)
107+
(unless (= (length xs) (length (remove-duplicates xs)))
108+
(error "duplicate identifier")))
109+
110+
;; Expr [Listof Id] [Listof Id] -> Void
111+
(define (check-syntax-e e dr r)
112+
(match e
113+
[(Eof) (void)]
114+
[(Empty) (void)]
115+
[(Int i) (void)]
116+
[(Bool b) (void)]
117+
[(Char c) (void)]
118+
[(Str s) (void)]
119+
[(Prim0 p) (void)]
120+
[(Prim1 p e) (check-syntax-e e dr r)]
121+
[(Prim2 p e1 e2)
122+
(check-syntax-e e1 dr r)
123+
(check-syntax-e e2 dr r)]
124+
[(Prim3 p e1 e2 e3)
125+
(check-syntax-e e1 dr r)
126+
(check-syntax-e e2 dr r)
127+
(check-syntax-e e3 dr r)]
128+
[(If e1 e2 e3)
129+
(check-syntax-e e1 dr r)
130+
(check-syntax-e e2 dr r)
131+
(check-syntax-e e3 dr r)]
132+
[(Begin e1 e2)
133+
(check-syntax-e e1 dr r)
134+
(check-syntax-e e2 dr r)]
135+
[(Let x e1 e2)
136+
(check-syntax-e e1 dr r)
137+
(check-syntax-e e2 dr (cons x r))]
138+
[(Var x)
139+
(unless (member x r)
140+
(error "unbound variable"))]
141+
[(App f es)
142+
(unless (member f dr)
143+
(error "undefined function"))
144+
(for-each (λ (e) (check-syntax-e e dr r)) es)]
145+
[(Apply f es e)
146+
(unless (member f dr)
147+
(error "undefined function"))
148+
(check-syntax-e e dr r)
149+
(for-each (λ (e) (check-syntax-e e dr r)) es)]))
150+
151+
(module+ test
152+
(require rackunit)
153+
(check-exn exn:fail? (λ () (check-syntax-e (Var 'x) '() '())))
154+
(check-exn exn:fail? (λ () (check-syntax-e (Var 'x) '(x) '())))
155+
(check-not-exn (λ () (check-syntax-e (Var 'x) '() '(x))))
156+
(check-not-exn (λ () (check-syntax-e (Let 'x (Int 1) (Var 'x)) '() '())))
157+
(check-not-exn (λ () (check-syntax-e (Let 'x (Int 1) (Let 'y (Int 2) (Var 'x))) '() '())))
158+
(check-not-exn (λ () (check-syntax-e (Let 'x (Int 1) (Let 'x (Int 2) (Var 'x))) '() '())))
159+
(check-not-exn (λ () (check-syntax-e (Let 'x (Int 1) (Let 'y (Int 2) (Var 'y))) '() '())))
160+
(check-exn exn:fail? (λ () (check-syntax (Prog (list (Defn 'f (FunPlain '() (Int 1)))) (Var 'f)))))
161+
(check-exn exn:fail? (λ () (check-syntax (Prog (list (Defn 'f (FunPlain '(f) (Int 1)))) (Int 1)))))
162+
(check-exn exn:fail? (λ () (check-syntax (Prog (list (Defn 'f (FunRest '(f) 'x (Int 1)))) (Int 1)))))
163+
(check-exn exn:fail? (λ () (check-syntax (Prog (list (Defn 'f (FunRest '() 'f (Int 1)))) (Int 1)))))
164+
(check-exn exn:fail? (λ () (check-syntax (Prog (list (Defn 'f (FunPlain '(x x) (Int 1)))) (Int 1)))))
165+
(check-exn exn:fail?
166+
(λ () (check-syntax
167+
(Prog (list (Defn 'f (FunPlain '(x) (Int 1)))
168+
(Defn 'f (FunPlain '(y) (Int 2))))
169+
(Int 1)))))
170+
(check-exn exn:fail? (λ () (check-syntax (Prog '() (App 'f '())))))
171+
(check-exn exn:fail? (λ () (check-syntax (Prog '() (Apply 'f '() (Int 1))))))
172+
(check-not-exn (λ () (check-syntax (Prog (list (Defn 'f (FunPlain '() (Int 1)))) (App 'f '())))))
173+
(check-not-exn (λ () (check-syntax (Prog (list (Defn 'f (FunPlain '() (Int 1)))) (Apply 'f '() (Int 1)))))))

‎langs/iniquity-plus/interp.rkt‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,9 @@
2121
;; type REnv = (Listof (List Id Value))
2222
;; type Defns = (Listof Defn)
2323

24-
;; Prog Defns -> Answer
24+
;; Prog -> Answer
2525
(define (interp p)
26+
(check-syntax p)
2627
(match p
2728
[(Prog ds e)
2829
(interp-env e '() ds)]))
@@ -105,11 +106,11 @@
105106
; check arity is acceptable
106107
(if (< (length vs) (length xs))
107108
'err
108-
(interp-env e
109-
(zip (cons x xs)
110-
(cons (drop vs (length xs))
111-
(take vs (length xs))))
112-
ds))]
109+
(interp-env e
110+
(zip (cons x xs)
111+
(cons (drop vs (length xs))
112+
(take vs (length xs))))
113+
ds))]
113114
[(FunCase cs)
114115
(match (select-case-lambda cs (length vs))
115116
['err 'err]
@@ -135,7 +136,9 @@
135136
[(cons e es)
136137
(match (interp-env e r ds)
137138
['err 'err]
138-
[v (cons v (interp-env* es r ds))])]))
139+
[v (match (interp-env* es r ds)
140+
['err 'err]
141+
[vs (cons v vs)])])]))
139142

140143
;; Defns Symbol -> Defn
141144
(define (defns-lookup ds f)

‎www/Makefile‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,10 +12,10 @@ $(course): scribble zips
1212
zips:
1313
mkdir -p $(course)/code/
1414
cd ../langs ; \
15-
tar -c `git ls-files intro a86 abscond blackmail con dupe dodger evildoer extort fraud hustle hoax iniquity jig knock loot mug mountebank neerdowell fp project.pdf` \
15+
tar -c `git ls-files intro a86 abscond blackmail con dupe dodger evildoer extort fraud hustle hoax iniquity iniquity-plus jig knock loot mug mountebank neerdowell fp project.pdf` \
1616
a86/main.c a86/gcd.c a86/tri.s abscond/42.s | \
1717
(cd ../www/main/code ; tar -x ; \
18-
for f in abscond blackmail con dupe dodger evildoer extort fraud hustle hoax iniquity jig knock loot mug mountebank ; do \
18+
for f in abscond blackmail con dupe dodger evildoer extort fraud hustle hoax iniquity iniquity-plus jig knock loot mug mountebank ; do \
1919
zip $${f}.zip -r $${f}/ ; \
2020
done )
2121
cd slides ; \

0 commit comments

Comments
 (0)