syntax-rules: rewrite case-lambda.scm. (p ... . var) pattern is not supported
This commit is contained in:
parent
2c269b4f0e
commit
1570bd1cd4
|
@ -1,28 +1,25 @@
|
|||
(define-library (scheme case-lambda)
|
||||
(import (scheme base))
|
||||
|
||||
(define (length+ list)
|
||||
(if (pair? list)
|
||||
(+ 1 (length+ (cdr list)))
|
||||
0))
|
||||
|
||||
(define-syntax case-lambda
|
||||
(syntax-rules ()
|
||||
((case-lambda (params body0 ...) ...)
|
||||
(lambda args
|
||||
(let ((len (length args)))
|
||||
(letrec-syntax
|
||||
((cl (syntax-rules ::: ()
|
||||
((cl (syntax-rules ()
|
||||
((cl)
|
||||
(error "no matching clause"))
|
||||
((cl ((p :::) . body) . rest)
|
||||
(if (= len (length '(p :::)))
|
||||
(apply (lambda (p :::)
|
||||
. body)
|
||||
args)
|
||||
(cl . rest)))
|
||||
((cl ((p ::: . tail) . body)
|
||||
. rest)
|
||||
(if (>= len (length '(p :::)))
|
||||
(apply
|
||||
(lambda (p ::: . tail)
|
||||
. body)
|
||||
args)
|
||||
((cl (formal . body) . rest)
|
||||
(if (if (list? 'formal)
|
||||
(= len (length 'formal))
|
||||
(>= len (length+ 'formal)))
|
||||
(apply (lambda formal . body) args)
|
||||
(cl . rest))))))
|
||||
(cl (params body0 ...) ...)))))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue