[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-130-gb88fef5

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

The branch, stable-2.0 has been updated
       via  b88fef5519fab447c6c5405928c248f9f0966148 (commit)
       via  f86f748db26eba15ca71e65b3e084a2fcbf8c3ac (commit)
      from  669ea4ebff8f0eb69b36f3d55b60e69f9f27c761 (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 b88fef5519fab447c6c5405928c248f9f0966148
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 17 19:30:31 2011 +0200

    fix invalid transformation of (values x) -> x, (+ x) -> x, etc
    
    * module/language/tree-il/primitives.scm (+, *, cons*): In the case of
      just one argument (the identity case), expand to (values x) instead of
      just x.  Fixes values truncation in that case.
      (values): Likewise remove (values x) -> x translation, as the compiler
      will do it for us, and this fixes (values (values 1 2)).
    
    * module/language/tree-il/compile-glil.scm (flatten-lambda-case): Handle
      `values' in a push context here.
    
    * test-suite/tests/tree-il.test ("values"): Add some tests.

commit f86f748db26eba15ca71e65b3e084a2fcbf8c3ac
Author: Andy Wingo <address@hidden>
Date:   Fri Jun 17 19:16:16 2011 +0200

    add -Wformat to %auto-compilation-options
    
    * module/ice-9/boot-9.scm (%auto-compilation-options): Add -Wformat to
      the default warning set.

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

Summary of changes:
 module/ice-9/boot-9.scm                  |    2 +-
 module/language/tree-il/compile-glil.scm |   24 +++++++++++++++++++++---
 module/language/tree-il/primitives.scm   |   10 ++++------
 test-suite/tests/tree-il.test            |   20 ++++++++++++++++++++
 4 files changed, 46 insertions(+), 10 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f31cffb..a70b9f7 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3447,7 +3447,7 @@ module '(ice-9 q) '(make-q q-length))}."
 
 (define %auto-compilation-options
   ;; Default `compile-file' option when auto-compiling.
-  '(#:warnings (unbound-variable arity-mismatch)))
+  '(#:warnings (unbound-variable arity-mismatch format)))
 
 (define* (load-in-vicinity dir path #:optional reader)
   ;; Returns the .go file corresponding to `name'. Does not search load
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index b137afa..518823d 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -305,21 +305,39 @@
                                    (cons proc args)))
                 (maybe-emit-return)))))))
         
-        ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
-              (not (eq? context 'push)))
+        ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values))
          ;; tail: (lambda () (values '(1 2)))
          ;; drop: (lambda () (values '(1 2)) 3)
          ;; push: (lambda () (list (values '(10 12)) 1))
          ;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
          (case context
            ((drop) (for-each comp-drop args) (maybe-emit-return))
+           ((push)
+            (case (length args)
+              ((0)
+               ;; FIXME: This is surely an error.  We need to add a
+               ;; values-mismatch warning pass.
+               (emit-code src (make-glil-call 'new-frame 0))
+               (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)))))
            ((vals)
             (for-each comp-push args)
             (emit-code #f (make-glil-const (length args)))
             (emit-branch src 'br MVRA))
            ((tail)
             (for-each comp-push args)
-            (emit-code src (make-glil-call 'return/values (length args))))))
+            (emit-code src (let ((len (length args)))
+                             (if (= len 1)
+                                 (make-glil-call 'return 1)
+                                 (make-glil-call 'return/values len)))))))
         
         ((and (primitive-ref? proc)
               (eq? (primitive-ref-name proc) '@call-with-values)
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 316a462..d21fc73 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
 ;;; open-coding primitive procedures
 
-;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011 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
@@ -248,7 +248,7 @@
 
 (define-primitive-expander +
   () 0
-  (x) x
+  (x) (values x)
   (x y) (if (and (const? y)
                  (let ((y (const-exp y)))
                    (and (number? y) (exact? y) (= y 1))))
@@ -266,7 +266,7 @@
   
 (define-primitive-expander *
   () 1
-  (x) x
+  (x) (values x)
   (x y z . rest) (* x (* y z . rest)))
   
 (define-primitive-expander -
@@ -312,7 +312,7 @@
 (define-primitive-expander cddddr (x) (cdr (cdr (cdr (cdr x)))))
 
 (define-primitive-expander cons*
-  (x) x
+  (x) (values x)
   (x y) (cons x y)
   (x y . rest) (cons x (cons* y . rest)))
 
@@ -331,8 +331,6 @@
 (define-primitive-expander call/cc (proc)
   (@call-with-current-continuation proc))
 
-(define-primitive-expander values (x) x)
-
 (define-primitive-expander make-struct (vtable tail-size . args)
   (if (and (const? tail-size)
            (let ((n (const-exp tail-size)))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 1b86b99..2dce471 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -474,6 +474,26 @@
    (program () (std-prelude 0 0 #f) (label _)
             (const 2) (call null? 1) (call return 1))))
 
+(with-test-prefix "values"
+  (assert-tree-il->glil
+   (apply (primitive values)
+          (apply (primitive values) (const 1) (const 2)))
+   (program () (std-prelude 0 0 #f) (label _)
+            (const 1) (call return 1)))
+
+  (assert-tree-il->glil
+   (apply (primitive values)
+          (apply (primitive values) (const 1) (const 2))
+          (const 3))
+   (program () (std-prelude 0 0 #f) (label _)
+            (const 1) (const 3) (call return/values 2)))
+
+  (assert-tree-il->glil
+   (apply (primitive +)
+          (apply (primitive values) (const 1) (const 2)))
+   (program () (std-prelude 0 0 #f) (label _)
+            (const 1) (call return 1))))
+
 ;; FIXME: binding info for or-hacked locals might bork the disassembler,
 ;; and could be tightened in any case
 (with-test-prefix "the or hack"


hooks/post-receive
-- 
GNU Guile