wingo pushed a commit to branch master in repository guile. commit cf948e0f6f61ec3f2e3f5a798315d116d380a8f7 Author: Andy Wingo <wi...@pobox.com> AuthorDate: Thu May 28 11:15:20 2020 +0200
Renumber before CSE * module/language/cps/cse.scm (compute-equivalent-subexpressions): Assume renumbered program. (eliminate-common-subexpressions): Renumber. Will allow optimizations later. --- module/language/cps/cse.scm | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm index 53b8a51..ec1685c 100644 --- a/module/language/cps/cse.scm +++ b/module/language/cps/cse.scm @@ -31,6 +31,7 @@ #:use-module (language cps effects-analysis) #:use-module (language cps intmap) #:use-module (language cps intset) + #:use-module (language cps renumber) #:export (eliminate-common-subexpressions)) (define (compute-available-expressions succs kfun effects) @@ -284,14 +285,14 @@ false. It could be that both true and false proofs are available." ((u <- untag-char #f s) (s <- tag-char #f u)) ((s <- tag-char #f u) (u <- untag-char #f s))))) - (define (visit-label label equiv-labels var-substs) + (define (visit-label label cont equiv-labels var-substs) (define (term-defs term) (match term (($ $continue k) (and (intset-ref singly-referenced k) (intmap-ref defs label))) (($ $branch) '()))) - (match (intmap-ref conts label) + (match cont (($ $kargs names vars term) (match (compute-term-key var-substs term) (#f (values equiv-labels var-substs)) @@ -343,12 +344,12 @@ false. It could be that both true and false proofs are available." defs))))))))))) (_ (values equiv-labels var-substs)))) - ;; Traverse the labels in fun in reverse post-order, which will - ;; visit definitions before uses first. - (fold2 visit-label - (compute-reverse-post-order succs kfun) - equiv-labels - var-substs))) + ;; Because of the renumber pass, the labels are numbered in + ;; reverse post-order, which will visit definitions before uses. + (intmap-fold visit-label + conts + equiv-labels + var-substs))) (intmap-fold visit-fun (compute-reachable-functions conts kfun) @@ -413,7 +414,8 @@ false. It could be that both true and false proofs are available." conts)) (define (eliminate-common-subexpressions conts) - (call-with-values (lambda () (compute-equivalent-subexpressions conts 0)) - (lambda (equiv-labels var-substs) - (let ((truthy-labels (compute-truthy-expressions conts 0))) - (apply-cse conts equiv-labels var-substs truthy-labels))))) + (let ((conts (renumber conts 0))) + (call-with-values (lambda () (compute-equivalent-subexpressions conts 0)) + (lambda (equiv-labels var-substs) + (let ((truthy-labels (compute-truthy-expressions conts 0))) + (apply-cse conts equiv-labels var-substs truthy-labels))))))