1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

CSE forward-propagates changes to CFG

* module/language/cps/cse.scm (propagate-analysis): New helper.
  (eliminate-common-subexpressions-in-fun): Recompute avail and bool set
  in response to simplifications in predecessor CFG.  Allows much better
  compilation of pattern-matching idioms!
This commit is contained in:
Andy Wingo 2020-05-29 16:31:11 +02:00
parent d9143c32c5
commit 4c59ff7e95

View file

@ -250,6 +250,27 @@ false. It could be that both true and false proofs are available."
kt (true-idx pred))) kt (true-idx pred)))
(_ bool))))))) (_ bool)))))))
(define (propagate-analysis analysis label out)
(match analysis
(($ <analysis> effects clobbers preds avail truthy-labels)
(call-with-values
(lambda ()
(intset-fold
(lambda (pred avail-in bool-in)
(call-with-values
(lambda ()
(compute-avail-and-bool-edge analysis pred label out))
(lambda (avail-in* bool-in*)
(values (if avail-in
(intset-intersect avail-in avail-in*)
avail-in*)
(intset-union bool-in bool-in*)))))
(intmap-ref preds label) #f empty-intset))
(lambda (avail-in bool-in)
(make-analysis effects clobbers preds
(intmap-replace avail label avail-in)
(intmap-replace truthy-labels label bool-in)))))))
(define (term-successors term) (define (term-successors term)
(match term (match term
(($ $continue k) (intset k)) (($ $continue k) (intset k))
@ -481,7 +502,8 @@ false. It could be that both true and false proofs are available."
(values term analysis))))))))) (values term analysis)))))))))
(define (visit-term label names vars term out substs analysis) (define (visit-term label names vars term out substs analysis)
(let ((term (rename-uses term substs))) (let ((term (rename-uses term substs))
(analyis (propagate-analysis analysis label out)))
(match term (match term
(($ $branch) (($ $branch)
;; Can only forward predecessors if this continuation binds no ;; Can only forward predecessors if this continuation binds no