mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 03:54:12 +02:00
Code Activity

peval: don't propagate expressions that access memory

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-09-24 18:57:59 +02:00
parent 8d06538e82
commit 1eb4886ffa
2 changed files with 83 additions and 74 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/language/tree-il/optimize.scm
View file

@ -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