mapping implementation

4 files changed, 124 insertions, 51 deletions

diff --git a/srfi/225.sld b/srfi/225.sld
index da509c4..53bc68f 100644
--- a/srfi/225.sld
+++ b/srfi/225.sld
@@ -1,7 +1,6 @@
 (define-library
   (srfi 225)
 
-  ;; imports
   (import (scheme base)
           (scheme case-lambda)
           (scheme write)
@@ -12,23 +11,6 @@
     ((library (srfi 145)) (import (srfi 145)))
     (else (include "assumptions.scm")))
 
-  (cond-expand
-    (kawa (import (prefix (srfi 69 basic-hash-tables) t69:)))
-    (guile (import (prefix (srfi srfi-69) t69:)))
-    ((library (srfi 69)) (import (prefix (srfi 69) t69:)))
-    (else))
-
-  (cond-expand
-    (guile)
-    ((library (srfi 125)) (import (prefix (srfi 125) t125:)))
-    (else))
-
-  (cond-expand
-    (guile)
-    ((library (srfi 126)) (import (prefix (srfi 126) t126:)))
-    (else))
-
-  ;; exports
   (export
 
     ;; constructor
@@ -166,20 +148,33 @@
     ;;srfi-126-dtd
     ;;mapping-dtd
     ;;hash-mapping-dtd
+
     (cond-expand
         ((library (srfi 69))
+         (import (prefix (srfi 69) t69:))
          (include "srfi-69-impl.scm")
          (export srfi-69-dtd))
         (else))
 
     (cond-expand
         ((library (srfi 125))
+         (import (prefix (srfi 125) t125:))
          (include "srfi-125-impl.scm")
          (export hash-table-dtd))
         (else))
 
     (cond-expand
         ((library (srfi 126))
+         (import (prefix (srfi 126) t126:))
          (include "srfi-126-impl.scm")
          (export srfi-126-dtd))
-        (else)))
+        (else))
+
+    (cond-expand
+        ((library (srfi 146))
+         (import (srfi 146)
+                 (srfi 146 hash))
+         (include "srfi-146-impl.scm"
+                  "srfi-146-hash-impl.scm")
+         (export mapping-dtd
+                 hash-mapping-dtd))))
diff --git a/srfi/srfi-146-hash-impl.scm b/srfi/srfi-146-hash-impl.scm
new file mode 100644
index 0000000..8f064dd
--- /dev/null
+++ b/srfi/srfi-146-hash-impl.scm
@@ -0,0 +1,49 @@
+(define hash-mapping-dtd
+  (let ()
+
+    (define (prep-dtd-arg proc)
+      (lambda (dtd . args)
+        (apply proc args)))
+
+    (make-dtd
+     make-dictionary-index (prep-dtd-arg hashmap)
+     dictionary?-index (prep-dtd-arg hashmap?)
+     dict-empty?-index (prep-dtd-arg hashmap-empty?)
+     dict-contains?-index (prep-dtd-arg hashmap-contains?)
+     dict-ref-index (prep-dtd-arg hashmap-ref)
+     dict-ref/default-index (prep-dtd-arg hashmap-ref/default)
+     dict-set-index (prep-dtd-arg hashmap-set)
+     dict-set!-index (prep-dtd-arg hashmap-set!)
+     dict-adjoin-index (prep-dtd-arg hashmap-adjoin)
+     dict-adjoin!-index (prep-dtd-arg hashmap-adjoin!)
+     dict-delete-index (prep-dtd-arg hashmap-delete)
+     dict-delete!-index (prep-dtd-arg hashmap-delete!)
+     dict-delete-all-index (prep-dtd-arg hashmap-delete-all)
+     dict-delete-all!-index (prep-dtd-arg hashmap-delete-all!)
+     dict-replace-index (prep-dtd-arg hashmap-replace)
+     dict-replace!-index (prep-dtd-arg hashmap-replace!)
+     dict-intern-index (prep-dtd-arg hashmap-intern)
+     dict-intern!-index (prep-dtd-arg hashmap-intern!)
+     dict-update-index (prep-dtd-arg hashmap-update)
+     dict-update!-index (prep-dtd-arg hashmap-update!)
+     dict-update/default-index (prep-dtd-arg hashmap-update/default)
+     dict-update/default!-index (prep-dtd-arg hashmap-update!/default)
+     dict-pop-index (prep-dtd-arg hashmap-pop)
+     dict-pop!-index (prep-dtd-arg hashmap-pop!)
+     dict-filter-index (prep-dtd-arg hashmap-filter)
+     dict-filter!-index (prep-dtd-arg hashmap-filter!)
+     dict-remove-index (prep-dtd-arg hashmap-remove)
+     dict-remove!-index (prep-dtd-arg hashmap-remove!)
+     dict-search-index (prep-dtd-arg hashmap-search)
+     dict-search!-index (prep-dtd-arg hashmap-search!)
+     dict-copy-index (prep-dtd-arg hashmap-copy)
+     dict-size-index (prep-dtd-arg hashmap-size)
+     dict-for-each-index (prep-dtd-arg hashmap-for-each)
+     dict-count-index (prep-dtd-arg hashmap-count)
+     dict-keys-index (prep-dtd-arg hashmap-keys)
+     dict-values-index (prep-dtd-arg hashmap-values)
+     dict-entries-index (prep-dtd-arg hashmap-entries)
+     dict-fold-index (prep-dtd-arg hashmap-fold)
+     dict-map->list-index (prep-dtd-arg hashmap-map->list)
+     dict->alist-index (prep-dtd-arg hashmap->alist)
+     dict-comparator-index (prep-dtd-arg hashmap-key-comparator))))
diff --git a/srfi/srfi-146-impl.scm b/srfi/srfi-146-impl.scm
new file mode 100644
index 0000000..bcde849
--- /dev/null
+++ b/srfi/srfi-146-impl.scm
@@ -0,0 +1,49 @@
+(define mapping-dtd
+  (let ()
+
+    (define (prep-dtd-arg proc)
+      (lambda (dtd . args)
+        (apply proc args)))
+
+    (make-dtd
+     make-dictionary-index (prep-dtd-arg mapping)
+     dictionary?-index (prep-dtd-arg mapping?)
+     dict-empty?-index (prep-dtd-arg mapping-empty?)
+     dict-contains?-index (prep-dtd-arg mapping-contains?)
+     dict-ref-index (prep-dtd-arg mapping-ref)
+     dict-ref/default-index (prep-dtd-arg mapping-ref/default)
+     dict-set-index (prep-dtd-arg mapping-set)
+     dict-set!-index (prep-dtd-arg mapping-set!)
+     dict-adjoin-index (prep-dtd-arg mapping-adjoin)
+     dict-adjoin!-index (prep-dtd-arg mapping-adjoin!)
+     dict-delete-index (prep-dtd-arg mapping-delete)
+     dict-delete!-index (prep-dtd-arg mapping-delete!)
+     dict-delete-all-index (prep-dtd-arg mapping-delete-all)
+     dict-delete-all!-index (prep-dtd-arg mapping-delete-all!)
+     dict-replace-index (prep-dtd-arg mapping-replace)
+     dict-replace!-index (prep-dtd-arg mapping-replace!)
+     dict-intern-index (prep-dtd-arg mapping-intern)
+     dict-intern!-index (prep-dtd-arg mapping-intern!)
+     dict-update-index (prep-dtd-arg mapping-update)
+     dict-update!-index (prep-dtd-arg mapping-update!)
+     dict-update/default-index (prep-dtd-arg mapping-update/default)
+     dict-update/default!-index (prep-dtd-arg mapping-update!/default)
+     dict-pop-index (prep-dtd-arg mapping-pop)
+     dict-pop!-index (prep-dtd-arg mapping-pop!)
+     dict-filter-index (prep-dtd-arg mapping-filter)
+     dict-filter!-index (prep-dtd-arg mapping-filter!)
+     dict-remove-index (prep-dtd-arg mapping-remove)
+     dict-remove!-index (prep-dtd-arg mapping-remove!)
+     dict-search-index (prep-dtd-arg mapping-search)
+     dict-search!-index (prep-dtd-arg mapping-search!)
+     dict-copy-index (prep-dtd-arg mapping-copy)
+     dict-size-index (prep-dtd-arg mapping-size)
+     dict-for-each-index (prep-dtd-arg mapping-for-each)
+     dict-count-index (prep-dtd-arg mapping-count)
+     dict-keys-index (prep-dtd-arg mapping-keys)
+     dict-values-index (prep-dtd-arg mapping-values)
+     dict-entries-index (prep-dtd-arg mapping-entries)
+     dict-fold-index (prep-dtd-arg mapping-fold)
+     dict-map->list-index (prep-dtd-arg mapping-map->list)
+     dict->alist-index (prep-dtd-arg mapping->alist)
+     dict-comparator-index (prep-dtd-arg mapping-key-comparator))))
diff --git a/srfi/srfi-69-impl.scm b/srfi/srfi-69-impl.scm
index f0e397e..4151dba 100644
--- a/srfi/srfi-69-impl.scm
+++ b/srfi/srfi-69-impl.scm
@@ -1,6 +1,10 @@
 (define srfi-69-dtd
   (let ()
 
+    (define (prep-dtd-arg proc)
+      (lambda (dtd . args)
+        (apply proc args)))
+
     (define (t69:make-hash-table* dtd comparator)
       (define constructor-args
         (if (not comparator)
@@ -87,27 +91,6 @@
     (define (t69:hash-table-search* dtd table key fail success)
       (t69:hash-table-search!* dtd (dict-copy dtd table) key fail success))
 
-    (define (t69:hash-table-values* dtd table)
-      (t69:hash-table-values table))
-
-    (define (t69:hash-table->alist* dtd table)
-      (t69:hash-table->alist table))
-
-    (define (t69:hash-table-keys* dtd table)
-      (t69:hash-table-keys table))
-
-    (define (t69:hash-table-size* dtd table)
-      (t69:hash-table-size table))
-
-    (define (t69:hash-table-exists?* dtd table key)
-      (t69:hash-table-exists? table key))
-
-    (define (t69:hash-table-ref/default* dtd table key default)
-      (t69:hash-table-ref/default table key default))
-
-    (define (t69:hash-table?* dtd table)
-      (t69:hash-table? table))
-
     (define (t69:hash-table-comparator* dtd table)
       (make-comparator (lambda args #t)
                        (or (t69:hash-table-equivalence-function table)
@@ -115,28 +98,25 @@
                        #f
                        (t69:hash-table-hash-function table)))
 
-    (define (t69:hash-table-copy* dtd table)
-      (t69:hash-table-copy table))
-
     (make-dtd
      make-dictionary-index t69:make-hash-table*
-     dictionary?-index t69:hash-table?*
+     dictionary?-index (prep-dtd-arg t69:hash-table?)
      dict-ref-index t69:hash-table-ref*
-     dict-ref/default-index t69:hash-table-ref/default*
+     dict-ref/default-index (prep-dtd-arg t69:hash-table-ref/default)
      dict-set!-index t69:hash-table-set!*
      dict-delete-all!-index t69:hash-table-delete-all!*
-     dict-contains?-index t69:hash-table-exists?*
+     dict-contains?-index (prep-dtd-arg t69:hash-table-exists?)
      dict-update/default!-index t69:hash-table-update!/default*
-     dict-size-index t69:hash-table-size*
-     dict-keys-index t69:hash-table-keys*
-     dict-values-index t69:hash-table-values*
+     dict-size-index (prep-dtd-arg t69:hash-table-size)
+     dict-keys-index (prep-dtd-arg t69:hash-table-keys)
+     dict-values-index (prep-dtd-arg t69:hash-table-values)
      dict-map!-index t69:hash-table-map!*
      dict-filter!-index t69:hash-table-filter!*
      dict-filter-index t69:hash-table-filter*
      dict-for-each-index t69:hash-table-foreach*
      dict-fold-index t69:hash-table-fold*
-     dict->alist-index t69:hash-table->alist*
+     dict->alist-index (prep-dtd-arg t69:hash-table->alist)
      dict-search-index t69:hash-table-search*
      dict-search!-index t69:hash-table-search!*
      dict-comparator-index t69:hash-table-comparator*
-     dict-copy-index t69:hash-table-copy*)))
+     dict-copy-index (prep-dtd-arg t69:hash-table-copy))))