mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
f4ca107f7f
* libguile/exceptions.c:
* libguile/exceptions.h: New files.
* libguile.h: Add exceptions.h.
* libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES):
(DOT_X_FILES, DOT_DOC_FILES, modinclude_HEADERS): Add exceptions.c and
exceptions.h.
* libguile/init.c (scm_i_init_guile): Initialize exceptions.
* libguile/threads.c (scm_spawn_thread): Use new names for
scm_i_make_catch_handler and scm_c_make_thunk.
* libguile/throw.c: Rewrite to be implemented in terms of
with-exception-handler / raise-exception.
* libguile/throw.h: Use data types from exceptions.h. Move
scm_report_stack_overflow and scm_report_out_of_memory to
exceptions.[ch].
* module/ice-9/boot-9.scm (&error, &programming-error)
(&non-continuable, make-exception-from-throw, raise-exception)
(with-exception-handler): New top-level definitions.
(throw, catch, with-throw-handler): Rewrite in terms of
with-exception-handler and raise-exception.
: New top-level definitions.
* module/ice-9/exceptions.scm: Adapt to re-export &error,
&programming-error, &non-continuable, raise-exception, and
with-exception-handler from boot-9.
(make-quit-exception, guile-quit-exception-converter): New exception
converters.
(make-exception-from-throw): Override core binding.
* test-suite/tests/eval.test ("inner trim with prompt tag"): Adapt to
"with-exception-handler" being the procedure on the stack.
("outer trim with prompt tag"): Likewise.
* test-suite/tests/exceptions.test (throw-test): Use pass-if-equal.
* module/srfi/srfi-34.scm: Reimplement in terms of core exceptions, and
make "guard" actually re-raise continuations with the original "raise"
continuation.
72 lines
2.7 KiB
Scheme
72 lines
2.7 KiB
Scheme
;;; srfi-34.scm --- Exception handling for programs
|
|
|
|
;; Copyright (C) 2003, 2006, 2008, 2010 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
|
|
;; License as published by the Free Software Foundation; either
|
|
;; version 3 of the License, or (at your option) any later version.
|
|
;;
|
|
;; This library is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;; Lesser General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU Lesser General Public
|
|
;; License along with this library; if not, write to the Free Software
|
|
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
;;; Author: Neil Jerram <neil@ossau.uklinux.net>
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is an implementation of SRFI-34: Exception Handling for
|
|
;; Programs. For documentation please see the SRFI-34 document; this
|
|
;; module is not yet documented at all in the Guile manual.
|
|
|
|
;;; Code:
|
|
|
|
(define-module (srfi srfi-34)
|
|
#:re-export (with-exception-handler
|
|
(raise-exception . raise))
|
|
#:export-syntax (guard))
|
|
|
|
(cond-expand-provide (current-module) '(srfi-34))
|
|
|
|
(define-syntax guard
|
|
(syntax-rules (else)
|
|
"Syntax: (guard (<var> <clause1> <clause2> ...) <body>)
|
|
Each <clause> should have the same form as a `cond' clause.
|
|
|
|
Semantics: Evaluating a guard form evaluates <body> with an exception
|
|
handler that binds the raised object to <var> and within the scope of
|
|
that binding evaluates the clauses as if they were the clauses of a
|
|
cond expression. That implicit cond expression is evaluated with the
|
|
continuation and dynamic environment of the guard expression. If
|
|
every <clause>'s <test> evaluates to false and there is no else
|
|
clause, then raise is re-invoked on the raised object within the
|
|
dynamic environment of the original call to raise except that the
|
|
current exception handler is that of the guard expression."
|
|
((guard (var clause ... (else e e* ...)) body body* ...)
|
|
(with-exception-handler
|
|
(lambda (var)
|
|
(cond clause ...
|
|
(else e e* ...)))
|
|
(lambda () body body* ...)
|
|
#:unwind? #t))
|
|
((guard (var clause clause* ...) body body* ...)
|
|
(let ((tag (make-prompt-tag)))
|
|
(call-with-prompt
|
|
tag
|
|
(lambda ()
|
|
(with-exception-handler
|
|
(lambda (exn)
|
|
(abort-to-prompt tag exn)
|
|
(raise-exception exn))
|
|
(lambda () body body* ...)))
|
|
(lambda (rewind var)
|
|
(cond clause clause* ...
|
|
(else (rewind)))))))))
|
|
|
|
|
|
;;; (srfi srfi-34) ends here.
|