start moving implementation-dependent code into separate libraries

8 files changed, 88 insertions, 23 deletions

diff --git a/lib/cuprate.sld b/lib/cuprate.sld
index a23f55a..05d9bf6 100644
--- a/lib/cuprate.sld
+++ b/lib/cuprate.sld
@@ -30,6 +30,14 @@
    with-test-group-cleanup
    test-exit
    pretty-print)
+  (cond-expand
+    (chicken-5 (import (cuprate implementation chicken)))
+    (gauche (import (cuprate implementation gauche)))
+    (foment (import (cuprate implementation foment)))
+    (chibi (import (cuprate implementation chibi)))
+    (skint (import (cuprate implementation skint)))
+    (sagittarius (import (cuprate implementation sagittarius)))
+    (else (import (cuprate implementation r7rs))))
   (begin
     (define-record-type <test-info>
       (wrap-test-info dict exited?)
@@ -40,27 +48,4 @@
   (cond-expand
     ((or foment chicken-5) (include "cuprate.simple-define-test-application.scm"))
     (else (include "cuprate.define-test-application.scm")))
-  ;; Pretty printing
-  (cond-expand
-    (chicken (import (only (chicken pretty-print) pretty-print)))
-    ((or foment chibi) (import (srfi 166))
-                           (begin (define (pretty-print obj)
-                                    (show #t (pretty obj))
-                                    (newline))))
-    (gauche (import (scheme show))
-            (begin (define (pretty-print obj)
-                     (show #t (pretty obj)))))
-    (else (begin (define (pretty-print x)
-                   (write x)
-                   (newline)))))
-  ;; Better containers for the test info than alists, if available.
-  (cond-expand
-    ((or chicken skint) (import (srfi 128) (srfi 146 hash))
-        (begin
-          (define default-test-dto hash-mapping-dto)
-          (define (alist->default-dictionary x)
-            (alist->hashmap (make-default-comparator) x))))
-    (else (begin
-            (define default-test-dto eqv-alist-dto)
-            (define (alist->default-dictionary x) x))))
   (include "cuprate-impl.scm"))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/chibi.sld b/lib/cuprate/implementation/chibi.sld
new file mode 100644
index 0000000..318ac78
--- /dev/null
+++ b/lib/cuprate/implementation/chibi.sld
@@ -0,0 +1,9 @@
+(define-library (cuprate implementation chibi)
+  (import (scheme base) (srfi 166) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (show #t (pretty obj)))
+    (define default-test-dto eqv-alist-dto)
+    (define (alist->default-dictionary x) x)))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/chicken.sld b/lib/cuprate/implementation/chicken.sld
new file mode 100644
index 0000000..a9bff2d
--- /dev/null
+++ b/lib/cuprate/implementation/chicken.sld
@@ -0,0 +1,9 @@
+(define-library (cuprate implementation chicken)
+  (import (scheme base) (chicken pretty-print)
+          (srfi 128) (srfi 146 hash) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define default-test-dto hash-mapping-dto)
+    (define (alist->default-dictionary x)
+      (alist->hashmap (make-default-comparator) x))))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/foment.sld b/lib/cuprate/implementation/foment.sld
new file mode 100644
index 0000000..2ad53dc
--- /dev/null
+++ b/lib/cuprate/implementation/foment.sld
@@ -0,0 +1,10 @@
+(define-library (cuprate implementation foment)
+  (import (scheme base) (srfi 166) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (show #t (pretty obj))
+      (newline))
+    (define default-test-dto eqv-alist-dto)
+    (define (alist->default-dictionary x) x)))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/gauche.sld b/lib/cuprate/implementation/gauche.sld
new file mode 100644
index 0000000..627ff5c
--- /dev/null
+++ b/lib/cuprate/implementation/gauche.sld
@@ -0,0 +1,9 @@
+(define-library (cuprate implementation gauche)
+  (import (scheme base) (scheme show) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (show #t (pretty obj)))
+    (define default-test-dto eqv-alist-dto)
+    (define (alist->default-dictionary x) x)))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/r7rs.sld b/lib/cuprate/implementation/r7rs.sld
new file mode 100644
index 0000000..0a1286f
--- /dev/null
+++ b/lib/cuprate/implementation/r7rs.sld
@@ -0,0 +1,10 @@
+(define-library (cuprate implementation r7rs)
+  (import (scheme base) (scheme write) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (write obj)
+      (newline))
+    (define default-test-dto eqv-alist-dto)
+    (define (alist->default-dictionary x) x)))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/sagittarius.sld b/lib/cuprate/implementation/sagittarius.sld
new file mode 100644
index 0000000..ba630f0
--- /dev/null
+++ b/lib/cuprate/implementation/sagittarius.sld
@@ -0,0 +1,20 @@
+(define-library (cuprate implementation sagittarius)
+  (import (scheme base) (scheme format) (srfi 146 hash) (srfi 225))
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (show #t (pretty obj))))
+  (cond-expand
+    ;; Sagittarius has SRFI-146 hashmaps. If the full SRFI-225 is loaded
+    ;; (which is hackily checked by checking if micro-srfi-225 is NOT
+    ;; loadable) then use them.
+    ((library (micro-srfi-225))
+     (begin
+       (define default-test-dto eqv-alist-dto)
+       (define (alist->default-dictionary x) x)))
+    (else
+     (begin
+       (define default-test-dto hash-mapping-dto)
+       (define (alist->default-dictionary x)
+         (alist->hashmap (make-default-comparator) x))))))
\ No newline at end of file
diff --git a/lib/cuprate/implementation/skint.sld b/lib/cuprate/implementation/skint.sld
new file mode 100644
index 0000000..b2ce921
--- /dev/null
+++ b/lib/cuprate/implementation/skint.sld
@@ -0,0 +1,13 @@
+(define-library (cuprate implementation skint)
+  (import (scheme base) (srfi 128) (srfi 146 hash) (scheme write)
+          (srfi 225)
+          )
+  (export pretty-print default-test-dto
+          alist->default-dictionary)
+  (begin
+    (define (pretty-print obj)
+      (write obj)
+      (newline))
+    (define default-test-dto hash-mapping-dto)
+    (define (alist->default-dictionary x)
+      (alist->hashmap (make-default-comparator) x))))
\ No newline at end of file