start moving implementation-dependent code into separate libraries

15 files changed, 156 insertions, 36 deletions

diff --git a/compat/micro-srfi-225/srfi/225.scm b/compat/micro-srfi-225/micro-srfi-225.scm
index 0e563d6..0e563d6 100644
--- a/compat/micro-srfi-225/srfi/225.scm
+++ b/compat/micro-srfi-225/micro-srfi-225.scm
diff --git a/compat/micro-srfi-225/micro-srfi-225.sld b/compat/micro-srfi-225/micro-srfi-225.sld
new file mode 100644
index 0000000..0b0834d
--- /dev/null
+++ b/compat/micro-srfi-225/micro-srfi-225.sld
@@ -0,0 +1,59 @@
+(define-library (micro-srfi-225)
+  (import (scheme base) (scheme case-lambda))
+  (export
+   eqv-alist-dto
+   ;; predicates
+   dictionary?
+   dict-empty?
+   dict-contains?
+   dict=?
+   dict-pure?
+   ;; lookup
+   dict-ref
+   dict-ref/default
+   dict-comparator
+   ;; mutation
+   dict-set!
+   dict-adjoin!
+   dict-delete!
+   dict-delete-all!
+   dict-replace!
+   dict-intern!
+   dict-update!
+   dict-update/default!
+   dict-pop!
+   dict-map
+   dict-filter
+   dict-remove
+   dict-find-update!
+   ;; whole dictionary
+   dict-size
+   dict-count
+   dict-any
+   dict-every
+   dict-keys
+   dict-values
+   dict-entries
+   dict-fold
+   dict-map->list
+   dict->alist
+   ;; iteration
+   dict-for-each
+   dict->generator
+   dict-set!-accumulator
+   dict-adjoin!-accumulator
+   ;; dictionary type descriptors
+   dto?
+   dto-ref
+   ;; exceptions
+   dictionary-error
+   dictionary-error?
+   dictionary-message
+   dictionary-irritants)
+  (begin
+    (define-record-type <derror>
+      (dictionary-error message irritants)
+      dictionary-error?
+      (message dictionary-message)
+      (irritants dictionary-irritants)))
+  (include "micro-srfi-225.scm"))
\ No newline at end of file
diff --git a/compat/micro-srfi-225/srfi/225.sld b/compat/micro-srfi-225/srfi/225.sld
index 9e97d76..69274d8 100644
--- a/compat/micro-srfi-225/srfi/225.sld
+++ b/compat/micro-srfi-225/srfi/225.sld
@@ -1,5 +1,5 @@
 (define-library (srfi 225)
-  (import (scheme base) (scheme case-lambda) (scheme write))
+  (import (micro-srfi-225))
   (export
    eqv-alist-dto
    ;; predicates
@@ -49,11 +49,4 @@
    dictionary-error
    dictionary-error?
    dictionary-message
-   dictionary-irritants)
-  (begin
-    (define-record-type <derror>
-      (dictionary-error message irritants)
-      dictionary-error?
-      (message dictionary-message)
-      (irritants dictionary-irritants)))
-  (include "225.scm"))
\ No newline at end of file
+   dictionary-irritants))
\ No newline at end of file
diff --git a/cuprate.egg b/cuprate.egg
index cd3a4f1..669ddaf 100644
--- a/cuprate.egg
+++ b/cuprate.egg
@@ -7,7 +7,10 @@
  (components (extension cuprate
                (source "lib/cuprate.sld")
                (source-dependencies "lib/cuprate-impl.scm" "lib/cuprate.simple-define-test-application.scm")
-               (component-dependencies cuprate.rewriters)
+               (component-dependencies cuprate.rewriters cuprate.implementation.chicken)
+               (csc-options "-R" "r7rs" "-X" "r7rs"))
+             (extension cuprate.implementation.chicken
+               (source "lib/cuprate/implementation/chicken.sld")
                (csc-options "-R" "r7rs" "-X" "r7rs"))
              (extension cuprate.rewriters
                (source "lib/cuprate/rewriters.sld")
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
diff --git a/tests/foment.sh b/tests/foment.sh
index 5dd4c04..a9e421e 100755
--- a/tests/foment.sh
+++ b/tests/foment.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-foment -A "../lib" -A "../compat/srfi-225" -l run.scm
+foment -A "../lib" -A "../compat/micro-srfi-225" -l run.scm
diff --git a/tests/gauche.sh b/tests/gauche.sh
index 75d3abb..989470b 100755
--- a/tests/gauche.sh
+++ b/tests/gauche.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-gosh -I "../lib" -I "../compat/srfi-225" run.scm
+gosh -I "../lib" -I "../compat/micro-srfi-225" run.scm
diff --git a/tests/sagittarius.sh b/tests/sagittarius.sh
index 827f33e..ff37d43 100755
--- a/tests/sagittarius.sh
+++ b/tests/sagittarius.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-sash -L../compat/srfi-225 -L../lib run.scm
+sash -L../compat/micro-srfi-225 -L../lib run.scm