summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-10-14 16:13:57 +0200
committerAndy Wingo <wingo@pobox.com>2010-10-14 16:13:57 +0200
commitdf6336c0a0bdb6dbdad7d8ba407a7c0377579d9b (patch)
treefffb032eeaf587bfd9130e16fd4eaa080f99d5f7
parent4aaa0650e04d17c86f6e9b47294ca9b623bea029 (diff)
downloadguile-df6336c0a0bdb6dbdad7d8ba407a7c0377579d9b.tar.gz
re-implement srfi-34's guard with syntax-case
* module/srfi/srfi-34.scm (guard): Re-implement using syntax-case.
-rw-r--r--module/srfi/srfi-34.scm28
1 files changed, 16 insertions, 12 deletions
diff --git a/module/srfi/srfi-34.scm b/module/srfi/srfi-34.scm
index f30bdfdd1..05bbdfa14 100644
--- a/module/srfi/srfi-34.scm
+++ b/module/srfi/srfi-34.scm
@@ -53,8 +53,9 @@ with-exception-handler that installed the handler being called. The
handler's continuation is otherwise unspecified."
(throw throw-key obj))
-(define-macro (guard var+clauses . body)
- "Syntax: (guard (<var> <clause1> <clause2> ...) <body>)
+(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
@@ -66,15 +67,18 @@ 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."
- (let ((var (car var+clauses))
- (clauses (cdr var+clauses)))
- `(catch ',throw-key
- (lambda ()
- ,@body)
- (lambda (key ,var)
- (cond ,@(if (eq? (caar (last-pair clauses)) 'else)
- clauses
- (append clauses
- `((else (throw key ,var))))))))))
+ ((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.