30 lines
1.0 KiB
Scheme
30 lines
1.0 KiB
Scheme
|
(define-library (scheme case-lambda)
|
||
|
|
(import (scheme base))
|
||
|
|
|
||
|
|
(define-syntax case-lambda
|
||
|
|
(syntax-rules ()
|
||
|
|
((case-lambda (params body0 ...) ...)
|
||
|
|
(lambda args
|
||
|
|
(let ((len (length args)))
|
||
|
|
(letrec-syntax
|
||
|
|
((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 . rest))))))
|
||
|
|
(cl (params body0 ...) ...)))))))
|
||
|
|
|
||
|
|
(export case-lambda))
|