From 7acf7695f54ee6074e742bf23266ceffe68f62c6 Mon Sep 17 00:00:00 2001
From: Darcy Shen <da@liii.pro>
Date: Wed, 10 Jul 2024 20:44:08 +0800
Subject: [PATCH] SRFI 16: case-lambda

---
 scheme/case-lambda-test.scm | 34 ++++++++++++++++++++++++++++++++++
 scheme/case-lambda.scm      | 22 ++++++++++++++++++++++
 srfi/srfi-16-test.scm       | 34 ++++++++++++++++++++++++++++++++++
 srfi/srfi-16.scm            | 20 ++++++++++++++++++++
 4 files changed, 110 insertions(+)
 create mode 100644 scheme/case-lambda-test.scm
 create mode 100644 scheme/case-lambda.scm
 create mode 100644 srfi/srfi-16-test.scm
 create mode 100644 srfi/srfi-16.scm

diff --git a/scheme/case-lambda-test.scm b/scheme/case-lambda-test.scm
new file mode 100644
index 00000000..543a4ef1
--- /dev/null
+++ b/scheme/case-lambda-test.scm
@@ -0,0 +1,34 @@
+;
+; Copyright (C) 2024 The S7 SRFI Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(import (srfi srfi-1)
+        (srfi srfi-78)
+        (scheme case-lambda))
+
+(check-set-mode! 'report-failed)
+
+(define (my-func . args)
+  (case-lambda
+    (() "zero args")
+    ((x) (+ x x))
+    ((x y) (+ x y))
+    ((x y . rest) (reduce + 0 (cons x (cons y rest))))))
+
+(check ((my-func)) => "zero args")
+(check ((my-func) 2) => 4)
+(check ((my-func) 3 4) => 7)
+(check ((my-func) 1 2 3 4) => 10)
+
diff --git a/scheme/case-lambda.scm b/scheme/case-lambda.scm
new file mode 100644
index 00000000..20da281e
--- /dev/null
+++ b/scheme/case-lambda.scm
@@ -0,0 +1,22 @@
+; 0-clause BSD
+; Bill Schottstaedt
+; from S7 source repo: r7rs.scm
+
+(define-library (scheme case-lambda)
+(export case-lambda)
+(begin
+
+;; case-lambda       
+(define-macro (case-lambda . choices)
+  `(lambda args
+     (case (length args)
+       ,@(map (lambda (choice)
+                (if (or (symbol? (car choice))
+                        (negative? (length (car choice))))
+                    `(else (apply (lambda ,(car choice) ,@(cdr choice)) args))
+                    `((,(length (car choice))) 
+                      (apply (lambda ,(car choice) ,@(cdr choice)) args))))
+              choices))))
+
+) ; end of begin
+) ; end of define-library
diff --git a/srfi/srfi-16-test.scm b/srfi/srfi-16-test.scm
new file mode 100644
index 00000000..684b1e98
--- /dev/null
+++ b/srfi/srfi-16-test.scm
@@ -0,0 +1,34 @@
+;
+; Copyright (C) 2024 The S7 SRFI Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(import (srfi srfi-1)
+        (srfi srfi-16)
+        (srfi srfi-78))
+
+(check-set-mode! 'report-failed)
+
+(define (my-func . args)
+  (case-lambda
+    (() "zero args")
+    ((x) (+ x x))
+    ((x y) (+ x y))
+    ((x y . rest) (reduce + 0 (cons x (cons y rest))))))
+
+(check ((my-func)) => "zero args")
+(check ((my-func) 2) => 4)
+(check ((my-func) 3 4) => 7)
+(check ((my-func) 1 2 3 4) => 10)
+
diff --git a/srfi/srfi-16.scm b/srfi/srfi-16.scm
new file mode 100644
index 00000000..0af20387
--- /dev/null
+++ b/srfi/srfi-16.scm
@@ -0,0 +1,20 @@
+;
+; Copyright (C) 2024 The S7 SRFI Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(define-library (srfi srfi-16)
+  (import (scheme case-lambda))
+  (export case-lambda))
+
-- 
Gitee