[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: all tests passing
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: all tests passing |
Date: |
Mon, 11 Nov 2019 15:09:45 -0500 (EST) |
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?)