aboutsummaryrefslogtreecommitdiffstats
path: root/lib/scheme/base/30-if.csc
diff options
context:
space:
mode:
authorRose Hogenson <rhogenson@posteo.net>2022-08-05 21:04:49 -0700
committerRose Hogenson <rhogenson@posteo.net>2022-08-05 21:04:49 -0700
commit83a18a658ac925b589d36e37ae150ec986d5eba8 (patch)
treeecea56f73087903aae129bf5b88f8bf2acac6a49 /lib/scheme/base/30-if.csc
parentc458c02f3cbf24770a18e4e0e3ee2854b7bc0377 (diff)
downloadchromatopelma-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.csc29
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 ...) ...))))))))