summaryrefslogtreecommitdiff
path: root/module/language/tree-il/optimize.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-24 18:57:59 +0200
committerAndy Wingo <wingo@pobox.com>2011-09-24 18:57:59 +0200
commit1eb4886ffa9c4c81c946af7fed8fb39020fcde12 (patch)
tree11c971885cb19fab0b244d9537431209f3bf7079 /module/language/tree-il/optimize.scm
parent8d06538e821c3e6cdd4861e1d8b1ec25ed930453 (diff)
downloadguile-1eb4886ffa9c4c81c946af7fed8fb39020fcde12.tar.gz
peval: don't propagate expressions that access memory
* module/language/tree-il/optimize.scm (peval): Rename `pure-expression?' to `constant-expression?', in the sense of GCC's `pure' and `const'. A <toplevel-ref> is not constant, because it can be mutated. A <dynref> isn't constant either, for the same reason. * test-suite/tests/tree-il.test ("partial evaluation"): Add a test, and update existing tests that assumed that toplevel-ref would propagate.
Diffstat (limited to 'module/language/tree-il/optimize.scm')
-rw-r--r--module/language/tree-il/optimize.scm15
1 files changed, 6 insertions, 9 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm
index 8d626ea8e..b96e80104 100644
--- a/module/language/tree-il/optimize.scm
+++ b/module/language/tree-il/optimize.scm
@@ -318,11 +318,10 @@ it does not handle <fix> and <let-values>, it should be called before
(define (const*? x)
(or (const? x) (lambda? x) (void? x)))
- (define (pure-expression? x)
- ;; Return true if X is pure---i.e., if it is known to have no
- ;; effects and does not allocate storage for a mutable object.
- ;; Note: <module-ref> is not "pure" because it loads a module as a
- ;; side-effect.
+ (define (constant-expression? x)
+ ;; Return true if X is constant---i.e., if it is known to have no
+ ;; effects, does not allocate storage for a mutable object, and does
+ ;; not access mutable data (like `car' or toplevel references).
(let loop ((x x))
(match x
(($ <void>) #t)
@@ -331,9 +330,7 @@ it does not handle <fix> and <let-values>, it should be called before
(($ <lambda-case> _ req opt rest kw inits _ body alternate)
(and (every loop inits) (loop body) (loop alternate)))
(($ <lexical-ref>) #t)
- (($ <toplevel-ref>) #t)
(($ <primitive-ref>) #t)
- (($ <dynref> _ fluid) (loop fluid))
(($ <conditional> _ condition subsequent alternate)
(and (loop condition) (loop subsequent) (loop alternate)))
(($ <application> _ ($ <primitive-ref> _ name) args)
@@ -447,7 +444,7 @@ it does not handle <fix> and <let-values>, it should be called before
((effect) (make-void #f))
(else
(let ((val (lookup gensym)))
- (if (pure-expression? val)
+ (if (constant-expression? val)
(case ctx
;; fixme: cache this? it is a divergence from
;; O(n).
@@ -616,7 +613,7 @@ it does not handle <fix> and <let-values>, it should be called before
(nreq (length req))
(nopt (if opt (length opt) 0)))
(if (and (>= nargs nreq) (<= nargs (+ nreq nopt))
- (every pure-expression? args))
+ (every constant-expression? args))
(let* ((params
(append args
(drop inits