diff options
author | Andy Wingo <wingo@pobox.com> | 2010-10-14 16:13:57 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-10-14 16:13:57 +0200 |
commit | df6336c0a0bdb6dbdad7d8ba407a7c0377579d9b (patch) | |
tree | fffb032eeaf587bfd9130e16fd4eaa080f99d5f7 | |
parent | 4aaa0650e04d17c86f6e9b47294ca9b623bea029 (diff) | |
download | guile-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.scm | 28 |
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. |