>From 67bbafb61f00730853385e54f30e7a3b90fad01d Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Mon, 27 May 2013 14:06:20 +1200 Subject: [PATCH] add => syntax for case clauses Signed-off-by: Christian Kellermann --- expand.scm | 11 +++++++++-- tests/r7rs-tests.scm | 8 ++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/expand.scm b/expand.scm index b278ec0..3688fa2 100644 --- a/expand.scm +++ b/expand.scm @@ -1174,6 +1174,7 @@ (body (cddr form)) ) (let ((tmp (r 'tmp)) (%or (r 'or)) + (%=> (r '=>)) (%eqv? (r 'eqv?)) (%else (r 'else))) `(let ((,tmp ,exp)) @@ -1185,7 +1186,10 @@ (##sys#check-syntax 'case clause '#(_ 1)) (cond ((c %else (car clause)) (expand rclauses #t) - `(##core#begin ,@(cdr clause)) ) + (if (and (fx= (length clause) 3) ; (else => expr) + (c %=> (cadr clause))) + `(,(caddr clause) ,tmp) + `(##core#begin ,@(cdr clause)))) (else? (##sys#notice "non-`else' clause following `else' clause in `case'" @@ -1196,7 +1200,10 @@ `(##core#if (,%or ,@(##sys#map (lambda (x) `(,%eqv? ,tmp ',x)) (car clause))) - (##core#begin ,@(cdr clause)) + ,(if (and (fx= (length clause) 3) ; ((...) => expr) + (c %=> (cadr clause))) + `(,(caddr clause) ,tmp) + `(##core#begin ,@(cdr clause))) ,(expand rclauses #f) ) ) ) ) ) ) ) ) ) ) ) ) (##sys#extend-macro-environment diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm index c0f6ebd..84a95d1 100644 --- a/tests/r7rs-tests.scm +++ b/tests/r7rs-tests.scm @@ -57,6 +57,14 @@ (exit 1))) (newline)) +(SECTION 4 2 1) + +;; case with => clause +(test "a" (lambda () (case 'a ((a) => symbol->string)))) +(test "a" (lambda () (case 'a (else => symbol->string)))) +(test-error condition? (lambda () (case 'a ((a) =>)))) +(test-error condition? (lambda () (case 'a (else =>)))) + (SECTION 4 2 5) -- 1.8.1.2