Commit | Line | Data |
---|---|---|
a1a5dfa8 NJ |
1 | ;;; srfi-34.scm --- Exception handling for programs |
2 | ||
1b09b607 | 3 | ;; Copyright (C) 2003, 2006 Free Software Foundation, Inc. |
a1a5dfa8 NJ |
4 | ;; |
5 | ;; This library is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU Lesser General Public | |
7 | ;; License as published by the Free Software Foundation; either | |
8 | ;; version 2.1 of the License, or (at your option) any later version. | |
9 | ;; | |
10 | ;; This library is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;; Lesser General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU Lesser General Public | |
16 | ;; License along with this library; if not, write to the Free Software | |
92205699 | 17 | ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
a1a5dfa8 NJ |
18 | |
19 | ;;; Author: Neil Jerram <neil@ossau.uklinux.net> | |
20 | ||
21 | ;;; Commentary: | |
22 | ||
23 | ;; This is an implementation of SRFI-34: Exception Handling for | |
24 | ;; Programs. For documentation please see the SRFI-34 document; this | |
25 | ;; module is not yet documented at all in the Guile manual. | |
26 | ||
27 | ;;; Code: | |
28 | ||
29 | (define-module (srfi srfi-34) | |
30 | #:export (with-exception-handler | |
31 | raise) | |
32 | #:export-syntax (guard)) | |
33 | ||
af2cc719 KR |
34 | (cond-expand-provide (current-module) '(srfi-34)) |
35 | ||
a1a5dfa8 NJ |
36 | (define throw-key 'srfi-34) |
37 | ||
38 | (define (with-exception-handler handler thunk) | |
39 | "Returns the result(s) of invoking THUNK. HANDLER must be a | |
40 | procedure that accepts one argument. It is installed as the current | |
41 | exception handler for the dynamic extent (as determined by | |
42 | dynamic-wind) of the invocation of THUNK." | |
43 | (lazy-catch throw-key | |
44 | thunk | |
45 | (lambda (key obj) | |
46 | (handler obj)))) | |
47 | ||
48 | (define (raise obj) | |
49 | "Invokes the current exception handler on OBJ. The handler is | |
50 | called in the dynamic environment of the call to raise, except that | |
51 | the current exception handler is that in place for the call to | |
52 | with-exception-handler that installed the handler being called. The | |
53 | handler's continuation is otherwise unspecified." | |
54 | (throw throw-key obj)) | |
55 | ||
56 | (define-macro (guard var+clauses . body) | |
57 | "Syntax: (guard (<var> <clause1> <clause2> ...) <body>) | |
58 | Each <clause> should have the same form as a `cond' clause. | |
59 | ||
60 | Semantics: Evaluating a guard form evaluates <body> with an exception | |
61 | handler that binds the raised object to <var> and within the scope of | |
62 | that binding evaluates the clauses as if they were the clauses of a | |
63 | cond expression. That implicit cond expression is evaluated with the | |
64 | continuation and dynamic environment of the guard expression. If | |
65 | every <clause>'s <test> evaluates to false and there is no else | |
66 | clause, then raise is re-invoked on the raised object within the | |
67 | dynamic environment of the original call to raise except that the | |
68 | current exception handler is that of the guard expression." | |
69 | (let ((var (car var+clauses)) | |
70 | (clauses (cdr var+clauses))) | |
71 | `(catch ',throw-key | |
72 | (lambda () | |
73 | ,@body) | |
74 | (lambda (key ,var) | |
75 | (cond ,@(if (eq? (caar (last-pair clauses)) 'else) | |
76 | clauses | |
77 | (append clauses | |
78 | `((else (throw key ,var)))))))))) | |
79 | ||
80 | ;;; (srfi srfi-34) ends here. |