diff options
Diffstat (limited to 'lib/scheme/base/30-if.csc')
| -rw-r--r-- | lib/scheme/base/30-if.csc | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/lib/scheme/base/30-if.csc b/lib/scheme/base/30-if.csc index 09012fa..6262f5a 100644 --- a/lib/scheme/base/30-if.csc +++ b/lib/scheme/base/30-if.csc @@ -1,5 +1,6 @@ (export and + case-lambda cond if or @@ -73,4 +74,30 @@ (syntax-rules () ((unless test result1 result2 ...) (if (not test) - (begin result1 result2 ...)))))) + (begin result1 result2 ...))))) + + + (define-syntax case-lambda + (syntax-rules () + ((case-lambda (params body0 ...) ...) + (lambda args + (let ((len (length args))) + (let-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 ...) ...)))))))) |