mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

Simplify analyze-reverse-control-flow

Browse source 
* module/language/cps/dfg.scm (analyze-reverse-control-flow): Use the
  DFG's label count and min label analysis instead of rolling our own.
This commit is contained in:
Andy Wingo 2014-04-02 11:04:04 +02:00
parent 16af91e862
commit ae0388b698
1 changed files with 14 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

31
module/language/cps/dfg.scm
View file

@ -288,12 +288,6 @@ BODY for each body continuation in the prompt."
(find-prompt-bodies dfg min-label label-count)))
(define (analyze-reverse-control-flow fun dfg)
(define (compute-label-ranges ktail)
((make-cont-folder #f min-label label-count)
(lambda (label cont min-label label-count)
(values (min label min-label) (1+ label-count)))
fun ktail 0))
(define (compute-reverse-control-flow-order ktail dfg min-label label-count)
(let ((order (make-vector label-count #f))
(label-map (make-vector label-count #f))
@ -366,17 +360,20 @@ BODY for each body continuation in the prompt."
(vector-push! succs (renumber body) (renumber handler))))
cfa))
(match fun
(($ $fun src meta free
($ $cont kentry ($ $kentry self ($ $cont ktail tail))))
(call-with-values (lambda () (compute-label-ranges ktail))
(lambda (min-label label-count)
(call-with-values
(lambda ()
(compute-reverse-control-flow-order ktail dfg
min-label label-count))
(lambda (order k-map)
(build-cfa ktail min-label label-count order k-map))))))))
(unless (= (vector-length (dfg-cont-table dfg)) (dfg-label-count dfg))
(error "function needs renumbering"))
(let ((min-label (dfg-min-label dfg))
(label-count (dfg-label-count dfg)))
(match fun
(($ $fun src meta free
($ $cont kentry ($ $kentry self ($ $cont ktail tail))))
(call-with-values
(lambda ()
(compute-reverse-control-flow-order ktail dfg
min-label label-count))
(lambda (order k-map)
(build-cfa ktail min-label label-count order k-map)))))))
;; Dominator analysis.
(define-record-type $dominator-analysis