[Guile-commits] GNU Guile branch, syncase-in-boot-9, updated. 30a5e062d022aafdb72cea648f3a4de0e72feb6d

[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=30a5e062d022aafdb72cea648f3a4de0e72feb6d

The branch, syncase-in-boot-9 has been updated
       via  30a5e062d022aafdb72cea648f3a4de0e72feb6d (commit)
      from  a48358b38fed9486cebf7f8338dc05adc770fc0f (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 30a5e062d022aafdb72cea648f3a4de0e72feb6d
Author: Andy Wingo <address@hidden>
Date:   Thu May 21 17:22:58 2009 +0200

    procedures in "drop" contexts can return unspecified values
    
    * module/language/tree-il/compile-glil.scm (flatten): For applications in
      "drop" context, allow the procedure to return unspecified values
      (including 0 values).
    
    * test-suite/tests/tree-il.test ("application"): Adapt test.
    
    * module/srfi/srfi-18.scm (wrap): Clarify.
    
    * test-suite/tests/srfi-18.test: Fix so that the expression importing
      srfi-18 is expanded before the tests. However the tests are still
      failing, something about 0-valued returns...

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

Summary of changes:
 module/language/tree-il/compile-glil.scm |    9 +++++++--
 module/srfi/srfi-18.scm                  |    4 ++--
 test-suite/tests/srfi-18.test            |    9 +++++++--
 test-suite/tests/tree-il.test            |    8 +++++---
 4 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 226b7d4..d5073ed 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -272,8 +272,13 @@
            (case context
              ((tail) (emit-code src (make-glil-call 'goto/args len)))
              ((push) (emit-code src (make-glil-call 'call len)))
-             ((drop) (emit-code src (make-glil-call 'call len))
-                     (emit-code src (make-glil-call 'drop 1))))))))
+             ((drop)
+              (let ((MV (make-label)))
+                (emit-code src (make-glil-mv-call len MV))
+                (emit-code #f (make-glil-const 1))
+                (emit-label MV)
+                (emit-code #f (make-glil-mv-bind '() #f))
+                (emit-code #f (make-glil-unbind)))))))))
 
       ((<conditional> src test then else)
        ;;     TEST
diff --git a/module/srfi/srfi-18.scm b/module/srfi/srfi-18.scm
index 925ecb3..75f1088 100644
--- a/module/srfi/srfi-18.scm
+++ b/module/srfi/srfi-18.scm
@@ -249,8 +249,8 @@
 (define (wrap thunk)
   (lambda (continuation)
     (with-exception-handler (lambda (obj)
-                             (apply (current-exception-handler) (list obj))
-                             (apply continuation (list)))
+                             ((current-exception-handler) obj)
+                             (continuation))
                            thunk)))
 
 ;; A pass-thru to cancel-thread that first installs a handler that throws
diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test
index fa309e6..3c70906 100644
--- a/test-suite/tests/srfi-18.test
+++ b/test-suite/tests/srfi-18.test
@@ -21,8 +21,13 @@
 (define-module (test-suite test-srfi-18)
   #:use-module (test-suite lib))
 
-(and (provided? 'threads)
-     (use-modules (srfi srfi-18))
+;; two expressions so that the srfi-18 import is in effect for expansion
+;; of the rest
+(if (provided? 'threads)
+    (use-modules (srfi srfi-18)))
+
+(and
+ (provided? 'threads)
 
 (with-test-prefix "current-thread"
 
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 873051f..724ea79 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -68,10 +68,12 @@
   (assert-tree-il->glil
    (apply (toplevel foo) (const 1))
    (program 0 0 0 0 () (toplevel ref foo) (const 1) (call goto/args 1)))
-  (assert-tree-il->glil
+  (assert-tree-il->glil/pmatch
    (begin (apply (toplevel foo) (const 1)) (void))
-   (program 0 0 0 0 () (toplevel ref foo) (const 1) (call call 1)
-            (call drop 1) (void) (call return 1)))
+   (program 0 0 0 0 () (toplevel ref foo) (const 1) (mv-call 1 ,l1)
+            (const 1) (label ,l2) (mv-bind () #f) (unbind)
+            (void) (call return 1))
+   (eq? l1 l2))
   (assert-tree-il->glil
    (apply (toplevel foo) (apply (toplevel bar)))
    (program 0 0 0 0 () (toplevel ref foo) (toplevel ref bar) (call call 0)


hooks/post-receive
-- 
GNU Guile