Skip to content

Commit b1afe0d

Browse files
dvanhorndvanhorn
authored
Merge pull request #17 from cmsc430/crook
crook
2 parents a18f2b2 + ae3e426 commit b1afe0d

File tree

6 files changed

+33
-163
lines changed

6 files changed

+33
-163
lines changed

‎iniquity-plus/compile.rkt‎

Lines changed: 4 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,8 @@
5151
(match fun
5252
[(FunPlain xs e)
5353
(seq (Label (symbol->label f))
54-
;; TODO: check arity
54+
(Cmp r8 (length xs))
55+
(Jne 'err)
5556
(compile-e e (reverse xs))
5657
(Add rsp (* 8 (length xs)))
5758
(Ret))]
@@ -74,9 +75,7 @@
7475
[(If e1 e2 e3) (compile-if e1 e2 e3 c)]
7576
[(Begin e1 e2) (compile-begin e1 e2 c)]
7677
[(Let x e1 e2) (compile-let x e1 e2 c)]
77-
[(App f es) (compile-app f es c)]
78-
[(Apply f es e)
79-
(compile-apply f es e c)]))
78+
[(App f es) (compile-app f es c)]))
8079

8180
;; Datum -> Asm
8281
(define (compile-datum d)
@@ -168,15 +167,10 @@
168167
(seq (Lea rax r)
169168
(Push rax)
170169
(compile-es es (cons #f c))
171-
;; TODO: communicate argument count to called function
170+
(Mov r8 (length es)) ; pass arity info
172171
(Jmp (symbol->label f))
173172
(Label r))))
174173

175-
;; Id [Listof Expr] Expr CEnv -> Asm
176-
(define (compile-apply f es e c)
177-
;; TODO: implement apply
178-
(seq))
179-
180174
;; [Listof Expr] CEnv -> Asm
181175
(define (compile-es es c)
182176
(match es

‎iniquity-plus/interp.rkt‎

Lines changed: 12 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -61,15 +61,7 @@
6161
(let ((vs (interp-e* es r ds)))
6262
(match (defns-lookup ds f)
6363
[(Defn _ fun)
64-
(apply-fun fun vs ds)]))]
65-
[(Apply f es e)
66-
(let ((vs (interp-e* es r ds))
67-
(ws (interp-e e r ds)))
68-
(if (list? ws)
69-
(match (defns-lookup ds f)
70-
[(Defn _ fun)
71-
(apply-fun fun (append vs ws) ds)])
72-
(raise 'err)))]))
64+
(apply-fun fun vs ds)]))]))
7365

7466
;; (Listof Expr) REnv Defns -> (Listof Value) { raises 'err }
7567
(define (interp-e* es r ds)
@@ -79,32 +71,30 @@
7971
(cons (interp-e e r ds)
8072
(interp-e* es r ds))]))
8173

82-
;; Fun [Listof Values] Defns -> Answer
74+
;; Fun [Listof Values] Defns -> Value { raises 'err }
8375
(define (apply-fun f vs ds)
8476
(match f
8577
[(FunPlain xs e)
8678
; check arity matches-arity-exactly?
8779
(if (= (length xs) (length vs))
8880
(interp-e e (zip xs vs) ds)
89-
'err)]
81+
(raise 'err))]
9082
[(FunRest xs x e)
9183
; check arity is acceptable
9284
(if (< (length vs) (length xs))
93-
'err
94-
(interp-e e
95-
(zip (cons x xs)
96-
(cons (drop vs (length xs))
97-
(take vs (length xs))))
98-
ds))]
85+
(raise 'err)
86+
(interp-e e
87+
(zip (cons x xs)
88+
(cons (drop vs (length xs))
89+
(take vs (length xs))))
90+
ds))]
9991
[(FunCase cs)
100-
(match (select-case-lambda cs (length vs))
101-
['err 'err]
102-
[f (apply-fun f vs ds)])]))
92+
(apply-fun (select-case-lambda cs (length vs)) vs ds)]))
10393

