scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rewritten OPTIONALS macro with SYNTAX-RULES.

This commit is contained in:
interp 2003-07-08 23:07:37 +00:00
parent 3384fdd920
commit e43b8bb2fc
1 changed files with 5 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
scheme/httpd/surflets/typed-optionals.scm
View File

@ -33,32 +33,9 @@
(cdr pred-list) (cdr pred-list)
args))))) args)))))
(define-syntax optionals (define-syntax optionals
(lambda (exp rename compare) (syntax-rules ()
(let ((%receive (rename 'receive)) ((optionals args ((name pred) ...) body)
(%typed-optionals (rename 'typed-optionals)) (receive (params must-be-empty)
(%list (rename 'list)) (typed-optionals (list pred ...) args)
(%if (rename 'if)) (apply (lambda (name ...) body) params)))))
(%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))))))