factor into libraries

4 files changed, 81 insertions, 28 deletions

diff --git a/cond-values.scm b/cond-values-impl.scm
index 099536c..e0b4889 100644
--- a/cond-values.scm
+++ b/cond-values-impl.scm
@@ -11,8 +11,6 @@
 ;;; implied. See the License for the specific language governing
 ;;; permissions and limitations under the License.
 
-(import srfi-1)
-
 ;;; AFTER executes a body after multiple tests.
 ;;; 
 ;;; The form of the syntax is
@@ -159,29 +157,3 @@
       (after ((when (> num 0))
               (when (pair? lst)))
         (length-at-least (cdr lst) (- num 1))))))
-
-;;; Helper function.
-(define (null-cdr? lst) (null? (cdr lst)))
-
-;;; MAP-VALUES returns (VALUES L1 L2 ...), where L1 is the first
-;;; value returned from (F (CAR LST)), (F (CADR LST)), ... and so on.
-(define (map-values f . lists)
-  (define (null-cdr? lst) (null? (cdr lst)))
-  (let-values ((new-values (apply f (map car lists))))
-    (if (any null-cdr? lists)
-        (apply values (map list new-values))
-        (let-values ((returned (apply map-values f (map cdr lists))))
-          (apply values (map cons new-values returned))))))
-
-;;; (ANY-VALUES F (A1 A2 ...) (B1 B2 ...) ...) runs
-;;; (F A1 B1 ...) and checks if there any returned values. If there are
-;;; none, runs (F A2 B2 ...), and so on.
-;;; 
-;;; If any of the lists end, then ANY-VALUES returns no values.
-(define (any-values f . lists)
-  (after ((when (not (null? lists)))
-          (when (all pair? lists)))
-    (let-values ((returned (apply f (map car lists))))
-      (if (null? returned)
-          (apply any-values f (map cdr lists))
-          (apply values returned)))))
diff --git a/cond-values.r7rs.scm b/cond-values.r7rs.scm
new file mode 100644
index 0000000..22c7f8a
--- /dev/null
+++ b/cond-values.r7rs.scm
@@ -0,0 +1,23 @@
+;;; Copyright 2024 Peter McGoron
+;;; 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.
+
+(cond-expand
+ (chicken (import r7rs)))
+
+(define-library (mcgoron.com cond-values)
+  (import (scheme base))
+  (export after cond-values
+          define-record-type/destructor
+          pair-d assq-d
+          length* length-at-least)
+  (import "cond-values.scm"))
diff --git a/values-lib.r7rs.scm b/values-lib.r7rs.scm
new file mode 100644
index 0000000..df50d04
--- /dev/null
+++ b/values-lib.r7rs.scm
@@ -0,0 +1,20 @@
+;;; Copyright 2024 Peter McGoron
+;;; 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.
+
+(cond-expand
+ (chicken (import r7rs)))
+
+(define-library (mcgoron.com values-lib)
+  (import (scheme base) srfi-1)
+  (export map-values any-values)
+  (import "values-lib.scm"))
diff --git a/values-lib.scm b/values-lib.scm
new file mode 100644
index 0000000..79e8d98
--- /dev/null
+++ b/values-lib.scm
@@ -0,0 +1,38 @@
+;;; Copyright 2024 Peter McGoron
+;;; 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.
+
+;;; Helper function.
+(define (null-cdr? lst) (null? (cdr lst)))
+
+;;; MAP-VALUES returns (VALUES L1 L2 ...), where L1 is the first
+;;; value returned from (F (CAR LST)), (F (CADR LST)), ... and so on.
+(define (map-values f . lists)
+  (define (null-cdr? lst) (null? (cdr lst)))
+  (let-values ((new-values (apply f (map car lists))))
+    (if (any null-cdr? lists)
+        (apply values (map list new-values))
+        (let-values ((returned (apply map-values f (map cdr lists))))
+          (apply values (map cons new-values returned))))))
+
+;;; (ANY-VALUES F (A1 A2 ...) (B1 B2 ...) ...) runs
+;;; (F A1 B1 ...) and checks if there any returned values. If there are
+;;; none, runs (F A2 B2 ...), and so on.
+;;; 
+;;; If any of the lists end, then ANY-VALUES returns no values.
+(define (any-values f . lists)
+  (after ((when (not (null? lists)))
+          (when (all pair? lists)))
+    (let-values ((returned (apply f (map car lists))))
+      (if (null? returned)
+          (apply any-values f (map cdr lists))
+          (apply values returned)))))