Add (liii cut) and (srfi srfi-26)

* Add (liii cut) and (srfi srfi-26)

* Update license information

* Improve code format

AUTHORS

@@ -15,4 +15,4 @@ Yingyao Zhou <[email protected]>
 赵淑婷 <[email protected]>
 Shen Wei <[email protected]>
 Noctis Zhang <[email protected]>
-
+Andy Yu <[email protected]>

goldfish/liii/cut.scm

@@ -0,0 +1,55 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme 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 (liii cut)
+(export cut cute)
+(import (liii list)
+        (liii error))
+(begin
+
+(define-macro (cut . paras)
+  (letrec*
+    ((slot? (lambda (x) (equal? '<> x)))
+     (more-slot? (lambda (x) (equal? '<...> x)))
+     (slots (filter slot? paras))
+     (more-slots (filter more-slot? paras))
+     (xs (map (lambda (x) (gensym)) slots))
+     (rest (gensym))
+     (parse
+       (lambda (xs paras)
+         (cond
+           ((null? paras) paras)
+           ((not (list? paras)) paras)
+           ((more-slot? (car paras)) `(,rest ,@(parse xs (cdr paras))))
+           ((slot? (car paras)) `(,(car xs) ,@(parse (cdr xs) (cdr paras))))
+           (else `(,(car paras) ,@(parse xs (cdr paras))))))))
+    (cond
+      ((null? more-slots)
+       `(lambda ,xs ,(parse xs paras)))
+      (else
+        (when
+          (or (> (length more-slots) 1)
+              (not (more-slot? (last paras))))
+          (error 'syntax-error "<...> must be the last parameter of cut"))
+        (let ((parsed (parse xs paras)))
+          `(lambda (,@xs . ,rest) (apply ,@parsed)))))))
+
+(define-macro (cute . paras)
+  (error 'not-implemented))
+
+) ; end of begin
+) ; end of library
+

goldfish/srfi/srfi-26.scm

@@ -0,0 +1,20 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme 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-26)
+  (import (liii cut))
+  (export cut cute))
+

tests/goldfish/liii/cut-test.scm

@@ -0,0 +1,32 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme 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 (liii check)
+        (liii cut))
+
+(check-set-mode! 'report-failed)
+
+(check ((cut list <> 'y <>) 'x 'z) => '(x y z))
+(check ((cut + 1 <...>) 2 3) => 6)
+(check ((cut + 1 <...>)) => 1)
+(check ((cut list <> <> <...>) 1 2 3) => '(1 2 3))
+(check ((cut list <> <> <...>) 1 2) => '(1 2))
+(check-catch 'wrong-number-of-args ((cut list <> <>) 1))
+(check-catch 'wrong-number-of-args ((cut list <> <> <...>) 1))
+(check-catch 'syntax-error ((cut list <> <> <...> <>) 1 2 3))
+
+(check-report)
+