104-
;; [Listof FunCaseClause] Nat -> Fun | 'err
94+
;; [Listof FunCaseClause] Nat -> Fun { raises 'err }
10595
(define (select-case-lambda cs n)
10696
(match cs
107-
['() 'err]
97+
['() (raise 'err)]
10898
[(cons (and (FunPlain xs e) f) cs)
10999
(if (= (length xs) n)
110100
f

‎iniquity-plus/parse.rkt‎

Lines changed: 0 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -150,10 +150,6 @@
150150
[(list ys gs e2)
151151
(list ys gs (Let x e1 e2))])])]
152152
[_ (error "let: bad syntax" s)])]
153-
['apply
154-
(match sr
155-
[(list-rest (? symbol? f) sr)
156-
(parse-apply/acc sr f fs xs ys (if (memq f fs) gs (cons f gs)))])]
157153
[_
158154
(match (parse-es/acc sr fs xs ys gs)
159155
[(list ys gs es)
@@ -180,20 +176,6 @@
180176
(error "parse error" s)]))
181177
(rec s xs ys gs))
182178

183-
;; S-Expr Id [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Id] Apply)
184-
(define (parse-apply/acc s f fs xs ys gs)
185-
(match s
186-
[(list s)
187-
(match (parse-e/acc s fs xs ys gs)
188-
[(list ys gs e)
189-
(list ys gs (Apply f '() e))])]
190-
[(cons s sr)
191-
(match (parse-e/acc s fs xs ys gs)
192-
[(list ys gs e)
193-
(match (parse-apply/acc sr f fs xs ys gs)
194-
[(list ys gs (Apply f es e0))
195-
(list ys gs (Apply f (cons e es) e0))])])]))
196-
197179
;; S-Expr [Listof Id] [Listof Id] [Listof Id] [Listof Id] -> (list [Listof Id] [Listof Id] [Listof Expr])
198180
;; s: list of expressions shaped s-expr to be parsed
199181
;; fs: defined function names

‎iniquity-plus/test/test-runner.rkt‎

Lines changed: 7 additions & 113 deletions
Original file line numberDiff line numberDiff line change
@@ -201,6 +201,12 @@
201201
'(2 3 4))
202202
(check-equal? (run '(define (f x y) y)
203203
'(f 1 (add1 #f)))
204+
'err)
205+
(check-equal? (run '(define (f x y) y)
206+
'(f 1))
207+
'err)
208+
(check-equal? (run '(define (f x y) y)
209+
'(f 1 2 3))
204210
'err))
205211

206212
(begin ;; Iniquity+
@@ -280,36 +286,6 @@
280286
(cons (f 1 2 3)
281287
'()))))
282288
'(() 2 (3)))
283-
284-
(check-equal? (run '(define (f) 1)
285-
'(apply f '()))
286-
1)
287-
(check-equal? (run '(define (f . xs) 1)
288-
'(apply f '()))
289-
1)
290-
(check-equal? (run '(define (f . xs) xs)
291-
'(apply f '()))
292-
'())
293-
(check-equal? (run '(define (f . xs) xs)
294-
'(apply f (cons 1 (cons 2 (cons 3 '())))))
295-
'(1 2 3))
296-
(check-equal? (run '(define (f . xs) xs)
297-
'(apply f 1 2 (cons 3 '())))
298-
'(1 2 3))
299-
(check-equal? (run '(define (append . xss)
300-
(if (empty? xss)
301-
'()
302-
(if (empty? (car xss))
303-
(apply append (cdr xss))
304-
(cons (car (car xss))
305-
(apply append (cdr (car xss)) (cdr xss))))))
306-
'(define (list . xs) xs)
307-
'(define (flatten xs)
308-
(apply append xs))
309-
'(flatten (list (append) (append (list 1 2 3) (list 4 5) (list 6)) (list 7))))
310-
'(1 2 3 4 5 6 7))
311-
312-
;; Extra tests
313289
(check-equal? (run '(define f (case-lambda))
314290
'(if #f (f) 1))
315291
1)
@@ -321,67 +297,6 @@
321297
'(let ((x (f 1 2 3)))
322298
(f x)))
323299
'())
324-
(check-equal? (run '(define (f x . xs)
325-
(let ((ys xs))
326-
(if (empty? xs)
327-
x
328-
(apply f ys))))
329-
'(let ((z 1))
330-
(f 1 2 3)))
331-
3)
332-
(check-equal? (run '(define (f x . xs)
333-
(let ((ys xs))
334-
(if (empty? xs)
335-
x
336-
(apply f ys))))
337-
'(let ((z 1))
338-
(f (f 1 2 3))))
339-
3)
340-
(check-equal? (run '(define f
341-
(case-lambda
342-
[(x . xs)
343-
(let ((ys xs))
344-
(if (empty? xs)
345-
x
346-
(apply f xs)))]))
347-
'(let ((z 1))
348-
(f (f 1 2 3))))
349-
3)
350-
(check-equal? (run '(define f
351-
(case-lambda
352-
[(x) x]
353-
[(x . xs)
354-
(apply f xs)]))
355-
'(f 1 2 3))
356-
3)
357-
(check-equal? (run '(define f
358-
(case-lambda
359-
[(x) x]
360-
[(x . xs)
361-
(apply f xs)]))
362-
'(f))
363-
'err)
364-
(check-equal? (run '(define f
365-
(case-lambda
366-
[(x y) x]
367-
[(x y . xs)
368-
(apply f xs)]))
369-
'(f 1 2 3))
370-
'err)
371-
(check-equal? (run '(define f
372-
(case-lambda
373-
[(x y) x]
374-
[(x y . xs)
375-
(apply f xs)]))
376-
'(f 1 2 (cons 3 (cons 4 '()))))
377-
'err)
378-
(check-equal? (run '(define f
379-
(case-lambda
380-
[(x) (char->integer (car x))]
381-
[(x y . xs)
382-
(apply f xs)]))
383-
'(f 1 2 (cons #\A 4)))
384-
65)
385300
(check-equal? (run '(define f
386301
(case-lambda
387302
[(x y) x]
@@ -390,28 +305,7 @@
390305
[(x y z . xs)
391306
(char->integer z)]))
392307
'(f 1 #\a 3))
393-
97)
394-
(check-equal? (run '(define plus
395-
(case-lambda
396-
[() 0]
397-
[(n . ns) (+ n (apply plus ns))]))
398-
'(define (cars xss)
399-
(if (empty? xss)
400-
'()
401-
(cons (car (car xss)) (cars (cdr xss)))))
402-
'(define (cdrs xss)
403-
(if (empty? xss)
404-
'()
405-
(cons (cdr (car xss)) (cdrs (cdr xss)))))
406-
'(define (mapplus ns . nss)
407-
(if (cons? ns)
408-
(cons (apply plus (car ns) (cars nss))
409-
(apply mapplus (cdr ns) (cdrs nss)))
410-
'()))
411-
'(mapplus (cons 1 (cons 2 '()))
412-
(cons 3 (cons 4 '()))
413-
(cons 5 (cons 6 '()))))
414-
'(9 12))))
308+
97)))
415309

416310
(define (test/io run)
417311
(begin ;; Evildoer

‎knock-plus/compile.rkt‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,8 @@
4747
(match d
4848
[(Defn f xs e)
4949
(seq (Label (symbol->label f))
50+
(Cmp r8 (length xs)) ; arity check
51+
(Jne 'err)
5052
(compile-e e (reverse xs) #t)
5153
(Add rsp (* 8 (length xs))) ; pop args
5254
(Ret))]))
@@ -169,6 +171,7 @@
169171
(seq (compile-es es c)
170172
(move-args (length es) (length c))
171173
(Add rsp (* 8 (length c)))
174+
(Mov r8 (length es)) ; pass arity info
172175
(Jmp (symbol->label f))))
173176

174177
;; Integer Integer -> Asm
@@ -185,6 +188,7 @@
185188
(seq (Lea rax r)
186189
(Push rax)
187190
(compile-es es (cons #f c))
191+
(Mov r8 (length es)) ; pass arity info
188192
(Jmp (symbol->label f))
189193
(Label r))))
190194

‎knock-plus/test/test-runner.rkt‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -201,6 +201,12 @@
201201
'(2 3 4))
202202
(check-equal? (run '(define (f x y) y)
203203
'(f 1 (add1 #f)))
204+
'err)
205+
(check-equal? (run '(define (f x y) y)
206+
'(f 1))
207+
'err)
208+
(check-equal? (run '(define (f x y) y)
209+
'(f 1 2 3))
204210
'err))
205211

206212
(begin ;; Knock

0 commit comments

Comments
 (0)