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

Make CSE more robust

Browse source 
* module/language/cps/cse.scm (eliminate-common-subexpressions-in-fun):
  I think it's possible to get an orphan loop, with predecessors
  after successors in the original RPO.  Handle that here.
This commit is contained in:
Andy Wingo 2020-06-12 15:58:54 +02:00
parent e7398643b2
commit fc139231a6
1 changed files with 6 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/language/cps/cse.scm
View file

@ -551,7 +551,11 @@ false. It could be that both true and false proofs are available."
(prune-successors analysis label (term-successors term)))) (prune-successors analysis label (term-successors term))))
((trivial-intset preds) ((trivial-intset preds)
=> (lambda (pred) => (lambda (pred)
(match (intmap-ref out pred) (match (and (< pred label) (intmap-ref out pred))
(#f
;; Orphan loop; branch folding must have removed
;; entry. Could still be alive though.
(visit-term-normally))
(($ $kargs names' vars' ($ $continue _ _ ($ $values vals))) (($ $kargs names' vars' ($ $continue _ _ ($ $values vals)))
;; Substitute dominating definitions, and try to elide the ;; Substitute dominating definitions, and try to elide the
;; predecessor entirely. ;; predecessor entirely.
@ -583,7 +587,7 @@ false. It could be that both true and false proofs are available."
;; those as well. ;; those as well.
(add-auxiliary-definitions! pred vars substs term-key))) (add-auxiliary-definitions! pred vars substs term-key)))
(visit-term-normally)) (visit-term-normally))
(_ ((or ($ $kclause) ($ $kreceive))
(visit-term-normally))))) (visit-term-normally)))))
(else (else
(visit-term-normally))))))) (visit-term-normally)))))))