Commit | Line | Data |
---|---|---|
a1a5dfa8 NJ |
1 | ;;; srfi-34.scm --- Exception handling for programs |
2 | ||
3 | ;; Copyright (C) 2003 Free Software Foundation, Inc. | |
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 | |
17 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
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 | ||
34 | (define throw-key 'srfi-34) | |
35 | ||
36 | (define (with-exception-handler handler thunk) | |
37 | "Returns the result(s) of invoking THUNK. HANDLER must be a | |
38 | procedure that accepts one argument. It is installed as the current | |
39 | exception handler for the dynamic extent (as determined by | |
40 | dynamic-wind) of the invocation of THUNK." | |
41 | (lazy-catch throw-key | |
42 | thunk | |
43 | (lambda (key obj) | |
44 | (handler obj)))) | |
45 | ||
46 | (define (raise obj) | |
47 | "Invokes the current exception handler on OBJ. The handler is | |
48 | called in the dynamic environment of the call to raise, except that | |
49 | the current exception handler is that in place for the call to | |
50 | with-exception-handler that installed the handler being called. The | |
51 | handler's continuation is otherwise unspecified." | |
52 | (throw throw-key obj)) | |
53 | ||
54 | (define-macro (guard var+clauses . body) | |
55 | "Syntax: (guard (<var> <clause1> <clause2> ...) <body>) | |
56 | Each <clause> should have the same form as a `cond' clause. | |
57 | ||
58 | Semantics: Evaluating a guard form evaluates <body> with an exception | |
59 | handler that binds the raised object to <var> and within the scope of | |
60 | that binding evaluates the clauses as if they were the clauses of a | |
61 | cond expression. That implicit cond expression is evaluated with the | |
62 | continuation and dynamic environment of the guard expression. If | |
63 | every <clause>'s <test> evaluates to false and there is no else | |
64 | clause, then raise is re-invoked on the raised object within the | |
65 | dynamic environment of the original call to raise except that the | |
66 | current exception handler is that of the guard expression." | |
67 | (let ((var (car var+clauses)) | |
68 | (clauses (cdr var+clauses))) | |
69 | `(catch ',throw-key | |
70 | (lambda () | |
71 | ,@body) | |
72 | (lambda (key ,var) | |
73 | (cond ,@(if (eq? (caar (last-pair clauses)) 'else) | |
74 | clauses | |
75 | (append clauses | |
76 | `((else (throw key ,var)))))))))) | |
77 | ||
78 | ;;; (srfi srfi-34) ends here. |