HCoop / bpt / guile.git / blame
| 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. |