[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-130-gb88fe
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-130-gb88fef5 |
Date: |
Fri, 17 Jun 2011 17:43:24 +0000 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.1-130-gb88fef5,
Andy Wingo <=