suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

not quite done yet

Browse Source
This commit is contained in:
Danny Yoo 2011-07-13 18:08:30 -04:00
parent ed5894b92c
commit d29410b738
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/optimize-il.rkt
View File

@ -2,6 +2,7 @@
(require "expression-structs.rkt" (require "expression-structs.rkt"
"il-structs.rkt" "il-structs.rkt"
"lexical-structs.rkt" "lexical-structs.rkt"
(prefix-in ufind: "../union-find.rkt")
racket/list) racket/list)
(provide optimize-il) (provide optimize-il)
@ -117,7 +118,7 @@
[(empty? stmts) [(empty? stmts)
stmts] stmts]
[else [else
(let ([ht ((inst make-hasheq Symbol Symbol))]) (let ([forest (ufind:new-forest)])
;; First scan identifies the adjacent labels ;; First scan identifies the adjacent labels
(let: loop : Void ([last-labeled-stmt : (U False Symbol) #f] (let: loop : Void ([last-labeled-stmt : (U False Symbol) #f]
@ -126,10 +127,16 @@
[(empty? stmts) [(empty? stmts)
(void)] (void)]
[else [else
(loop (if (symbol? (first stmts)) (let ([next-stmt (first stmts)])
(first stmts) (cond [(symbol? next-stmt)
#f) (ufind:make-set forest next-stmt)
(rest stmts))])) (when (and (symbol? last-labeled-stmt)
(eq? last-labeled-stmt next-stmt))
(ufind:union-set forest last-labeled-stmt next-stmt))
(loop next-stmt
(rest stmts))]
[else
(loop #f (rest stmts))]))]))
;; We then run through all the statements and replace with ;; We then run through all the statements and replace with
@ -139,8 +146,9 @@
[(empty? stmts) [(empty? stmts)
empty] empty]
[else [else
(cons (first stmts) (let ([next-stmt (first stmts)])
(loop (rest stmts)))])))])) (cons next-stmt
(loop (rest stmts))))])))]))