[Guile-commits] 01/01: all tests passing

[Andy Wingo]

wingo pushed a commit to branch wip-exceptions
in repository guile.

commit f59a337bdd052056646a017677d8527c9f885c30
Author: Andy Wingo <address@hidden>
Date:   Mon Nov 11 21:09:36 2019 +0100

    all tests passing
---
 module/ice-9/boot-9.scm     | 10 +++++++++-
 module/ice-9/exceptions.scm | 32 +++++++++++++++++++++-----------
 2 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 3a3fd1c..a75676b 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1507,6 +1507,13 @@ exception composed of such an instance."
                       '((immutable code))
                       #:parent &exception #:extensible? #f))
 
+  (define &error
+    (make-exception-type '&error &exception '()))
+  (define &programming-error
+    (make-exception-type '&programming-error &error '()))
+  (define &non-continuable
+    (make-exception-type '&non-continuable &programming-error '()))
+
   ;; Boot definition; overridden later.
   (define-values* (make-exception-from-throw)
     (define make-exception-with-kind-and-args
@@ -1626,7 +1633,8 @@ exception composed of such an instance."
                 (handler exn))
                (else
                 (handler exn)
-                (error "this should be a not-continuable error")))))))))
+                (raise-exception
+                 ((record-constructor &non-continuable)))))))))))
 
     (define* (with-exception-handler handler thunk #:key (unwind? #f)
                                      (unwind-for-type #t))
diff --git a/module/ice-9/exceptions.scm b/module/ice-9/exceptions.scm
index 8b1c1e7..f9fe2fb 100644
--- a/module/ice-9/exceptions.scm
+++ b/module/ice-9/exceptions.scm
@@ -32,6 +32,10 @@
                exception-predicate
                exception-accessor
 
+               &error
+               &programming-error
+               &non-continuable
+
                raise-exception
                with-exception-handler)
   #:export (define-exception-type
@@ -45,7 +49,6 @@
             make-warning
             warning?
 
-            &error
             make-error
             error?
 
@@ -53,8 +56,7 @@
            make-external-error
            external-error?
        
-            &programming-error
-           make-programming-error
+            make-programming-error
            programming-error?
 
            &assertion-failure
@@ -71,7 +73,6 @@
             exception-with-origin?
            exception-origin
 
-            &non-continuable
             make-non-continuable-error
             non-continuable-error?
 
@@ -95,14 +96,11 @@
 
             raise-continuable))
 
-(define-syntax define-exception-type
+(define-syntax define-exception-type-procedures
   (syntax-rules ()
     ((_ exception-type supertype constructor predicate
        (field accessor) ...)
      (begin
-       (define exception-type
-         (make-record-type 'exception-type '((immutable field) ...)
-                           #:parent supertype #:extensible? #t))
        (define constructor (record-constructor exception-type))
        (define predicate (exception-predicate exception-type))
        (define accessor
@@ -110,10 +108,22 @@
                              (record-accessor exception-type 'field)))
        ...))))
 
-(define-exception-type &error &exception
+(define-syntax define-exception-type
+  (syntax-rules ()
+    ((_ exception-type supertype constructor predicate
+       (field accessor) ...)
+     (begin
+       (define exception-type
+         (make-record-type 'exception-type '((immutable field) ...)
+                           #:parent supertype #:extensible? #t))
+       (define-exception-type-procedures exception-type supertype
+         constructor predicate (field accessor) ...)))))
+
+(define-exception-type-procedures &error &exception
   make-error error?)
-(define-exception-type &programming-error &error
+(define-exception-type-procedures &programming-error &error
   make-programming-error programming-error?)
+
 (define-exception-type &assertion-failure &programming-error
   make-assertion-failure assertion-failure?)
 
@@ -135,7 +145,7 @@
   make-exception-with-origin exception-with-origin?
   (origin exception-origin))
 
-(define-exception-type &non-continuable &programming-error
+(define-exception-type-procedures &non-continuable &programming-error
   make-non-continuable-error
   non-continuable-error?)