mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
84 lines
3.2 KiB
Scheme
84 lines
3.2 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)
|
|
#:export (with-exception-handler)
|
|
#:replace (raise)
|
|
#:export-syntax (guard))
|
|
|
|
(cond-expand-provide (current-module) '(srfi-34))
|
|
|
|
(define throw-key 'srfi-34)
|
|
|
|
(define (with-exception-handler handler thunk)
|
|
"Returns the result(s) of invoking THUNK. HANDLER must be a
|
|
procedure that accepts one argument. It is installed as the current
|
|
exception handler for the dynamic extent (as determined by
|
|
dynamic-wind) of the invocation of THUNK."
|
|
(with-throw-handler throw-key
|
|
thunk
|
|
(lambda (key obj)
|
|
(handler obj))))
|
|
|
|
(define (raise obj)
|
|
"Invokes the current exception handler on OBJ. The handler is
|
|
called in the dynamic environment of the call to raise, except that
|
|
the current exception handler is that in place for the call to
|
|
with-exception-handler that installed the handler being called. The
|
|
handler's continuation is otherwise unspecified."
|
|
(throw throw-key obj))
|
|
|
|
(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* ...)
|
|
(catch throw-key
|
|
(lambda () body body* ...)
|
|
(lambda (key var)
|
|
(cond clause ...
|
|
(else e e* ...)))))
|
|
((guard (var clause clause* ...) body body* ...)
|
|
(catch throw-key
|
|
(lambda () body body* ...)
|
|
(lambda (key var)
|
|
(cond clause clause* ...
|
|
(else (throw key var))))))))
|
|
|
|
|
|
;;; (srfi srfi-34) ends here.
|