[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-128-g265e7bd

[Ian Price]

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=265e7bd92a3d8720ca94d64443878d309250ecba

The branch, stable-2.0 has been updated
       via  265e7bd92a3d8720ca94d64443878d309250ecba (commit)
      from  70511cc4037c9129cf501d87c79d19f062d56357 (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 265e7bd92a3d8720ca94d64443878d309250ecba
Author: Ian Price <address@hidden>
Date:   Wed Oct 23 11:14:26 2013 +0100

    Fix inlining of tail list to apply.
    
    Fixes <http://bugs.gnu.org/15533>.
    
    * module/language/tree-il/peval.scm (peval): Final list argument to
      `apply' should not be inlined if it is mutable.
    * test-suite/tests/peval.test ("partial evaluation"): Add test.

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

Summary of changes:
 module/language/tree-il/peval.scm |   38 +++++++++++++++++++-----------------
 test-suite/tests/peval.test       |   16 ++++++++++++++-
 2 files changed, 35 insertions(+), 19 deletions(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index a6e4076..bd92edc 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -716,24 +716,26 @@ top-level bindings from ENV and return the resulting 
expression."
         (cond
          ((lookup (lexical-ref-gensym x))
           => (lambda (op)
-               (let ((y (or (operand-residual-value op)
-                            (visit-operand op counter 'value 10 10)
-                            (operand-source op))))
-                 (cond
-                  ((and (lexical-ref? y)
-                        (= (lexical-refcount (lexical-ref-gensym x)) 1))
-                   ;; X is a simple alias for Y.  Recurse, regardless of
-                   ;; the number of aliases we were expecting.
-                   (find-definition y n-aliases))
-                  ((= (lexical-refcount (lexical-ref-gensym x)) n-aliases)
-                   ;; We found a definition that is aliased the right
-                   ;; number of times.  We still recurse in case it is a
-                   ;; lexical.
-                   (values (find-definition y 1)
-                           op))
-                  (else
-                   ;; We can't account for our aliases.
-                   (values #f #f))))))
+               (if (var-set? (operand-var op))
+                   (values #f #f)
+                   (let ((y (or (operand-residual-value op)
+                                (visit-operand op counter 'value 10 10)
+                                (operand-source op))))
+                     (cond
+                      ((and (lexical-ref? y)
+                            (= (lexical-refcount (lexical-ref-gensym x)) 1))
+                       ;; X is a simple alias for Y.  Recurse, regardless of
+                       ;; the number of aliases we were expecting.
+                       (find-definition y n-aliases))
+                      ((= (lexical-refcount (lexical-ref-gensym x)) n-aliases)
+                       ;; We found a definition that is aliased the right
+                       ;; number of times.  We still recurse in case it is a
+                       ;; lexical.
+                       (values (find-definition y 1)
+                               op))
+                      (else
+                       ;; We can't account for our aliases.
+                       (values #f #f)))))))
          (else
           ;; A formal parameter.  Can't say anything about that.
           (values #f #f))))
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 923b0d1..5b003d2 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -1223,4 +1223,18 @@
       (call-with-prompt t
                         (lambda () (abort-to-prompt t 1 2 3))
                         (lambda (k x y z) (list x y z))))
-    (apply (primitive 'list) (const 1) (const 2) (const 3))))
+    (apply (primitive 'list) (const 1) (const 2) (const 3)))
+
+  (pass-if-peval resolve-primitives
+   ;; Should not inline tail list to apply if it is mutable.
+   ;; <http://debbugs.gnu.org/15533>
+   (let ((l '()))
+     (if (pair? arg)
+         (set! l arg))
+     (apply f l))
+   (let (l) (_) ((const ()))
+        (begin
+          (if (apply (primitive pair?) (toplevel arg))
+              (set! (lexical l _) (toplevel arg))
+              (void))
+          (apply (primitive @apply) (toplevel f) (lexical l _))))))


hooks/post-receive
-- 
GNU Guile