diff options
| author | Andy Wingo <wingo@pobox.com> | 2020-01-10 21:42:26 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2020-01-10 21:42:26 +0100 |
| commit | 8068994ba859e2a81830b2bd7e71c002e3a79700 (patch) | |
| tree | 1c237bbc52f9c2dda2283e265f8d38b564e3fc48 /module/srfi | |
| parent | 9f2b70310151388791638bf1b7fe8b5237516376 (diff) | |
| download | guile-8068994ba859e2a81830b2bd7e71c002e3a79700.tar.gz | |
Re-implement `guard'
* module/ice-9/exceptions.scm (guard): Add guard definition that
re-propagates from original continuation, runs consequents in tail
position in guard continuation, and doesn't rewind the stack.
* module/srfi/srfi-34.scm:
* module/rnrs/exceptions.scm (guard): Re-export from (ice-9
exceptions).
Diffstat (limited to 'module/srfi')
| -rw-r--r-- | module/srfi/srfi-34.scm | 48 |
1 files changed, 6 insertions, 42 deletions
diff --git a/module/srfi/srfi-34.scm b/module/srfi/srfi-34.scm index 4eb94b443..728b87119 100644 --- a/module/srfi/srfi-34.scm +++ b/module/srfi/srfi-34.scm @@ -1,6 +1,7 @@ ;;; srfi-34.scm --- Exception handling for programs -;; Copyright (C) 2003, 2006, 2008, 2010, 2019 Free Software Foundation, Inc. +;; Copyright (C) 2003,2006,2008-2010,2019-2020 +;; 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 @@ -27,47 +28,10 @@ ;;; Code: (define-module (srfi srfi-34) + #:use-module ((ice-9 exceptions) #:select (guard)) #:re-export (with-exception-handler - (raise-exception . raise)) - #:re-export-and-replace ((raise-exception . raise)) - #:export-syntax (guard)) + (raise-exception . raise) + guard) + #:re-export-and-replace ((raise-exception . raise))) (cond-expand-provide (current-module) '(srfi-34)) - -(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* ...) - (with-exception-handler - (lambda (var) - (cond clause ... - (else e e* ...))) - (lambda () body body* ...) - #:unwind? #t)) - ((guard (var clause clause* ...) body body* ...) - (let ((tag (make-prompt-tag))) - (call-with-prompt - tag - (lambda () - (with-exception-handler - (lambda (exn) - (abort-to-prompt tag exn) - (raise-exception exn)) - (lambda () body body* ...))) - (lambda (rewind var) - (cond clause clause* ... - (else (rewind))))))))) - - -;;; (srfi srfi-34) ends here. |