Skip to content

Commit fb3e800

Browse files
dvanhorndvanhorn
committed
Carry forward pattern match simplification.
1 parent abda0a9 commit fb3e800

File tree

12 files changed

+192
-212
lines changed

12 files changed

+192
-212
lines changed

‎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))])])]))

‎langs/mountebank/compile-ops.rkt‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -31,10 +31,10 @@
3131
(match p
3232
['add1
3333
(seq (assert-integer rax)
34-
(Add rax (imm->bits 1)))]
34+
(Add rax (value->bits 1)))]
3535
['sub1
3636
(seq (assert-integer rax)
37-
(Sub rax (imm->bits 1)))]
37+
(Sub rax (value->bits 1)))]
3838
['zero?
3939
(seq (assert-integer rax)
4040
(eq-imm 0))]
@@ -331,9 +331,9 @@
331331
(let ((l (gensym)))
332332
(seq (And rax mask)
333333
(Cmp rax type)
334-
(Mov rax (imm->bits #t))
334+
(Mov rax (value->bits #t))
335335
(Je l)
336-
(Mov rax (imm->bits #f))
336+
(Mov rax (value->bits #f))
337337
(Label l))))
338338

339339
(define assert-integer
@@ -356,33 +356,33 @@
356356
(define (assert-codepoint r)
357357
(let ((ok (gensym)))
358358
(seq (assert-integer r)
359-
(Cmp r (imm->bits 0))
359+
(Cmp r (value->bits 0))
360360
(Jl 'raise_error_align)
361-
(Cmp r (imm->bits 1114111))
361+
(Cmp r (value->bits 1114111))
362362
(Jg 'raise_error_align)
363-
(Cmp r (imm->bits 55295))
363+
(Cmp r (value->bits 55295))
364364
(Jl ok)
365-
(Cmp r (imm->bits 57344))
365+
(Cmp r (value->bits 57344))
366366
(Jg ok)
367367
(Jmp 'raise_error_align)
368368
(Label ok))))
369369

370370
(define (assert-byte r)
371371
(seq (assert-integer r)
372-
(Cmp r (imm->bits 0))
372+
(Cmp r (value->bits 0))
373373
(Jl 'raise_error_align)
374-
(Cmp r (imm->bits 255))
374+
(Cmp r (value->bits 255))
375375
(Jg 'raise_error_align)))
376376

377377
(define (assert-natural r)
378378
(seq (assert-integer r)
379-
(Cmp r (imm->bits 0))
379+
(Cmp r (value->bits 0))
380380
(Jl 'raise_error_align)))
381381

382382
;; Value -> Asm
383383
(define (eq-imm imm)
384384
(let ((l1 (gensym)))
385-
(seq (Cmp rax (imm->bits imm))
385+
(seq (Cmp rax (value->bits imm))
386386
(Mov rax val-true)
387387
(Je l1)
388388
(Mov rax val-false)

‎langs/mountebank/types.rkt‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@
3434
[(= b val-empty) '()]
3535
[else (error "invalid bits")]))
3636

37-
(define (imm->bits v)
37+
(define (value->bits v)
3838
(cond [(eof-object? v) val-eof]
3939
[(integer? v) (arithmetic-shift v int-shift)]
4040
[(char? v)
@@ -43,7 +43,8 @@
4343
[(eq? v #t) val-true]
4444
[(eq? v #f) val-false]
4545
[(void? v) val-void]
46-
[(empty? v) val-empty]))
46+
[(empty? v) val-empty]
47+
[else (error "not an immediate")]))
4748

4849

4950
(define (imm-bits? v)

0 commit comments

Comments
 (0)