guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-138-g9dadf


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-138-g9dadfa4
Date: Sun, 27 Mar 2011 13:00:51 +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=9dadfa47b07548ff5cf3604067910c8aece93c42

The branch, stable-2.0 has been updated
       via  9dadfa47b07548ff5cf3604067910c8aece93c42 (commit)
       via  62f528e929368ddce77f550168c229177793d854 (commit)
       via  8e9af8541253577c15c94455ef31c762071aae64 (commit)
      from  96c71c589a866e41b3a95ccc90318c6a28e42004 (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 9dadfa47b07548ff5cf3604067910c8aece93c42
Author: Andy Wingo <address@hidden>
Date:   Sun Mar 27 15:00:18 2011 +0200

    fix prompt in fix in single-value context compilation
    
    * module/language/tree-il/compile-glil.scm (flatten): When compiling a
      <prompt> in push context with an RA, after the body returns normally,
      jump to that RA instead of to our POST label (which in that case does
      not need to be emitted).  Fixes a tail <prompt> in a push <fix>.
    
    * test-suite/tests/control.test ("prompt in different contexts"): Add
      more test cases.

commit 62f528e929368ddce77f550168c229177793d854
Author: Andy Wingo <address@hidden>
Date:   Sun Mar 27 14:44:20 2011 +0200

    tree-il->scheme fix
    
    * module/language/tree-il.scm (tree-il->scheme): Fix <prompt> to Scheme
      serialization.

commit 8e9af8541253577c15c94455ef31c762071aae64
Author: Noah Lavine <address@hidden>
Date:   Fri Mar 11 11:45:33 2011 -0500

    Document SRFI-23
    
     * doc/ref/srfi-modules.texi: mention that we support SRFI 23
     * module/ice-9/boot-9.scm (%cond-expand-features): add srfi-23

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

Summary of changes:
 doc/ref/srfi-modules.texi                |    6 ++
 module/ice-9/boot-9.scm                  |    1 +
 module/language/tree-il.scm              |    7 +-
 module/language/tree-il/compile-glil.scm |    8 +-
 test-suite/tests/control.test            |   95 ++++++++++++++++++++++++++++++
 5 files changed, 110 insertions(+), 7 deletions(-)

diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index eab8779..a5b9740 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -35,6 +35,7 @@ get the relevant SRFI documents from the SRFI home page
 * SRFI-17::                     Generalized set!
 * SRFI-18::                     Multithreading support
 * SRFI-19::                     Time/Date library.
+* SRFI-23::                     Error reporting
 * SRFI-26::                     Specializing parameters
 * SRFI-27::                     Sources of Random Bits
 * SRFI-30::                     Nested multi-line block comments
@@ -3135,6 +3136,11 @@ Conversion is locale-dependent on systems that support it
 locale.
 @end defun
 
address@hidden SRFI-23
address@hidden SRFI-23 - Error Reporting
address@hidden SRFI-23
+
+The SRFI-23 @code{error} procedure is always available.
 
 @node SRFI-26
 @subsection SRFI-26 - specializing parameters
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a0b207c..33aa333 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3404,6 +3404,7 @@ module '(ice-9 q) '(make-q q-length))}."
     srfi-4   ;; homogenous numeric vectors
     srfi-6   ;; open-input-string etc, in the guile core
     srfi-13  ;; string library
+    srfi-23  ;; `error` procedure
     srfi-14  ;; character sets
     srfi-55  ;; require-extension
     srfi-61  ;; general cond clause
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 5fd4c12..221cf26 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -1,4 +1,4 @@
-;;;;   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
@@ -471,8 +471,9 @@
      `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp)))
 
     ((<prompt> tag body handler)
-     `((@ (ice-9 control) prompt)
-       ,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body))
+     `(call-with-prompt
+       ,(tree-il->scheme tag)
+       (lambda () ,(tree-il->scheme body))
        ,(tree-il->scheme handler)))
 
 
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 23648cd..f193e9d 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 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,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
@@ -1095,7 +1095,7 @@
             ;; post
             (comp-push body)
             (emit-code #f (make-glil-call 'unwind 0))
-            (emit-branch #f 'br POST))
+            (emit-branch #f 'br (or RA POST)))
            
            ((vals)
             (let ((MV (make-label)))
@@ -1138,8 +1138,8 @@
             (comp-tail body)
             (emit-code #f (make-glil-unbind))))
 
-         (if (or (eq? context 'push)
-                 (and (eq? context 'drop) (not RA)))
+         (if (and (not RA)
+                  (or (eq? context 'push) (eq? context 'drop)))
              (emit-label POST))))
 
       ((<abort> src tag args tail)
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index ce2e1bf..6f1804a 100644
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -178,6 +178,101 @@
       (eq? (k 'xyzzy)
            'xyzzy))))
 
+;; Here we test different cases for the `prompt'.
+(with-test-prefix/c&e "prompt in different contexts"
+  (pass-if "push, normal exit"
+    (car (call-with-prompt
+          'foo
+          (lambda () '(#t))
+          (lambda (k) '(#f)))))
+
+  (pass-if "push, nonlocal exit"
+    (car (call-with-prompt
+          'foo
+          (lambda () (abort-to-prompt 'foo) '(#f))
+          (lambda (k) '(#t)))))
+
+  (pass-if "push with RA, normal exit"
+    (car (letrec ((test (lambda ()
+                          (call-with-prompt
+                           'foo
+                           (lambda () '(#t))
+                           (lambda (k) '(#f))))))
+           (test))))
+
+  (pass-if "push with RA, nonlocal exit"
+    (car (letrec ((test (lambda ()
+                          (call-with-prompt
+                           'foo
+                           (lambda () (abort-to-prompt 'foo) '(#f))
+                           (lambda (k) '(#t))))))
+           (test))))
+
+  (pass-if "tail, normal exit"
+    (call-with-prompt
+     'foo
+     (lambda () #t)
+     (lambda (k) #f)))
+
+  (pass-if "tail, nonlocal exit"
+    (call-with-prompt
+     'foo
+     (lambda () (abort-to-prompt 'foo) #f)
+     (lambda (k) #t)))
+
+  (pass-if "tail with RA, normal exit"
+    (letrec ((test (lambda ()
+                     (call-with-prompt
+                      'foo
+                      (lambda () #t)
+                      (lambda (k) #f)))))
+      (test)))
+
+  (pass-if "tail with RA, nonlocal exit"
+    (letrec ((test (lambda ()
+                     (call-with-prompt
+                      'foo
+                      (lambda () (abort-to-prompt 'foo) #f)
+                      (lambda (k) #t)))))
+      (test)))
+
+  (pass-if "drop, normal exit"
+    (begin
+      (call-with-prompt
+       'foo
+       (lambda () #f)
+       (lambda (k) #f))
+      #t))
+
+  (pass-if "drop, nonlocal exit"
+    (begin
+      (call-with-prompt
+       'foo
+       (lambda () (abort-to-prompt 'foo))
+       (lambda (k) #f))
+      #t))
+
+  (pass-if "drop with RA, normal exit"
+    (begin
+      (letrec ((test (lambda ()
+                       (call-with-prompt
+                        'foo
+                        (lambda () #f)
+                        (lambda (k) #f)))))
+        (test))
+      #t))
+
+  (pass-if "drop with RA, nonlocal exit"
+    (begin
+      (letrec ((test (lambda ()
+                       (call-with-prompt
+                        'foo
+                        (lambda () (abort-to-prompt 'foo) #f)
+                        (lambda (k) #f)))))
+        (test))
+      #t)))
+
+
 (define fl (make-fluid))
 (fluid-set! fl 0)
 


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]