[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-181-gd646d81

[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=d646d81ec1c9f16a1e4d3f5bd388ec069c47a1c2

The branch, stable-2.0 has been updated
       via  d646d81ec1c9f16a1e4d3f5bd388ec069c47a1c2 (commit)
       via  c3d5344a92d815c855445d82079d1a390b9282c8 (commit)
      from  2b264d7e4fb649955ade1814527b6eb6f34f4e18 (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 d646d81ec1c9f16a1e4d3f5bd388ec069c47a1c2
Author: Andy Wingo <address@hidden>
Date:   Wed Jan 25 10:42:54 2012 +0100

    add another case in which to fold (values FOO) to FOO, for some FOO
    
    * module/language/tree-il/peval.scm (peval): Fold (values
      'singly-valued-expression) to 'singly-valued-expression in contexts
      that expect multiple values, in addition to those that expect single
      values.

commit c3d5344a92d815c855445d82079d1a390b9282c8
Author: Andy Wingo <address@hidden>
Date:   Wed Jan 25 10:37:25 2012 +0100

    fix values miscompilation in push context with RA
    
    * module/language/tree-il/compile-glil.scm (flatten-lambda-case): Fix
      miscompilation of `values' in a push context with RA.
    * test-suite/tests/tree-il.test: Add low-level test for this
      miscompilation.

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

Summary of changes:
 module/language/tree-il/compile-glil.scm |    7 +++----
 module/language/tree-il/peval.scm        |    6 ++++--
 test-suite/tests/tree-il.test            |   21 +++++++++++++++++++--
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index de55026..a9f6df9 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1,6 +1,6 @@
 ;;; TREE-IL -> GLIL compiler
 
-;; Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -341,13 +341,12 @@
                (comp-push proc)
                (emit-code src (make-glil-call 'call 0))
                (maybe-emit-return))
-              ((1)
-               (comp-push (car args)))
               (else
                ;; Taking advantage of unspecified order of evaluation of
                ;; arguments.
                (for-each comp-drop (cdr args))
-               (comp-push (car args)))))
+               (comp-push (car args))
+               (maybe-emit-return))))
            ((vals)
             (for-each comp-push args)
             (emit-code #f (make-glil-const (length args)))
diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index a6bb954..abc0199 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1,6 +1,6 @@
 ;;; Tree-IL partial evaluator
 
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -1011,7 +1011,9 @@ top-level bindings from ENV and return the resulting 
expression."
              exp))
         (else
          (let ((vals (map for-value exps)))
-           (if (and (memq ctx '(value test effect))
+           (if (and (case ctx
+                      ((value test effect) #t)
+                      (else (null? (cdr vals))))
                     (every singly-valued-expression? vals))
                (for-tail (make-sequence src (append (cdr vals) (list (car 
vals)))))
                (make-application src (make-primitive-ref #f 'values) vals))))))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 0b00f6f..bb56c23 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <address@hidden> --- May 2009
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -549,7 +549,24 @@
    (apply (primitive +)
           (apply (primitive values) (const 1) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
-            (const 1) (call return 1))))
+            (const 1) (call return 1)))
+
+  ;; Testing `(values foo)' in push context with RA.
+  (assert-tree-il->glil without-partial-evaluation
+   (apply (primitive cdr)
+          (letrec (lp) (#{lp ~V9KrhVD4PFEL6oCTrLg3A}#)
+                  ((lambda ((name . lp))
+                     (lambda-case ((() #f #f #f () ())
+                                   (apply (toplevel values) (const (one 
two)))))))
+                  (apply (lexical lp #{lp ~V9KrhVD4PFEL6oCTrLg3A}#))))
+   (program () (std-prelude 0 0 #f) (label _)
+            (branch br _) ;; entering the fix, jump to :2
+            ;; :1 body of lp, jump to :3
+            (label _) (bind) (const (one two)) (branch br _) (unbind)
+            ;; :2 initial call of lp, jump to :1
+            (label _) (bind) (branch br _) (label _) (unbind)
+            ;; :3 the push continuation
+            (call cdr 1) (call return 1))))
 
 ;; FIXME: binding info for or-hacked locals might bork the disassembler,
 ;; and could be tightened in any case


hooks/post-receive
-- 
GNU Guile