summaryrefslogtreecommitdiff
path: root/module/language/cps/contification.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2020-08-11 23:09:51 +0200
committerAndy Wingo <wingo@pobox.com>2020-08-12 23:30:08 +0200
commit03998db647546df017feb19c0d5912e7451a61fc (patch)
tree968fe99c1a0e39b96a340b37c0f0ed2199e1e65e /module/language/cps/contification.scm
parentcd5ab6377bb14cb8248e0ba577ee0c44bce43b60 (diff)
downloadguile-03998db647546df017feb19c0d5912e7451a61fc.tar.gz
Add new pass to optimize branch chains to table dispatch
* module/language/cps/switch.scm: New pass. * module/Makefile.am (SOURCES): * am/bootstrap.am (SOURCES): Add switch.scm. * module/system/base/optimize.scm (available-optimizations): * module/language/cps/optimize.scm (optimize-first-order-cps): Run switch optimization at level 2. * libguile/hash.c (JENKINS_LOOKUP3_HASHWORD2): Add note regarding cross-compilation. * module/language/cps/graphs.scm (intmap-select): New definition. * module/language/cps/utils.scm (compute-singly-referenced-labels): Move here, from various places. Doesn't take a body intset argument. * module/language/cps/contification.scm: * module/language/cps/closure-conversion.scm: * module/language/cps/simplify.scm: Use compute-singly-referenced-labels from utils. * module/language/cps/effects-analysis.scm (annotation->memory-kind*): (annotation->memory-kind): Add symbol annotation cases.
Diffstat (limited to 'module/language/cps/contification.scm')
-rw-r--r--module/language/cps/contification.scm31
1 files changed, 0 insertions, 31 deletions
diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm
index 031b0cd13..664c4b305 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -40,37 +40,6 @@
#:use-module (language cps with-cps)
#:export (contify))
-(define (compute-singly-referenced-labels conts)
- "Compute the set of labels in CONTS that have exactly one
-predecessor."
- (define (add-ref label cont single multiple)
- (define (ref k single multiple)
- (if (intset-ref single k)
- (values single (intset-add! multiple k))
- (values (intset-add! single k) multiple)))
- (define (ref0) (values single multiple))
- (define (ref1 k) (ref k single multiple))
- (define (ref2 k k*)
- (if k*
- (let-values (((single multiple) (ref k single multiple)))
- (ref k* single multiple))
- (ref1 k)))
- (match cont
- (($ $kreceive arity k) (ref1 k))
- (($ $kfun src meta self ktail kclause) (ref2 ktail kclause))
- (($ $ktail) (ref0))
- (($ $kclause arity kbody kalt) (ref2 kbody kalt))
- (($ $kargs names syms ($ $continue k)) (ref1 k))
- (($ $kargs names syms ($ $branch kf kt)) (ref2 kf kt))
- (($ $kargs names syms ($ $switch kf kt*))
- (fold2 ref (cons kf kt*) single multiple))
- (($ $kargs names syms ($ $prompt k kh)) (ref2 k kh))
- (($ $kargs names syms ($ $throw)) (ref0))))
- (let*-values (((single multiple) (values empty-intset empty-intset))
- ((single multiple) (intmap-fold add-ref conts single multiple)))
- (intset-subtract (persistent-intset single)
- (persistent-intset multiple))))
-
(define (compute-functions conts)
"Compute a map from $kfun label to bound variable names for all
functions in CONTS. Functions have two bound variable names: their self