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

Make integer devirtualization less eager

Browse source 
* module/language/cps/devirtualize-integers.scm (bailout?): Factor out.
  (peel-trace): Adapt to call external bailout? predicate.
  (peel-traces-in-function): Don't peel traces whose alternate is a
  bailout.
This commit is contained in:
Andy Wingo 2018-01-07 12:59:33 +01:00
parent d4addf3792
commit ef23e512b5
1 changed files with 19 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

34
module/language/cps/devirtualize-integers.scm
View file

@ -83,6 +83,11 @@
cps
(transient-intmap))))
(define (bailout? cps label)
(match (intmap-ref cps label)
(($ $kargs _ _ ($ $throw)) #t)
(_ #f)))
(define (peel-trace cps label fx kexit use-counts)
"For the graph starting at LABEL, try to peel out a trace that uses
the variable FX. A peelable trace consists of effect-free terms, or
@ -116,10 +121,6 @@ the trace should be referenced outside of it."
((= count 1) (intmap-remove live-vars var))
(else (intmap-replace live-vars var (1- count)))))
vars))))
(define (bailout? k)
(match (intmap-ref cps k)
(($ $kargs _ _ ($ $throw)) #t)
(_ #f)))
(match (intmap-ref cps label)
;; We know the initial label is a $kargs, and we won't follow the
;; graph to get to $kreceive etc, so we can stop with these two
@ -172,12 +173,12 @@ the trace should be referenced outside of it."
(cond
((not uses-of-interest?)
(fail))
((bailout? kt)
((bailout? cps kt)
(continue kf live-vars defs-of-interest? can-terminate-trace?
(lambda (kf)
(build-term
($branch kf kt src op param peeled-args)))))
((bailout? kf)
((bailout? cps kf)
(continue kt live-vars defs-of-interest? can-terminate-trace?
(lambda (kt)
(build-term
@ -236,15 +237,18 @@ the trace should be referenced outside of it."
;; Traces start with a fixnum? predicate. We could expand this
;; in the future if we wanted to.
(($ $kargs names vars ($ $branch kf kt src 'fixnum? #f (x)))
(with-cps cps
(let$ kt (peel-trace kt x kf use-counts))
($ ((lambda (cps)
(if kt
(with-cps cps
(setk label
($kargs names vars
($branch kf kt src 'fixnum? #f (x)))))
cps))))))
(if (and (bailout? cps kf) #f)
;; Don't peel traces whose alternate is just a bailout.
cps
(with-cps cps
(let$ kt (peel-trace kt x kf use-counts))
($ ((lambda (cps)
(if kt
(with-cps cps
(setk label
($kargs names vars
($branch kf kt src 'fixnum? #f (x)))))
cps)))))))
(_ cps)))
body
cps))