* Eliminates a jump-to-jump case in "flatten-code".
This commit is contained in:
parent
37aab027da
commit
eb30e7ab58
Binary file not shown.
|
@ -2585,6 +2585,11 @@
|
||||||
(define (unique-label)
|
(define (unique-label)
|
||||||
(label (gensym)))
|
(label (gensym)))
|
||||||
;;;
|
;;;
|
||||||
|
(define (constant=? x k)
|
||||||
|
(struct-case x
|
||||||
|
[(constant k0) (equal? k0 k)]
|
||||||
|
[else #f]))
|
||||||
|
;;;
|
||||||
(define (P x lt lf ac)
|
(define (P x lt lf ac)
|
||||||
(struct-case x
|
(struct-case x
|
||||||
[(constant c)
|
[(constant c)
|
||||||
|
@ -2595,6 +2600,10 @@
|
||||||
(E e0 (P e1 lt lf ac))]
|
(E e0 (P e1 lt lf ac))]
|
||||||
[(conditional e0 e1 e2)
|
[(conditional e0 e1 e2)
|
||||||
(cond
|
(cond
|
||||||
|
[(and (constant=? e1 #t) (constant=? e2 #f))
|
||||||
|
(P e0 lt lf ac)]
|
||||||
|
[(and (constant=? e1 #f) (constant=? e2 #t))
|
||||||
|
(P e0 lf lt ac)]
|
||||||
[(and lt lf)
|
[(and lt lf)
|
||||||
(let ([l (unique-label)])
|
(let ([l (unique-label)])
|
||||||
(P e0 #f l
|
(P e0 #f l
|
||||||
|
|
|
@ -1821,14 +1821,14 @@
|
||||||
cases)
|
cases)
|
||||||
cp free name))])]
|
cp free name))])]
|
||||||
[else (error who "invalid expression" (unparse x))]))
|
[else (error who "invalid expression" (unparse x))]))
|
||||||
(when (assembler-output)
|
;(when (assembler-output)
|
||||||
(printf "BEFORE\n")
|
; (printf "BEFORE\n")
|
||||||
(pretty-print (unparse x)))
|
; (pretty-print (unparse x)))
|
||||||
(let ([x (E x)])
|
(let ([x (E x)])
|
||||||
(let ([v (make-codes all-codes x)])
|
(let ([v (make-codes all-codes x)])
|
||||||
(when (assembler-output)
|
;(when (assembler-output)
|
||||||
(printf "AFTER\n")
|
; (printf "AFTER\n")
|
||||||
(pretty-print (unparse v)))
|
; (pretty-print (unparse v)))
|
||||||
v)))
|
v)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1101
|
1102
|
||||||
|
|
Loading…
Reference in New Issue