Skip to content

Commit 1a2875e

Browse files
dvanhorndvanhorn
authored
Merge pull request #140 from cmsc430/simpler-match
Simplified pattern matching from lecture.
2 parents 4752960 + fb3e800 commit 1a2875e

File tree

13 files changed

+215
-242
lines changed

13 files changed

+215
-242
lines changed

‎langs/knock/compile.rkt‎

Lines changed: 23 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -218,84 +218,77 @@
218218
(define (compile-match-clause p e c done t?)
219219
(let ((next (gensym)))
220220
(match (compile-pattern p '() next)
221-
[(list i f cm)
221+
[(list i cm)
222222
(seq (Mov rax (Offset rsp 0)) ; restore value being matched
223223
i
224224
(compile-e e (append cm c) t?)
225225
(Add rsp (* 8 (length cm)))
226226
(Jmp done)
227-
f
228227
(Label next))])))
229228

230-
;; Pat CEnv Symbol -> (list Asm Asm CEnv)
229+
;; Pat CEnv Symbol -> (list Asm CEnv)
231230
(define (compile-pattern p cm next)
232231
(match p
233232
[(PWild)
234-
(list (seq) (seq) cm)]
233+
(list (seq) cm)]
235234
[(PVar x)
236-
(list (seq (Push rax))
237-
(seq)
238-
(cons x cm))]
235+
(list (seq (Push rax)) (cons x cm))]
239236
[(PLit l)
240-
(let ((fail (gensym)))
237+
(let ((ok (gensym)))
241238
(list (seq (Cmp rax (value->bits l))
242-
(Jne fail))
243-
(seq (Label fail)
239+
(Je ok)
244240
(Add rsp (* 8 (length cm)))
245-
(Jmp next))
241+
(Jmp next)
242+
(Label ok))
246243
cm))]
247244
[(PAnd p1 p2)
248245
(match (compile-pattern p1 (cons #f cm) next)
249-
[(list i1 f1 cm1)
246+
[(list i1 cm1)
250247
(match (compile-pattern p2 cm1 next)
251-
[(list i2 f2 cm2)
248+
[(list i2 cm2)
252249
(list
253250
(seq (Push rax)
254251
i1
255252
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
256253
i2)
257-
(seq f1 f2)
258254
cm2)])])]
259255
[(PBox p)
260256
(match (compile-pattern p cm next)
261-
[(list i1 f1 cm1)
262-
(let ((fail (gensym)))
257+
[(list i1 cm1)
258+
(let ((ok (gensym)))
263259
(list
264260
(seq (Mov r8 rax)
265261
(And r8 ptr-mask)
266262
(Cmp r8 type-box)
267-
(Jne fail)
263+
(Je ok)
264+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
265+
(Jmp next)
266+
(Label ok)
268267
(Xor rax type-box)
269268
(Mov rax (Offset rax 0))
270269
i1)
271-
(seq f1
272-
(Label fail)
273-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
274-
(Jmp next))
275270
cm1))])]
276271
[(PCons p1 p2)
277272
(match (compile-pattern p1 (cons #f cm) next)
278-
[(list i1 f1 cm1)
273+
[(list i1 cm1)
279274
(match (compile-pattern p2 cm1 next)
280-
[(list i2 f2 cm2)
281-
(let ((fail (gensym)))
275+
[(list i2 cm2)
276+
(let ((ok (gensym)))
282277
(list
283278
(seq (Mov r8 rax)
284279
(And r8 ptr-mask)
285280
(Cmp r8 type-cons)
286-
(Jne fail)
281+
(Je ok)
282+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
283+
(Jmp next)
284+
(Label ok)
287285
(Xor rax type-cons)
288286
(Mov r8 (Offset rax 0))
289287
(Push r8) ; push cdr
290288
(Mov rax (Offset rax 8)) ; mov rax car
291289
i1
292290
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
293291
i2)
294-
(seq f1
295-
f2
296-
(Label fail)
297-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
298-
(Jmp next))
299292
cm2))])])]))
300293

301294
;; Id CEnv -> Integer

‎langs/loot/compile.rkt‎

Lines changed: 23 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -328,84 +328,77 @@
328328
(define (compile-match-clause p e c done t?)
329329
(let ((next (gensym)))
330330
(match (compile-pattern p '() next)
331-
[(list i f cm)
331+
[(list i cm)
332332
(seq (Mov rax (Offset rsp 0)) ; restore value being matched
333333
i
334334
(compile-e e (append cm c) t?)
335335
(Add rsp (* 8 (length cm)))
336336
(Jmp done)
337-
f
338337
(Label next))])))
339338

340-
;; Pat CEnv Symbol -> (list Asm Asm CEnv)
339+
;; Pat CEnv Symbol -> (list Asm CEnv)
341340
(define (compile-pattern p cm next)
342341
(match p
343342
[(PWild)
344-
(list (seq) (seq) cm)]
343+
(list (seq) cm)]
345344
[(PVar x)
346-
(list (seq (Push rax))
347-
(seq)
348-
(cons x cm))]
345+
(list (seq (Push rax)) (cons x cm))]
349346
[(PLit l)
350-
(let ((fail (gensym)))
347+
(let ((ok (gensym)))
351348
(list (seq (Cmp rax (value->bits l))
352-
(Jne fail))
353-
(seq (Label fail)
349+
(Je ok)
354350
(Add rsp (* 8 (length cm)))
355-
(Jmp next))
351+
(Jmp next)
352+
(Label ok))
356353
cm))]
357354
[(PAnd p1 p2)
358355
(match (compile-pattern p1 (cons #f cm) next)
359-
[(list i1 f1 cm1)
356+
[(list i1 cm1)
360357
(match (compile-pattern p2 cm1 next)
361-
[(list i2 f2 cm2)
358+
[(list i2 cm2)
362359
(list
363360
(seq (Push rax)
364361
i1
365362
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
366363
i2)
367-
(seq f1 f2)
368364
cm2)])])]
369365
[(PBox p)
370366
(match (compile-pattern p cm next)
371-
[(list i1 f1 cm1)
372-
(let ((fail (gensym)))
367+
[(list i1 cm1)
368+
(let ((ok (gensym)))
373369
(list
374370
(seq (Mov r8 rax)
375371
(And r8 ptr-mask)
376372
(Cmp r8 type-box)
377-
(Jne fail)
373+
(Je ok)
374+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
375+
(Jmp next)
376+
(Label ok)
378377
(Xor rax type-box)
379378
(Mov rax (Offset rax 0))
380379
i1)
381-
(seq f1
382-
(Label fail)
383-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
384-
(Jmp next))
385380
cm1))])]
386381
[(PCons p1 p2)
387382
(match (compile-pattern p1 (cons #f cm) next)
388-
[(list i1 f1 cm1)
383+
[(list i1 cm1)
389384
(match (compile-pattern p2 cm1 next)
390-
[(list i2 f2 cm2)
391-
(let ((fail (gensym)))
385+
[(list i2 cm2)
386+
(let ((ok (gensym)))
392387
(list
393388
(seq (Mov r8 rax)
394389
(And r8 ptr-mask)
395390
(Cmp r8 type-cons)
396-
(Jne fail)
391+
(Je ok)
392+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
393+
(Jmp next)
394+
(Label ok)
397395
(Xor rax type-cons)
398396
(Mov r8 (Offset rax 0))
399397
(Push r8) ; push cdr
400398
(Mov rax (Offset rax 8)) ; mov rax car
401399
i1
402400
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
403401
i2)
404-
(seq f1
405-
f2
406-
(Label fail)
407-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
408-
(Jmp next))
409402
cm2))])])]))
410403

411404
;; Id CEnv -> Integer

‎langs/mountebank/compile-datum.rkt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@
2323

2424
;; Value -> Asm
2525
(define (compile-atom v)
26-
(seq (Mov rax (imm->bits v))))
26+
(seq (Mov rax (value->bits v))))
2727

2828
;; Datum -> Boolean
2929
(define (compound? d)
@@ -48,7 +48,7 @@
4848
[(cons? c) (compile-datum-cons (car c) (cdr c))]
4949
[(symbol? c) (cons (load-symbol c) '())]
5050
[(string? c) (cons (load-string c) '())]
51-
[else (cons (imm->bits c) '())]))
51+
[else (cons (value->bits c) '())]))
5252

5353
;; Datum -> (cons AsmExpr Asm)
5454
(define (compile-datum-box c)

‎langs/mountebank/compile-expr.rkt‎

Lines changed: 36 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
(define (compile-e e c t?)
2020
(match e
2121
[(Quote d) (compile-datum d)]
22-
[(Eof) (seq (Mov rax (imm->bits eof)))]
22+
[(Eof) (seq (Mov rax (value->bits eof)))]
2323
[(Var x) (compile-variable x c)]
2424
[(Prim0 p) (compile-prim0 p c)]
2525
[(Prim1 p e) (compile-prim1 p e c)]
@@ -214,109 +214,104 @@
214214
(define (compile-match-clause p e c done t?)
215215
(let ((next (gensym)))
216216
(match (compile-pattern p '() next)
217-
[(list i f cm)
217+
[(list i cm)
218218
(seq (Mov rax (Offset rsp 0)) ; restore value being matched
219219
i
220220
(compile-e e (append cm c) t?)
221221
(Add rsp (* 8 (length cm)))
222222
(Jmp done)
223-
f
224223
(Label next))])))
225224

226-
;; Pat CEnv Symbol -> (list Asm Asm CEnv)
225+
;; Pat CEnv Symbol -> (list Asm CEnv)
227226
(define (compile-pattern p cm next)
228227
(match p
229228
[(PWild)
230-
(list (seq) (seq) cm)]
229+
(list (seq) cm)]
231230
[(PVar x)
232-
(list (seq (Push rax))
233-
(seq)
234-
(cons x cm))]
231+
(list (seq (Push rax)) (cons x cm))]
235232
[(PStr s)
236-
(let ((fail (gensym)))
233+
(let ((ok (gensym))
234+
(fail (gensym)))
237235
(list (seq (Lea rdi (symbol->data-label (string->symbol s)))
238236
(Mov r8 rax)
239237
(And r8 ptr-mask)
240238
(Cmp r8 type-str)
241-
(Jne fail)
239+
(Je ok)
240+
(Label fail)
241+
(Add rsp (* 8 (length cm)))
242+
(Jmp next)
243+
(Label ok)
242244
(Xor rax type-str)
243245
(Mov rsi rax)
244246
pad-stack
245247
(Call 'symb_cmp)
246248
unpad-stack
247249
(Cmp rax 0)
248250
(Jne fail))
249-
(seq (Label fail)
250-
(Add rsp (* 8 (length cm)))
251-
(Jmp next))
252251
cm))]
253252
[(PSymb s)
254-
(let ((fail (gensym)))
253+
(let ((ok (gensym)))
255254
(list (seq (Lea r9 (Plus (symbol->data-label s) type-symb))
256255
(Cmp rax r9)
257-
(Jne fail))
258-
(seq (Label fail)
256+
(Je ok)
259257
(Add rsp (* 8 (length cm)))
260-
(Jmp next))
258+
(Jmp next)
259+
(Label ok))
261260
cm))]
262261
[(PLit l)
263-
(let ((fail (gensym)))
264-
(list (seq (Cmp rax (imm->bits l))
265-
(Jne fail))
266-
(seq (Label fail)
262+
(let ((ok (gensym)))
263+
(list (seq (Cmp rax (value->bits l))
264+
(Je ok)
267265
(Add rsp (* 8 (length cm)))
268-
(Jmp next))
266+
(Jmp next)
267+
(Label ok))
269268
cm))]
270269
[(PAnd p1 p2)
271270
(match (compile-pattern p1 (cons #f cm) next)
272-
[(list i1 f1 cm1)
271+
[(list i1 cm1)
273272
(match (compile-pattern p2 cm1 next)
274-
[(list i2 f2 cm2)
273+
[(list i2 cm2)
275274
(list
276275
(seq (Push rax)
277276
i1
278277
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
279278
i2)
280-
(seq f1 f2)
281279
cm2)])])]
282280
[(PBox p)
283281
(match (compile-pattern p cm next)
284-
[(list i1 f1 cm1)
285-
(let ((fail (gensym)))
282+
[(list i1 cm1)
283+
(let ((ok (gensym)))
286284
(list
287285
(seq (Mov r8 rax)
288286
(And r8 ptr-mask)
289287
(Cmp r8 type-box)
290-
(Jne fail)
288+
(Je ok)
289+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
290+
(Jmp next)
291+
(Label ok)
291292
(Xor rax type-box)
292293
(Mov rax (Offset rax 0))
293294
i1)
294-
(seq f1
295-
(Label fail)
296-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
297-
(Jmp next))
298295
cm1))])]
299296
[(PCons p1 p2)
300297
(match (compile-pattern p1 (cons #f cm) next)
301-
[(list i1 f1 cm1)
298+
[(list i1 cm1)
302299
(match (compile-pattern p2 cm1 next)
303-
[(list i2 f2 cm2)
304-
(let ((fail (gensym)))
300+
[(list i2 cm2)
301+
(let ((ok (gensym)))
305302
(list
306303
(seq (Mov r8 rax)
307304
(And r8 ptr-mask)
308305
(Cmp r8 type-cons)
309-
(Jne fail)
306+
(Je ok)
307+
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
308+
(Jmp next)
309+
(Label ok)
310310
(Xor rax type-cons)
311311
(Mov r8 (Offset rax 0))
312312
(Push r8) ; push cdr
313313
(Mov rax (Offset rax 8)) ; mov rax car
314314
i1
315315
(Mov rax (Offset rsp (* 8 (- (sub1 (length cm1)) (length cm)))))
316316
i2)
317-
(seq f1
318-
f2
319-
(Label fail)
320-
(Add rsp (* 8 (length cm))) ; haven't pushed anything yet
321-
(Jmp next))
322317
cm2))])])]))

0 commit comments

Comments
 (0)