diff options
author | Andy Wingo <wingo@pobox.com> | 2012-05-15 17:23:06 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-05-15 17:23:06 +0200 |
commit | 63216d80def079922016fc9084c0ee57af3af383 (patch) | |
tree | c28465bbadda889d1de8c0933f53e76d22f06fbd | |
parent | 83bd53abb697dd9597f3b78e13e74344b0b676e6 (diff) | |
download | guile-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.scm | 21 |
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 |