[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.2-101-gd851e32

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=d851e32fdc3d14804108f0389faa75a57599ced4

The branch, stable-2.0 has been updated
       via  d851e32fdc3d14804108f0389faa75a57599ced4 (commit)
      from  40bd6a7e57a779d249f901f710d7368bf26550bb (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d851e32fdc3d14804108f0389faa75a57599ced4
Author: Andy Wingo <address@hidden>
Date:   Fri Sep 23 18:02:05 2011 +0200

    prevent propagation for memory-dependent operations like `car'
    
    * module/language/tree-il/primitives.scm (*primitive-constructors*):
      Record car, cdr, vector-ref, and struct-ref as "constructors".
      Comment to come later.
      (*effect-free-primitives*): Update.
    
    * test-suite/tests/tree-il.test ("partial evaluation"): Add tests.

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/primitives.scm |    7 +++----
 test-suite/tests/tree-il.test          |   24 ++++++++++++++++++++++++
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 76fb669..67c12d2 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -109,7 +109,8 @@
 
 (define *primitive-constructors*
   ;; Primitives that return a fresh object.
-  '(acons cons cons* list vector make-struct make-struct/no-tail))
+  '(acons cons cons* list vector make-struct make-struct/no-tail
+          car cdr vector-ref struct-ref))
 
 (define *effect-free-primitives*
   `(values
@@ -118,13 +119,11 @@
     + * - / 1- 1+ quotient remainder modulo
     not
     pair? null? list? symbol? vector?
-    car cdr
     caar cadr cdar cddr
     caaar caadr cadar caddr cdaar cdadr cddar cdddr
     caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
     cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
-    vector-ref
-    struct? struct-vtable struct-ref
+    struct? struct-vtable
     bytevector-u8-ref bytevector-s8-ref
     bytevector-u16-ref bytevector-u16-native-ref
     bytevector-s16-ref bytevector-s16-native-ref
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 63b74ad..bdff643 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -655,6 +655,30 @@
       (apply (primitive list) (const 1) (const 2) (const 3))))
 
   (pass-if-peval
+   ;; Don't propagate effect-free expressions that operate on mutable
+   ;; objects.
+   (let* ((x (list 1))
+          (y (car x)))
+     (set-car! x 0)
+     y)
+   (let (x) (_) ((apply (primitive list) (const 1)))
+        (let (y) (_) ((apply (primitive car) (lexical x _)))
+             (begin
+               (apply (toplevel set-car!) (lexical x _) (const 0))
+               (lexical y _)))))
+  
+  (pass-if-peval
+   ;; Don't propagate effect-free expressions that operate on objects we
+   ;; don't know about.
+   (let ((y (car x)))
+     (set-car! x 0)
+     y)
+   (let (y) (_) ((apply (primitive car) (toplevel x)))
+        (begin
+          (apply (toplevel set-car!) (toplevel x) (const 0))
+          (lexical y _))))
+  
+  (pass-if-peval
     ;; First order, evaluated.
     (define one
       (let loop ((i 7)


hooks/post-receive
-- 
GNU Guile