diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-24 18:57:59 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-24 18:57:59 +0200 |
commit | 1eb4886ffa9c4c81c946af7fed8fb39020fcde12 (patch) | |
tree | 11c971885cb19fab0b244d9537431209f3bf7079 /module/language/tree-il/optimize.scm | |
parent | 8d06538e821c3e6cdd4861e1d8b1ec25ed930453 (diff) | |
download | guile-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.scm | 15 |
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 |