From e43b8bb2fcd66979dd7d8992a550c1afa239802f Mon Sep 17 00:00:00 2001 From: interp Date: Tue, 8 Jul 2003 23:07:37 +0000 Subject: [PATCH] Rewritten OPTIONALS macro with SYNTAX-RULES. --- scheme/httpd/surflets/typed-optionals.scm | 33 ++++------------------- 1 file changed, 5 insertions(+), 28 deletions(-) diff --git a/scheme/httpd/surflets/typed-optionals.scm b/scheme/httpd/surflets/typed-optionals.scm index 493a569..690826b 100644 --- a/scheme/httpd/surflets/typed-optionals.scm +++ b/scheme/httpd/surflets/typed-optionals.scm @@ -33,32 +33,9 @@ (cdr pred-list) args))))) - (define-syntax optionals - (lambda (exp rename compare) - (let ((%receive (rename 'receive)) - (%typed-optionals (rename 'typed-optionals)) - (%list (rename 'list)) - (%if (rename 'if)) - (%pair? (rename 'pair?)) - (%error (rename 'error)) - (%let (rename 'let)) - (%list-ref (rename 'list-ref)) - - (args (cadr exp)) - (var-list (caddr exp)) - (body (cadddr exp))) - `(,%receive (params rest-args) - (,%typed-optionals (,%list ,@(map cadr var-list)) ,args) - (,%if (pair? rest-args) - (,%error "optionals: too many arguments and/or argument type mismatch" - rest-args) - (,%let (,@(let loop ((counter 0) - (var-list var-list)) - (if (null? var-list) - '() - (cons (cons (caar var-list) `((,%list-ref params ,counter))) - (loop (+ 1 counter) - (cdr var-list)))))) - ,body)))))) - + (syntax-rules () + ((optionals args ((name pred) ...) body) + (receive (params must-be-empty) + (typed-optionals (list pred ...) args) + (apply (lambda (name ...) body) params)))))