!98 Move case-list and case-vector to (liii scala)

goldfish/liii/list.scm

@@ -42,7 +42,6 @@
   flat-map
   list-null? list-not-null? not-null-list?
   length=? length>? length>=? flatten
-  case-list case-list? case-list=?
 )
 (import (srfi srfi-1)
         (srfi srfi-13)
@@ -146,78 +145,6 @@
             " but got a ~A") depth)))
   ) ; end of (define* (flatten))
 
-(define-case-class case-list ((data list?))
-  (define (%collect) data)
-
-  (define (%map x . xs)
-    (let1 r (case-list (map x data))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%flat-map x . xs)
-    (let1 r (case-list (flat-map x data))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%filter x . xs)
-    (let1 r (case-list (filter x data))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%for-each x)
-    (for-each x data))
-
-  (define (%take x . xs)
-    (typed-define (scala-take (data list?) (n integer?))
-      (cond ((< n 0) '())
-            ((>= n (length data)) data)
-            (else (take data n))))
-
-    (let1 r (case-list (scala-take data x))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%take-right x . xs)
-    (typed-define (scala-take-right (data list?) (n integer?))
-      (cond ((< n 0) '())
-            ((>= n (length data)) data)
-            (else (take-right data n))))
-
-    (let1 r (case-list (scala-take-right data x))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%count . xs)
-    (cond ((null? xs) (length data))
-          ((length=? 1 xs) (count (car xs) data))
-          (else (error 'wrong-number-of-args "case-list%count" xs))))
-
-  (define (%fold initial f)
-    (fold f initial data))
-
-  (define (%fold-right initial f)
-    (fold-right f initial data))
-
-  (define (%make-string . xs)
-    (define (parse-args xs)
-      (cond
-        ((null? xs) (values "" "" ""))
-        ((length=? 1 xs)
-         (let1 sep (car xs)
-           (if (string? sep)
-               (values "" sep "")
-               (type-error "case-list%make-string: separator must be a string" sep))))
-        ((length=? 2 xs)
-         (error 'wrong-number-of-args "case-list%make-string: expected 0, 1, or 3 arguments, but got 2" xs))
-        ((length=? 3 xs)
-         (let ((start (car xs))
-               (sep (cadr xs))
-               (end (caddr xs)))
-           (if (and (string? start) (string? sep) (string? end))
-               (values start sep end)
-               (error 'type-error "case-list%make-string: prefix, separator, and suffix must be strings" xs))))
-        (else (error 'wrong-number-of-args "case-list%make-string: expected 0, 1, or 3 arguments" xs))))
-
-    (receive (start sep end) (parse-args xs)
-      (string-append start (string-join (map object->string data) sep) end)))
-
-)
-
 ) ; end of begin
 ) ; end of library
 

goldfish/liii/scala.scm

@@ -0,0 +1,176 @@
+;
+; 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 scala)
+(import (liii string) (liii vector) (liii list))
+(export
+  case-list case-list? case-list=?
+  case-vector case-vector? case-vector=?)
+(begin
+
+(define-case-class case-list ((data list?))
+  (define (%collect) data)
+
+  (define (%map x . xs)
+    (let1 r (case-list (map x data))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%flat-map x . xs)
+    (let1 r (case-list (flat-map x data))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%filter x . xs)
+    (let1 r (case-list (filter x data))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%for-each x)
+    (for-each x data))
+
+  (define (%take x . xs)
+    (typed-define (scala-take (data list?) (n integer?))
+      (cond ((< n 0) '())
+            ((>= n (length data)) data)
+            (else (take data n))))
+
+    (let1 r (case-list (scala-take data x))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%take-right x . xs)
+    (typed-define (scala-take-right (data list?) (n integer?))
+      (cond ((< n 0) '())
+            ((>= n (length data)) data)
+            (else (take-right data n))))
+
+    (let1 r (case-list (scala-take-right data x))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%count . xs)
+    (cond ((null? xs) (length data))
+          ((length=? 1 xs) (count (car xs) data))
+          (else (error 'wrong-number-of-args "case-list%count" xs))))
+
+  (define (%fold initial f)
+    (fold f initial data))
+
+  (define (%fold-right initial f)
+    (fold-right f initial data))
+
+  (define (%make-string . xs)
+    (define (parse-args xs)
+      (cond
+        ((null? xs) (values "" "" ""))
+        ((length=? 1 xs)
+         (let1 sep (car xs)
+           (if (string? sep)
+               (values "" sep "")
+               (type-error "case-list%make-string: separator must be a string" sep))))
+        ((length=? 2 xs)
+         (error 'wrong-number-of-args "case-list%make-string: expected 0, 1, or 3 arguments, but got 2" xs))
+        ((length=? 3 xs)
+         (let ((start (car xs))
+               (sep (cadr xs))
+               (end (caddr xs)))
+           (if (and (string? start) (string? sep) (string? end))
+               (values start sep end)
+               (error 'type-error "case-list%make-string: prefix, separator, and suffix must be strings" xs))))
+        (else (error 'wrong-number-of-args "case-list%make-string: expected 0, 1, or 3 arguments" xs))))
+
+    (receive (start sep end) (parse-args xs)
+      (string-append start (string-join (map object->string data) sep) end)))
+
+)
+
+(define-case-class case-vector ((data vector?))
+  (define (%collect) data)
+
+  (define (%map x . xs)
+    (let1 r (case-vector (vector-map x data))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%filter x . xs)
+    (let1 r (case-vector (vector-filter x data))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%for-each x)
+    (vector-for-each x data))
+
+  (define (%count . xs)
+    (cond ((null? xs) (vector-length data))
+          ((length=? 1 xs) (vector-count (car xs) data))
+          (else (error 'wrong-number-of-args "case-vector%count" xs))))
+
+  (define (%take x . xs)
+    (typed-define (scala-take (data vector?) (n integer?))
+      (cond
+        ((< n 0) (vector))
+        ((>= n (vector-length data)) data)
+        (else
+          (let ((new-vec (make-vector n)))
+            (do ((i 0 (+ i 1)))
+                ((>= i n) new-vec)
+              (vector-set! new-vec i (vector-ref data i)))))))
+
+    (let1 r (case-vector (scala-take data x))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%take-right x . xs)
+    (typed-define (scala-take-right (data vector?) (n integer?))
+      (let ((len (vector-length data)))
+        (cond
+          ((< n 0) (vector))
+          ((>= n len) data)
+          (else
+            (let ((new-vec (make-vector n)))
+              (do ((i (- len n) (+ i 1))
+                   (j 0 (+ j 1)))
+                  ((>= j n) new-vec)
+                (vector-set! new-vec j (vector-ref data i))))))))
+
+    (let1 r (case-vector (scala-take-right data x))
+      (if (null? xs) r (apply r xs))))
+
+  (define (%fold initial f)
+    (vector-fold f initial data))
+
+  (define (%fold-right initial f)
+    (vector-fold-right f initial data))
+
+  (define (%make-string . xs)
+    (define (parse-args xs)
+      (cond
+        ((null? xs) (values "" "" ""))
+        ((length=? 1 xs)
+         (let1 sep (car xs)
+           (if (string? sep)
+               (values "" sep "")
+               (type-error "case-vector%make-string: separator must be a string" sep))))
+        ((length=? 2 xs)
+         (error 'wrong-number-of-args "case-vector%make-string: expected 0, 1, or 3 arguments, but got 2" xs))
+        ((length=? 3 xs)
+         (let ((start (car xs))
+               (sep (cadr xs))
+               (end (caddr xs)))
+           (if (and (string? start) (string? sep) (string? end))
+               (values start sep end)
+               (type-error "case-vector%make-string: prefix, separator, and suffix must be strings" xs))))
+        (else (error 'wrong-number-of-args "case-vector%make-string: expected 0, 1, or 3 arguments" xs))))
+
+    (receive (start sep end) (parse-args xs)
+      (string-append start (string-join (map object->string (vector->list data)) sep) end)))
+)
+) ; end of begin
+) ; end of library
+

goldfish/liii/vector.scm

@@ -33,7 +33,7 @@
   vector-swap! vector-cumulate reverse-list->vector
   vector=
   ; Liii Extras
-  vector-filter case-vector case-vector? case-vector=?
+  vector-filter
 )
 (begin
 
@@ -53,84 +53,6 @@
             (vector-set! result-vec i (car lst))
             (loop (- i 1) (cdr lst)))))))
 
-(define-case-class case-vector ((data vector?))
-  (define (%collect) data)
-
-  (define (%map x . xs)
-    (let1 r (case-vector (vector-map x data))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%filter x . xs)
-    (let1 r (case-vector (vector-filter x data))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%for-each x)
-    (vector-for-each x data))
-
-  (define (%count . xs)
-    (cond ((null? xs) (vector-length data))
-          ((length=? 1 xs) (vector-count (car xs) data))
-          (else (error 'wrong-number-of-args "case-vector%count" xs))))
-
-  (define (%take x . xs)
-    (typed-define (scala-take (data vector?) (n integer?))
-      (cond
-        ((< n 0) (vector))
-        ((>= n (vector-length data)) data)
-        (else
-          (let ((new-vec (make-vector n)))
-            (do ((i 0 (+ i 1)))
-                ((>= i n) new-vec)
-              (vector-set! new-vec i (vector-ref data i)))))))
-
-    (let1 r (case-vector (scala-take data x))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%take-right x . xs)
-    (typed-define (scala-take-right (data vector?) (n integer?))
-      (let ((len (vector-length data)))
-        (cond
-          ((< n 0) (vector))
-          ((>= n len) data)
-          (else
-            (let ((new-vec (make-vector n)))
-              (do ((i (- len n) (+ i 1))
-                   (j 0 (+ j 1)))
-                  ((>= j n) new-vec)
-                (vector-set! new-vec j (vector-ref data i))))))))
-
-    (let1 r (case-vector (scala-take-right data x))
-      (if (null? xs) r (apply r xs))))
-
-  (define (%fold initial f)
-    (vector-fold f initial data))
-
-  (define (%fold-right initial f)
-    (vector-fold-right f initial data))
-
-  (define (%make-string . xs)
-    (define (parse-args xs)
-      (cond
-        ((null? xs) (values "" "" ""))
-        ((length=? 1 xs)
-         (let1 sep (car xs)
-           (if (string? sep)
-               (values "" sep "")
-               (type-error "case-vector%make-string: separator must be a string" sep))))
-        ((length=? 2 xs)
-         (error 'wrong-number-of-args "case-vector%make-string: expected 0, 1, or 3 arguments, but got 2" xs))
-        ((length=? 3 xs)
-         (let ((start (car xs))
-               (sep (cadr xs))
-               (end (caddr xs)))
-           (if (and (string? start) (string? sep) (string? end))
-               (values start sep end)
-               (type-error "case-vector%make-string: prefix, separator, and suffix must be strings" xs))))
-        (else (error 'wrong-number-of-args "case-vector%make-string: expected 0, 1, or 3 arguments" xs))))
-
-    (receive (start sep end) (parse-args xs)
-      (string-append start (string-join (map object->string (vector->list data)) sep) end)))
-)
 ) ; end of begin
 ) ; end of define-library