mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

Refactor CSE to take advantage of RPO numbering

Browse source 
* module/language/cps/cse.scm (fold-renumbered-functions): New helper.
  (compute-equivalent-expressions): Use new helper.
  (compute-equivalent-expressions-in-fun): Lift to top-level.
  (eliminate-common-subexpressions): Adapt.
This commit is contained in:
Andy Wingo 2020-05-28 11:52:28 +02:00
parent cf948e0f6f
commit 6e91173334
1 changed files with 182 additions and 163 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -187,13 +187,9 @@ false. It could be that both true and false proofs are available."
(intset-subtract (persistent-intset single)
(persistent-intset multiple)))))
(define (intmap-select map set)
(intset->intmap (lambda (label) (intmap-ref map label)) set))
(define (compute-equivalent-subexpressions conts kfun)
(define (visit-fun kfun body equiv-labels var-substs)
(let* ((conts (intmap-select conts body))
(effects (synthesize-definition-effects (compute-effects conts)))
(define (compute-equivalent-expressions-in-fun kfun conts
equiv-labels var-substs)
(let* ((effects (synthesize-definition-effects (compute-effects conts)))
(succs (compute-successors conts kfun))
(singly-referenced (compute-singly-referenced succs))
(avail (compute-available-expressions succs kfun effects))
@ -351,10 +347,33 @@ false. It could be that both true and false proofs are available."
equiv-labels
var-substs)))
(intmap-fold visit-fun
(compute-reachable-functions conts kfun)
empty-intmap
empty-intmap))
(define (fold-renumbered-functions f conts . seeds)
;; Precondition: CONTS has been renumbered, and therefore functions
;; contained within it are topologically sorted, and the conts of each
;; function's body are numbered sequentially after the function's
;; $kfun.
(define (next-function-body kfun)
(match (intmap-ref conts kfun (lambda (_) #f))
(#f #f)
((and cont ($ $kfun))
(let lp ((k (1+ kfun)) (body (intmap-add! empty-intmap kfun cont)))
(match (intmap-ref conts k (lambda (_) #f))
((or #f ($ $kfun))
(persistent-intmap body))
(cont
(lp (1+ k) (intmap-add! body k cont))))))))
(let fold ((kfun 0) (seeds seeds))
(match (next-function-body kfun)
(#f (apply values seeds))
(conts
(call-with-values (lambda () (apply f kfun conts seeds))
(lambda seeds
(fold (1+ (intmap-prev conts)) seeds)))))))
(define (compute-equivalent-expressions conts)
(fold-renumbered-functions compute-equivalent-expressions-in-fun
conts empty-intmap empty-intmap))
(define (apply-cse conts equiv-labels var-substs truthy-labels)
(define (true-idx idx) (ash idx 1))
@ -415,7 +434,7 @@ false. It could be that both true and false proofs are available."
(define (eliminate-common-subexpressions conts)
(let ((conts (renumber conts 0)))
(call-with-values (lambda () (compute-equivalent-subexpressions conts 0))
(call-with-values (lambda () (compute-equivalent-expressions conts))
(lambda (equiv-labels var-substs)
(let ((truthy-labels (compute-truthy-expressions conts 0)))
(apply-cse conts equiv-labels var-substs truthy-labels))))))