[bpt/guile.git] / module / srfi / srfi-34.scm

;;; 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.
Commit	Line	Data
a1a5dfa8 NJ	1	;;; srfi-34.scm --- Exception handling for programs
a1a5dfa8 NJ	2
de976b75	3	;; Copyright (C) 2003, 2006, 2008, 2010 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
83ba2d37	8	;; version 3 of the License, or (at your option) any later version.
a1a5dfa8 NJ	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)
de976b75 AW	30	#:export (with-exception-handler)
de976b75 AW	31	#:replace (raise)
a1a5dfa8 NJ	32	#:export-syntax (guard))
a1a5dfa8 NJ	33
af2cc719 KR	34	(cond-expand-provide (current-module) '(srfi-34))
af2cc719 KR	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."
76350432	43	(with-throw-handler throw-key
a1a5dfa8 NJ	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
df6336c0 AW	56	(define-syntax guard
	57	(syntax-rules (else)
	58	"Syntax: (guard (<var> <clause1> <clause2> ...) <body>)
a1a5dfa8 NJ	59	Each <clause> should have the same form as a `cond' clause.
	60
	61	Semantics: Evaluating a guard form evaluates <body> with an exception
	62	handler that binds the raised object to <var> and within the scope of
	63	that binding evaluates the clauses as if they were the clauses of a
	64	cond expression. That implicit cond expression is evaluated with the
	65	continuation and dynamic environment of the guard expression. If
	66	every <clause>'s <test> evaluates to false and there is no else
	67	clause, then raise is re-invoked on the raised object within the
	68	dynamic environment of the original call to raise except that the
	69	current exception handler is that of the guard expression."
df6336c0 AW	70	((guard (var clause ... (else e e* ...)) body body* ...)
	71	(catch throw-key
	72	(lambda () body body* ...)
	73	(lambda (key var)
	74	(cond clause ...
	75	(else e e* ...)))))
	76	((guard (var clause clause* ...) body body* ...)
	77	(catch throw-key
	78	(lambda () body body* ...)
	79	(lambda (key var)
	80	(cond clause clause* ...
	81	(else (throw key var))))))))
	82
a1a5dfa8 NJ	83
a1a5dfa8 NJ	84	;;; (srfi srfi-34) ends here.