summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-05-15 17:23:06 +0200
committerAndy Wingo <wingo@pobox.com>2012-05-15 17:23:06 +0200
commit63216d80def079922016fc9084c0ee57af3af383 (patch)
treec28465bbadda889d1de8c0933f53e76d22f06fbd
parent83bd53abb697dd9597f3b78e13e74344b0b676e6 (diff)
downloadguile-63216d80def079922016fc9084c0ee57af3af383.tar.gz
cse passes a lookup procedure to the effects analyzer
* module/language/tree-il/cse.scm (cse): Arrange to pass a lookup procedure to compute-effects, for better effects analysis.
-rw-r--r--module/language/tree-il/cse.scm21
1 files changed, 17 insertions, 4 deletions
diff --git a/module/language/tree-il/cse.scm b/module/language/tree-il/cse.scm
index 5ba590637..ceef15f70 100644
--- a/module/language/tree-il/cse.scm
+++ b/module/language/tree-il/cse.scm
@@ -177,7 +177,7 @@
(lambda (sym)
(vhash-assq sym table))))
- (define compute-effects
+ (define %compute-effects
(make-effects-analyzer assigned-lexical?))
(define (negate exp ctx)
@@ -201,9 +201,6 @@
(make-application #f (make-primitive-ref #f 'not) (list exp)))))
- (define (bailout? exp)
- (causes-effects? (compute-effects exp) &definite-bailout))
-
(define (hasher n)
(lambda (x size) (modulo n size)))
@@ -338,6 +335,16 @@
(make-lexical-ref (tree-il-src exp) name sym)
(lp (1+ n) (- db-len db-len*))))))))))))
+ (define (lookup-lexical sym env)
+ (let ((env-len (vlist-length env)))
+ (let lp ((n 0))
+ (and (< n env-len)
+ (match (vlist-ref env n)
+ ((#(exp _ sym* _) . _)
+ (if (eq? sym sym*)
+ exp
+ (lp (1+ n)))))))))
+
(define (intersection db+ db-)
(vhash-fold-right
(lambda (k h out)
@@ -365,6 +372,12 @@
(lp (cdr in) (cons x out) (concat db** db*))))
(values (reverse out) db*))))
+ (define (compute-effects exp)
+ (%compute-effects exp (lambda (sym) (lookup-lexical sym env))))
+
+ (define (bailout? exp)
+ (causes-effects? (compute-effects exp) &definite-bailout))
+
(define (return exp db*)
(let ((effects (compute-effects exp)))
(cond