diff options
| author | Rose Hogenson <rhogenson@posteo.net> | 2022-08-05 21:04:49 -0700 |
|---|---|---|
| committer | Rose Hogenson <rhogenson@posteo.net> | 2022-08-05 21:04:49 -0700 |
| commit | 83a18a658ac925b589d36e37ae150ec986d5eba8 (patch) | |
| tree | ecea56f73087903aae129bf5b88f8bf2acac6a49 /lib/scheme/base/30-if.csc | |
| parent | c458c02f3cbf24770a18e4e0e3ee2854b7bc0377 (diff) | |
| download | chromatopelma-83a18a658ac925b589d36e37ae150ec986d5eba8.tar.zst | |
Add more of the standard library.
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 ...) ...)))))))) |
