work

16 files changed, 2079 insertions, 33 deletions

diff --git a/Dockerfile b/Dockerfile
new file mode 100644
index 0000000..3a927cb
--- /dev/null
+++ b/Dockerfile
@@ -0,0 +1,9 @@
+FROM alpine
+RUN apk add --no-cache git
+RUN mkdir /test
+WORKDIR /test
+ADD . srfi-225
+RUN ["git", "clone", "https://github.com/scheme-requests-for-implementation/srfi-69/"]
+RUN ["git", "clone", "https://github.com/scheme-requests-for-implementation/srfi-125/"]
+RUN ["git", "clone", "https://github.com/scheme-requests-for-implementation/srfi-126/"]
+RUN ["git", "clone", "https://github.com/scheme-requests-for-implementation/srfi-146/"]
diff --git a/alist-impl.scm b/alist-impl.scm
index 5114621..9ce3c35 100644
--- a/alist-impl.scm
+++ b/alist-impl.scm
@@ -1,4 +1,4 @@
-(define (register-alist!)
+(define (make-alist-dtd key=)
 
   (define (alist? l)
     (and (list? l)
@@ -13,40 +13,31 @@
         (cons key (proc key value)))
       alist))
 
-  (define (alist-filter! pred alist)
+  (define (alist-filter pred alist)
     (filter
       (lambda (e)
         (pred (car e) (cdr e)))
       alist))
 
-  (define (alist-delete key alist)
-    ;; find the tail of alist that will be kept
-    ;; ie rest entries after the last entry with matched key
-    (define kept-tail
-      (let loop ((tail alist)
-                 (lst alist))
-      (cond
-        ((null? lst) tail)
-        (else
-          (if (equal? key (caar lst))
-              (loop (cdr lst) (cdr lst))
-              (loop tail (cdr lst)))))))
-    ;; if tail == alist; just return,
-    ;; else filter elements before the tail, and append the tail
-    (if (eq? alist kept-tail)
-        alist
-        (let loop ((lst alist)
-                   (result/reversed '()))
-          (if (eq? lst kept-tail)
-              (append (reverse result/reversed) kept-tail)
-              (let* ((entry (car lst))
-                     (keep? (not (equal? key (car entry))))
-                     (result/reversed* (if keep?
-                                           (cons entry result/reversed)
-                                           result/reversed)))
-                (loop (cdr lst) result/reversed*))))))
+  (define (alist-filter! pred alist)
+    (filter!
+      (lambda (e)
+        (pred (car e) (cdr e)))
+      alist))
+
+  (define (alist-delete dtd key alist)
+    (filter
+     (lambda (entry)
+       (not (key= (car entry) key)))
+     alist))
+
+  (define (alist-delete! dtd key alist)
+    (filter!
+     (lambda (entry)
+       (not (key= (car entry) key)))
+     alist))
 
-  (define (alist-search! alist key failure success)
+  (define (alist-search* dtd alist-delete-proc alist key failure success)
     (define (handle-success pair)
       (define old-key (car pair))
       (define old-value (cdr pair))
@@ -61,7 +52,7 @@
             (let ((new-list
                     (alist-cons
                       new-key new-value
-                      (alist-delete old-key alist))))
+                      (alist-delete-proc old-key alist))))
               (values new-list obj)))))
       (define (remove obj)
         (values (alist-delete old-key alist) obj))
@@ -78,6 +69,12 @@
       ((assoc key alist) => handle-success)
       (else (handle-failure))))
 
+  (define (alist-search dtd alist key failure success)
+    (alist-search* dtd alist-delete alist key failure success))
+
+  (define (alist-search! dtd alist key failure success)
+    (alist-search* dtd alist-delete! alist key failure success))
+
   (define (alist-size alist)
     (length alist))
 
@@ -89,7 +86,7 @@
   (define (alist->alist alist)
     alist)
 
-  (register-dictionary!
+  (-dictionary!
     'dictionary? alist?
     'dict-map! alist-map!
     'dict-filter! alist-filter!
diff --git a/docker-compose.yml b/docker-compose.yml
new file mode 100644
index 0000000..2571288
--- /dev/null
+++ b/docker-compose.yml
@@ -0,0 +1,16 @@
+version: "3"
+services:
+  srfi_225_test:
+    build: .
+    volumes:
+      - test-volume:/test
+  gauche:
+    image: "schemers/gauche"
+    depends_on:
+      - srfi_225_test
+    volumes:
+      - test-volume:/test
+    command: ["gosh", "-I", "/test/srfi-225", "/test/srfi-225/srfi-225-test.scm"]
+
+volumes:
+  test-volume:
diff --git a/srfi-225-test.scm b/srfi-225-test.scm
new file mode 100644
index 0000000..cd99344
--- /dev/null
+++ b/srfi-225-test.scm
@@ -0,0 +1,713 @@
+(import (scheme base)
+        (scheme case-lambda)
+        (srfi 1)
+        (prefix (srfi 69) t69:)
+        (prefix (srfi 125) t125:)
+        (srfi 128)
+        (srfi 225))
+
+(cond-expand
+  (chibi
+   (import (rename (except (chibi test) test-equal)
+                   (test test-equal))))
+  (else
+   (import (srfi 64))))
+
+;; returns new wrapper dtd
+;; which counts how often each dtd's method was called
+;; verify that all functions were tested
+(define (wrap-dtd dtd)
+  (define proc-count (+ 1 dict-comparator-index))
+  (define counter (make-vector proc-count 0))
+  (define wrapper-dtd-args
+    (let loop ((indexes (iota proc-count))
+               (args '()))
+      (if (null? indexes)
+          args
+          (let* ((index (car indexes))
+                 (real-proc (dtd-ref dtd index))
+                 (wrapper-proc (lambda args
+                                 (vector-set! counter index (+ 1 (vector-ref counter index)))
+                                 (apply real-proc args))))
+            (loop (cdr indexes)
+                  (append (list index wrapper-proc)
+                          args))))))
+  (values
+   (apply make-dtd wrapper-dtd-args)
+   counter))
+
+(define (do-test real-dtd alist->dict comparator)
+
+  (define-values
+      (dtd counter)
+    (wrap-dtd real-dtd))
+
+  (test-group
+   "make-dictionary"
+   (define dict (make-dictionary dtd comparator))
+   (test-assert (dictionary? dtd dict))
+   (test-assert (dict-empty? dtd dict)))
+
+  (test-group
+    "dictionary?"
+    (test-assert (not (dictionary? dtd 'foo)))
+    (test-assert (dictionary? dtd (alist->dict '())))
+    (test-assert (dictionary? dtd (alist->dict '((a . b))))))
+
+  (test-group
+    "dict-empty?"
+    (test-assert (dict-empty? dtd (alist->dict '())))
+    (test-assert (not (dict-empty? dtd (alist->dict '((a . b)))))))
+
+  (test-group
+    "dict-contains?"
+    (test-assert (not (dict-contains? dtd (alist->dict '()) 'a)))
+    (test-assert (not (dict-contains? dtd (alist->dict '((b . c))) 'a)))
+    (test-assert (dict-contains? dtd (alist->dict '((a . b))) 'a)))
+
+  (test-group
+    "dict-ref"
+    (test-assert (dict-ref dtd (alist->dict '((a . b))) 'a (lambda () #f) (lambda (x) #t)))
+    (test-assert (dict-ref dtd (alist->dict '((a . b))) 'b (lambda () #t) (lambda (x) #f))))
+
+  (test-group
+    "dict-ref/default"
+    (test-equal (dict-ref/default dtd (alist->dict '((a . b))) 'a 'c) 'b)
+    (test-equal (dict-ref/default dtd (alist->dict '((a* . b))) 'a 'c) 'c))
+
+  (test-group
+   "dict-set"
+   (define dict-original (alist->dict '((a . b))))
+   (define d (dict-set dtd dict-original 'a 'c 'a2 'b2))
+   (test-equal 'c (dict-ref dtd d 'a ))
+   (test-equal 'b2 (dict-ref dtd d 'a2))
+   (test-equal 'b (dict-ref dtd dict-original' a))
+   (test-equal #f (dict-ref/default dtd dict-original 'a2 #f)))
+
+  (test-group
+    "dict-set!"
+    (define d (dict-set! dtd (alist->dict '((a . b))) 'a 'c 'a2 'b2))
+    (test-equal 'c (dict-ref dtd d 'a ))
+    (test-equal 'b2 (dict-ref dtd d 'a2)))
+
+  (test-group
+   "dict-adjoin"
+   (define dict-original (alist->dict '((a . b))))
+   (define d (dict-adjoin dtd dict-original 'a 'c 'a2 'b2))
+   (test-equal 'b (dict-ref dtd d 'a))
+   (test-equal 'b2 (dict-ref dtd d 'a2))
+   (test-equal #f (dict-ref/default dtd dict-original 'a2 #f)))
+
+  (test-group
+    "dict-adjoin!"
+    (define d (dict-adjoin! dtd (alist->dict '((a . b))) 'a 'c 'a2 'b2))
+    (test-equal 'b (dict-ref dtd d 'a))
+    (test-equal 'b2 (dict-ref dtd d 'a2)))
+
+  (test-group
+   "dict-delete"
+   (define dict-original (alist->dict '((a . b) (c . d))))
+   (define d (dict-delete dtd dict-original 'a 'b))
+   (test-equal (dict->alist dtd d) '((c . d)))
+   (test-equal 'b (dict-ref dtd dict-original 'a)))
+
+  (test-group
+    "dict-delete!"
+    (define d (dict-delete! dtd (alist->dict '((a . b) (c . d))) 'a 'b))
+    (test-equal (dict->alist dtd d) '((c . d))))
+
+  (test-group
+   "dict-delete-all"
+   (define dict-original (alist->dict '((a . b) (c . d))))
+   (define d (dict-delete-all dtd dict-original '(a b)))
+   (test-equal (dict->alist dtd d) '((c . d)))
+   (test-equal 'b (dict-ref dtd dict-original 'a)))
+
+  (test-group
+    "dict-delete-all!"
+    (define d (dict-delete-all! dtd (alist->dict '((a . b) (c . d))) '(a b)))
+    (test-equal (dict->alist dtd d) '((c . d))))
+
+  (test-group
+   "dict-replace"
+   (define dict-original (alist->dict '((a . b) (c . d))))
+    (define d (dict-replace dtd dict-original 'a 'b2))
+    (test-equal 'b2 (dict-ref dtd d 'a))
+    (test-equal 'd (dict-ref dtd d 'c))
+    (test-equal 'b (dict-ref dtd dict-original 'a)))
+
+  (test-group
+    "dict-replace!"
+    (define d (dict-replace! dtd (alist->dict '((a . b) (c . d))) 'a 'b2))
+    (test-equal 'b2 (dict-ref dtd d 'a))
+    (test-equal 'd (dict-ref dtd d 'c)))
+
+  (test-group
+    "dict-intern"
+    ;; intern existing
+    (let ()
+     (define-values
+       (d value)
+       (dict-intern dtd (alist->dict '((a . b))) 'a (lambda () 'd)))
+     (test-equal 'b (dict-ref dtd d 'a))
+     (test-equal 'b value))
+    ;; intern missing
+    (let ()
+      (define dict-original (alist->dict '((a . b))))
+     (define-values
+       (d value)
+       (dict-intern dtd dict-original 'c (lambda () 'd)))
+     (test-equal 'b (dict-ref dtd d 'a))
+     (test-equal 'd (dict-ref dtd d 'c))
+     (test-equal 'd value)
+     (test-equal #f (dict-ref/default dtd dict-original 'c #f))))
+
+  (test-group
+    "dict-intern!"
+    ;; intern existing
+    (let ()
+     (define-values
+       (d value)
+       (dict-intern! dtd (alist->dict '((a . b))) 'a (lambda () 'd)))
+     (test-equal 'b (dict-ref dtd d 'a))
+     (test-equal 'b value))
+    ;; intern missing
+    (let ()
+     (define-values
+       (d value)
+       (dict-intern! dtd (alist->dict '((a . b))) 'c (lambda () 'd)))
+     (test-equal 'b (dict-ref dtd d 'a))
+     (test-equal 'd (dict-ref dtd d 'c))
+     (test-equal 'd value)))
+
+  (test-group
+    "dict-update"
+    ;; update existing
+    (define dict-original (alist->dict '((a . "b"))))
+    (let ()
+     (define d (dict-update dtd dict-original 'a
+                      (lambda (value)
+                        (string-append value "2"))
+                      error
+                      (lambda (x) (string-append x "1"))))
+     (test-equal "b12" (dict-ref dtd d 'a))
+     (test-equal "b" (dict-ref dtd dict-original 'a)))
+    ;; update missing
+    (let ()
+     (define d (dict-update dtd dict-original 'c
+                      (lambda (value)
+                        (string-append value "2"))
+                      (lambda () "d1")
+                      (lambda (x) (string-append x "1"))))
+     (test-equal "d12" (dict-ref dtd d 'c))
+     (test-equal #f (dict-ref/default dtd dict-original 'c #f))))
+
+  (test-group
+    "dict-update!"
+    ;; update existing
+    (let ()
+     (define d (dict-update! dtd (alist->dict '((a . "b"))) 'a
+                      (lambda (value)
+                        (string-append value "2"))
+                      error
+                      (lambda (x) (string-append x "1"))))
+     (test-equal "b12" (dict-ref dtd d 'a)))
+    ;; update missing
+    (let ()
+     (define d (dict-update! dtd (alist->dict '((a . "b"))) 'c
+                      (lambda (value)
+                        (string-append value "2"))
+                      (lambda () "d1")
+                      (lambda (x) (string-append x "1"))))
+     (test-equal "d12" (dict-ref dtd d 'c))))
+
+  (test-group
+    "dict-update/default"
+    ;; update existing
+    (define dict-original (alist->dict '((a . "b"))))
+    (let ()
+     (define d (dict-update/default dtd dict-original 'a
+                      (lambda (value)
+                        (string-append value "2"))
+                      "d1"))
+     (test-equal "b2" (dict-ref dtd d 'a))
+     (test-equal "b" (dict-ref dtd dict-original 'a)))
+
+    ;; update missing
+    (let ()
+     (define d (dict-update/default dtd dict-original 'c
+                      (lambda (value)
+                        (string-append value "2"))
+                      "d1"))
+     (test-equal "d12" (dict-ref dtd d 'c))
+     (test-equal #f (dict-ref/default dtd dict-original 'c #f))))
+
+  (test-group
+    "dict-update/default!"
+    ;; update existing
+    (let ()
+     (define d (dict-update/default! dtd (alist->dict '((a . "b"))) 'a
+                      (lambda (value)
+                        (string-append value "2"))
+                      "d1"))
+     (test-equal "b2" (dict-ref dtd d 'a)))
+
+    ;; update missing
+    (let ()
+     (define d (dict-update/default! dtd (alist->dict '((a . "b"))) 'c
+                      (lambda (value)
+                        (string-append value "2"))
+                      "d1"))
+     (test-equal "d12" (dict-ref dtd d 'c))))
+
+  (test-group
+   "dict-pop"
+   (define dict-original (alist->dict '((a . b) (c . d))))
+    (define-values
+      (new-dict key value)
+      (dict-pop dtd dict-original))
+    (test-assert
+      (or
+        (and (equal? (dict->alist dtd new-dict) '((c . d)))
+             (equal? key 'a)
+             (equal? value 'b))
+
+        (and (equal? (dict->alist dtd new-dict) '((a . b)))
+             (equal? key 'c)
+             (equal? value 'd))))
+    (test-assert 'b (dict-ref dtd dict-original 'a))
+    (test-assert 'd (dict-ref dtd dict-original 'c)))
+
+  (test-group
+    "dict-pop!"
+    (define-values
+      (new-dict key value)
+      (dict-pop! dtd (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or
+        (and (equal? (dict->alist dtd new-dict) '((c . d)))
+             (equal? key 'a)
+             (equal? value 'b))
+
+        (and (equal? (dict->alist dtd new-dict) '((a . b)))
+             (equal? key 'c)
+             (equal? value 'd)))))
+
+  (test-group
+   "dict-map"
+   (define dict-original (alist->dict '((a . "a") (b . "b"))))
+    (define d (dict-map dtd
+                     (lambda (key value)
+                       (string-append value "2"))
+                     dict-original))
+    (test-equal "a2" (dict-ref dtd d 'a))
+    (test-equal "b2" (dict-ref dtd d 'b))
+    (test-equal "a" (dict-ref dtd dict-original 'a))
+    (test-equal "b" (dict-ref dtd dict-original 'b)))
+
+(test-group
+    "dict-map!"
+    (define d (dict-map! dtd
+                     (lambda (key value)
+                       (string-append value "2"))
+                     (alist->dict '((a . "a") (b . "b")))))
+    (test-equal "a2" (dict-ref dtd d 'a))
+    (test-equal "b2" (dict-ref dtd d 'b)))
+
+  (test-group
+   "dict-filter"
+   (define dict-original (alist->dict '((a . b) (c . d))))
+    (define d (dict-filter dtd
+                     (lambda (key value)
+                       (equal? value 'b))
+                     dict-original))
+    (test-equal '((a . b)) (dict->alist dtd d))
+    (test-equal 'd (dict-ref dtd dict-original 'c)))
+
+  (test-group
+    "dict-filter!"
+    (define d (dict-filter! dtd
+                     (lambda (key value)
+                       (equal? value 'b))
+                     (alist->dict '((a . b) (c . d)))))
+    (test-equal '((a . b)) (dict->alist dtd d)))
+
+  (test-group
+    "dict-remove"
+    (define dict-original (alist->dict '((a . b) (c . d))))
+    (define d (dict-remove dtd
+                     (lambda (key value)
+                       (equal? value 'b))
+                     dict-original))
+    (test-equal '((c . d)) (dict->alist dtd d))
+    (test-equal 'd (dict-ref dtd dict-original 'c)))
+
+  (test-group
+    "dict-remove!"
+    (define d (dict-remove! dtd
+                     (lambda (key value)
+                       (equal? value 'b))
+                     (alist->dict '((a . b) (c . d)))))
+    (test-equal '((c . d)) (dict->alist dtd d)))
+
+  (test-group
+    "dict-search"
+    ;; ignore
+    (let ()
+     (define-values
+       (dict value)
+       (dict-search dtd (alist->dict '((a . b))) 'c
+              (lambda (insert ignore)
+                (ignore 'foo))
+              (lambda args
+                (error "shouldn't happen"))))
+     (test-equal '((a . b)) (dict->alist dtd dict))
+     (test-equal value 'foo))
+
+    ;; insert
+    (let ()
+      (define dict-original (alist->dict '((a . b))))
+     (define-values
+       (dict value)
+       (dict-search dtd dict-original 'c
+              (lambda (insert ignore)
+                (insert 'd 'foo))
+              (lambda args
+                (error "shouldn't happen"))))
+     (test-equal 'b (dict-ref dtd dict 'a))
+     (test-equal 'd (dict-ref dtd dict 'c))
+     (test-equal value 'foo)
+     (test-equal #f (dict-ref/default dtd dict-original 'c #f)))
+
+    ;; update
+    (let ()
+      (define dict-original (alist->dict '((a . b))))
+     (define-values
+       (dict value)
+       (dict-search dtd dict-original 'a
+              (lambda args
+                (error "shouldn't happen"))
+              (lambda (key value update delete)
+                (update 'a2 'b2 'foo))))
+     (test-equal '((a2 . b2)) (dict->alist dtd dict))
+     (test-equal value 'foo)
+     (test-equal #f (dict-ref/default dtd dict-original 'a2 #f))
+     (test-equal 'b (dict-ref dtd dict-original 'a)))
+
+    ;; delete
+    (let ()
+      (define dict-original (alist->dict '((a . b) (c . d))))
+     (define-values
+       (dict value)
+       (dict-search dtd dict-original 'a
+              (lambda args
+                (error "shouldn't happen"))
+              (lambda (key value update delete)
+                (delete 'foo))))
+     (test-equal '((c . d)) (dict->alist dtd dict))
+     (test-equal value 'foo)
+     (test-equal 'b (dict-ref dtd dict-original 'a))))
+
+  (test-group
+    "dict-search!"
+    ;; ignore
+    (let ()
+     (define-values
+       (dict value)
+       (dict-search! dtd (alist->dict '((a . b))) 'c
+              (lambda (insert ignore)
+                (ignore 'foo))
+              (lambda args
+                (error "shouldn't happen"))))
+     (test-equal '((a . b)) (dict->alist dtd dict))
+     (test-equal value 'foo))
+
+    ;; insert
+    (let ()
+     (define-values
+       (dict value)
+       (dict-search! dtd (alist->dict '((a . b))) 'c
+              (lambda (insert ignore)
+                (insert 'd 'foo))
+              (lambda args
+                (error "shouldn't happen"))))
+     (test-equal 'b (dict-ref dtd dict 'a))
+     (test-equal 'd (dict-ref dtd dict 'c))
+     (test-equal value 'foo))
+
+    ;; update
+    (let ()
+     (define-values
+       (dict value)
+       (dict-search! dtd (alist->dict '((a . b))) 'a
+              (lambda args
+                (error "shouldn't happen"))
+              (lambda (key value update delete)
+                (update 'a2 'b2 'foo))))
+     (test-equal '((a2 . b2)) (dict->alist dtd dict))
+     (test-equal value 'foo))
+
+    ;; delete
+    (let ()
+     (define-values
+       (dict value)
+       (dict-search! dtd (alist->dict '((a . b) (c . d))) 'a
+              (lambda args
+                (error "shouldn't happen"))
+              (lambda (key value update delete)
+                (delete 'foo))))
+     (test-equal '((c . d)) (dict->alist dtd dict))
+     (test-equal value 'foo)))
+
+  (test-group
+   "dict-copy"
+   (define original-dict (alist->dict '((a . b))))
+   (define copied-dict (dict-copy dtd original-dict))
+   (test-assert (not (eq? original-dict copied-dict)))
+   (set! original-dict (dict-set! dtd original-dict 'c 'd))
+   (test-equal 'd (dict-ref dtd original-dict 'c))
+   (test-equal #f (dict-ref/default dtd copied-dict 'c #f)))
+
+  (test-group
+    "dict-size"
+    (test-equal 2 (dict-size dtd (alist->dict '((a . b) (c . d)))))
+    (test-equal 0 (dict-size dtd (alist->dict '()))))
+
+  (test-group
+    "dict-for-each"
+    (define lst '())
+    (dict-for-each dtd
+           (lambda (key value)
+             (set! lst (append lst (list key value))))
+           (alist->dict '((a . b) (c . d))))
+    (test-assert
+      (or (equal? '(a b c d) lst)
+          (equal? '(c d a b) lst))))
+
+  (test-group
+    "dict-count"
+    (define count (dict-count dtd
+                         (lambda (key value)
+                           (equal? value 'b))
+                         (alist->dict '((a . b) (c . d)))))
+    (test-equal count 1))
+
+  (test-group
+    "dict-any"
+
+    (let ()
+     (define value
+       (dict-any dtd
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value 'foo))
+
+    (let ()
+     (define value
+       (dict-any dtd
+              (lambda (key value)
+                (if (equal? 'e value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value #f)))
+
+  (test-group
+    "dict-every"
+    (let ()
+     (define value
+       (dict-every dtd
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . b)))))
+     (test-equal value 'foo))
+
+    (let ()
+     (define value
+       (dict-every dtd
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '())))
+     (test-equal value #t))
+
+    (let ()
+     (define value
+       (dict-every dtd
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value #f)))
+
+  (test-group
+    "dict-keys"
+    (define keys
+      (dict-keys dtd (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(a c) keys)
+          (equal? '(c a) keys))))
+
+  (test-group
+    "dict-values"
+    (define vals
+      (dict-values dtd (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(b d) vals)
+          (equal? '(d b) vals))))
+
+  (test-group
+    "dict-entries"
+    (define-values
+      (keys vals)
+      (dict-entries dtd (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (and (equal? '(a c) keys)
+               (equal? '(b d) vals))
+          (and (equal? '(c a) keys)
+               (equal? '(d b) vals)))))
+
+  (test-group
+    "dict-fold"
+    (define value
+      (dict-fold dtd
+             (lambda (key value acc)
+               (append acc (list key value)))
+             '()
+             (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(a b c d) value)
+          (equal? '(c d a b) value))))
+
+  (test-group
+    "dict-map->list"
+    (define lst
+      (dict-map->list dtd
+             (lambda (key value)
+               (string-append (symbol->string key)
+                              value))
+             (alist->dict '((a . "b") (c . "d")))))
+    (test-assert
+      (or (equal? '("ab" "cd") lst)
+          (equal? '("cd" "ab") lst))))
+
+  (test-group
+    "dict->alist"
+    (define alist
+      (dict->alist dtd (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '((a . b) (c . d)) alist)
+          (equal? '((c . d) (a . b)) alist))))
+
+  (test-group
+   "dict-comparator"
+   ;; extremelly basic generic test; more useful specific tests defined separately
+   ;; for each dtd
+   (test-assert (comparator? (dict-comparator dtd (alist->dict '((a . b)))))))
+
+  ;; check all procs were called
+  (for-each
+   (lambda (index)
+     (when (= 0 (vector-ref counter index))
+       (error "Untested procedure" index)))
+   (iota (vector-length counter))))
+
+(test-begin "Dictionaries")
+
+(test-group
+ "default"
+ ;; test defaults by overring only procedures that raise error otherwise
+ (define alist-dtd (make-alist-dtd equal?))
+ (define default-dtd
+   (make-modified-dtd
+    alist-dtd
+    make-dictionary-index (dtd-ref alist-dtd make-dictionary-index)
+    dictionary?-index (dtd-ref alist-dtd dictionary?-index)
+    dict-size-index (dtd-ref alist-dtd dict-size-index)
+    dict-search-index (dtd-ref alist-dtd dict-search-index)
+    dict-for-each-index (dtd-ref alist-dtd dict-for-each-index)))
+ (do-test
+  default-dtd
+  alist-copy
+  #f))
+
+(test-group
+  "alist"
+  (do-test
+   (make-alist-dtd equal?)
+   ;; copy to a mutable list
+   ;; so that mutating procedures don't fail
+   alist-copy
+   #f)
+
+  ;; TODO test alist handling with different alist-dtd variants
+  ;; TODO test comparator
+  )
+
+(test-group
+  "plist"
+  (do-test
+   plist-dtd
+    (lambda (alist)
+      (apply append
+             (map (lambda (pair)
+                    (list (car pair) (cdr pair)))
+                  alist)))
+    #f)
+  ;; TODO test comparator
+  )
+
+(test-group
+ "srfi-69"
+ (do-test
+  srfi-69-dtd
+  (lambda (alist)
+    (define table (t69:make-hash-table equal?))
+    (for-each
+     (lambda (pair)
+       (t69:hash-table-set! table (car pair) (cdr pair)))
+     alist)
+    table)
+  (make-comparator (lambda args #t)
+                   equal?
+                   #f
+                   #f))
+ ;; TODO test comparator
+ )
+
+(test-group
+ "srfi-125"
+ (do-test
+  hash-table-dtd
+  (lambda (alist)
+    (define table (t125:make-hash-table equal?))
+    (for-each
+     (lambda (pair)
+       (t125:hash-table-set! table (car pair) (cdr pair)))
+     alist)
+    table)
+  (make-comparator (lambda args #t)
+                   equal?
+                   #f
+                   default-hash))
+ ;; TODO test comparator
+ )
+
+#|
+(cond-expand
+  (guile)
+  ((library (srfi 126))
+   (test-group
+     "srfi-126 (r6rs)"
+     (include "srfi-126-impl.scm")
+     (clear-registry!)
+     (register-srfi-126!)
+     (do-test (lambda (alist)
+                (define table (make-eqv-hashtable))
+                (for-each
+                  (lambda (pair)
+                    (hashtable-set! table (car pair) (cdr pair)))
+                  alist)
+                table))))
+  (else))
+|#
+
+
+(test-end)
diff --git a/srfi-225.html b/srfi-225.html
index 8c43c74..e4bbca2 100644
--- a/srfi-225.html
+++ b/srfi-225.html
@@ -96,8 +96,8 @@ If the dictionary type does not accept a comparator, <code>#f</code> should be p
 <blockquote><pre>; new values are prepended
 (dict-set aed dict 7 8) =&gt; ((7 . 8) (1 . 2) (3 . 4) (5 . 6))
 (dict-set aed dict 3 5) =&gt; ((3 . 5) (1 . 2) (3 . 4) (5 . 6)</pre></blockquote>
-<p><code>(dict-adjoin</code>&nbsp;<em>dtd dictionary objs</em><code>)</code><br>
-<code>(dict-adjoin!</code>&nbsp;<em>dtd dictionary objs</em><code>)</code></p>
+<p><code>(dict-adjoin</code>&nbsp;<em>dtd dictionary obj</em> ...<code>)</code><br>
+<code>(dict-adjoin!</code>&nbsp;<em>dtd dictionary obj</em> ...<code>)</code></p>
 <p>Returns a dictionary that contains all the associations of <em>dictionary</em> plus those specified by <em>objs</em>, which alternate between keys and values. If a key to be added already exists in <em>dictionary</em>, the old value prevails.</p>
 <blockquote><pre>; new values are prepended to alists
 (dict-adjoin aed dict 7 8) =&gt; ((7 . 8) (1 . 2) (3 . 4) (5 . 6))
diff --git a/srfi/225-impl.scm b/srfi/225-impl.scm
new file mode 100644
index 0000000..f24c180
--- /dev/null
+++ b/srfi/225-impl.scm
@@ -0,0 +1,13 @@
+(include "indexes.scm")
+(include "externals.scm")
+(include "default-impl.scm")
+(include "alist-impl.scm")
+(include "plist-impl.scm")
+
+(cond-expand
+  ((library (srfi 69))
+   (define srfi-69-dtd
+     (let ()
+       (include "srfi-69-impl.scm")
+       (make-srfi-69-dtd))))
+  (else))
diff --git a/srfi/225.scm b/srfi/225.scm
new file mode 120000
index 0000000..74d5e72
--- /dev/null
+++ b/srfi/225.scm
@@ -0,0 +1 @@
+225.sld
\ No newline at end of file
diff --git a/srfi/225.sld b/srfi/225.sld
new file mode 100644
index 0000000..c009606
--- /dev/null
+++ b/srfi/225.sld
@@ -0,0 +1,179 @@
+(define-library
+  (srfi 225)
+
+  ;; imports
+  (import (scheme base)
+          (scheme case-lambda)
+          (scheme write)
+          (srfi 1)
+          (srfi 128))
+
+  (cond-expand
+    ((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 (srfi 126)))
+    (else))
+
+  ;; exports
+  (export
+
+    ;; constructor
+    make-dictionary
+
+    ;; predicates
+    dictionary?
+    dict-empty?
+    dict-contains?
+
+    ;; lookup
+    dict-ref
+    dict-ref/default
+
+    ;; mutation
+    dict-set
+    dict-set!
+    dict-adjoin
+    dict-adjoin!
+    dict-delete
+    dict-delete!
+    dict-delete-all
+    dict-delete-all!
+    dict-replace
+    dict-replace!
+    dict-intern
+    dict-intern!
+    dict-update
+    dict-update!
+    dict-update/default
+    dict-update/default!
+    dict-pop
+    dict-pop!
+    dict-map
+    dict-map!
+    dict-filter
+    dict-filter!
+    dict-remove
+    dict-remove!
+    dict-search
+    dict-search!
+
+    ;; whole dictionary
+    dict-copy
+    dict-size
+    dict-for-each
+    dict-count
+    dict-any
+    dict-every
+    dict-keys
+    dict-values
+    dict-entries
+    dict-fold
+    dict-map->list
+    dict->alist
+    dict-comparator
+
+    ;; dictionary type descriptors
+    dtd?
+    make-dtd
+    dtd
+    make-modified-dtd
+    make-alist-dtd
+    dtd-ref
+
+    ;; exceptions
+    dictionary-error?
+    dictionary-message
+    dictionary-irritants
+
+    ;; proc indeces
+    make-dictionary-index
+    dictionary?-index
+    dict-empty?-index
+    dict-contains?-index
+    dict-ref-index
+    dict-ref/default-index
+    dict-set-index
+    dict-set!-index
+    dict-adjoin-index
+    dict-adjoin!-index
+    dict-delete-index
+    dict-delete!-index
+    dict-delete-all-index
+    dict-delete-all!-index
+    dict-replace-index
+    dict-replace!-index
+    dict-intern-index
+    dict-intern!-index
+    dict-update-index
+    dict-update!-index
+    dict-update/default-index
+    dict-update/default!-index
+    dict-pop-index
+    dict-pop!-index
+    dict-map-index
+    dict-map!-index
+    dict-filter-index
+    dict-filter!-index
+    dict-remove-index
+    dict-remove!-index
+    dict-search-index
+    dict-search!-index
+    dict-copy-index
+    dict-size-index
+    dict-for-each-index
+    dict-count-index
+    dict-any-index
+    dict-every-index
+    dict-keys-index
+    dict-values-index
+    dict-entries-index
+    dict-fold-index
+    dict-map->list-index
+    dict->alist-index
+    dict-comparator-index
+
+    ;; basic DTDs
+    plist-dtd
+    alist-eqv-dtd
+    alist-equal-dtd)
+
+    ;; implementations
+    (include "indexes.scm")
+    (include "externals.scm")
+    (include "default-impl.scm")
+    (include "alist-impl.scm")
+    (include "plist-impl.scm")
+
+    ;; library-dependent DTD exports
+    ;; and implementations
+    ;;
+    ;;srfi-69-dtd
+    ;;hash-table-dtd
+    ;;srfi-126-dtd
+    ;;mapping-dtd
+    ;;hash-mapping-dtd
+    (cond-expand
+        ((library (srfi 69))
+         (include "srfi-69-impl.scm")
+         (export srfi-69-dtd))
+        (else))
+
+    (cond-expand
+        ((library (srfi 125))
+         (include "srfi-125-impl.scm")
+         (export hash-table-dtd))
+        (else)))
diff --git a/srfi/alist-impl.scm b/srfi/alist-impl.scm
new file mode 100644
index 0000000..4463d1c
--- /dev/null
+++ b/srfi/alist-impl.scm
@@ -0,0 +1,123 @@
+(define (make-alist-dtd key=)
+
+  (define (make-alist dtd comparator)
+    (when comparator
+      (raise (dictionary-error "alist dtd doesn't accept comparator" dtd)))
+    '())
+
+  (define (alist? dtd l)
+    (and (list? l)
+         (or (null? l)
+             (pair? (car l)))))
+
+  (define (alist-map dtd proc alist)
+    (map
+     (lambda (e)
+       (define key (car e))
+       (define value (cdr e))
+       (cons key (proc key value)))
+     alist))
+
+  (define (alist-map! dtd proc alist)
+    (map!
+     (lambda (e)
+       (define key (car e))
+       (define value (cdr e))
+       (cons key (proc key value)))
+     alist))
+
+  (define (alist-filter dtd pred alist)
+    (filter
+     (lambda (e)
+       (pred (car e) (cdr e)))
+     alist))
+
+  (define (alist-filter! dtd pred alist)
+    (filter!
+     (lambda (e)
+       (pred (car e) (cdr e)))
+     alist))
+
+  (define (alist-delete dtd key alist)
+    (filter
+     (lambda (entry)
+       (not (key= (car entry) key)))
+     alist))
+
+  (define (alist-delete! dtd key alist)
+    (filter!
+     (lambda (entry)
+       (not (key= (car entry) key)))
+     alist))
+
+  (define (alist-search* dtd alist-delete-proc alist key failure success)
+    (define (handle-success pair)
+      (define old-key (car pair))
+      (define old-value (cdr pair))
+      (define (update new-key new-value obj)
+        (cond
+         ((and (eq? old-key
+                    new-key)
+               (eq? old-value
+                    new-value))
+          (values alist obj))
+         (else
+          (let ((new-list
+                 (alist-cons
+                  new-key new-value
+                  (alist-delete-proc dtd old-key alist))))
+            (values new-list obj)))))
+      (define (remove obj)
+        (values (alist-delete-proc dtd old-key alist) obj))
+      (success old-key old-value update remove))
+
+    (define (handle-failure)
+      (define (insert value obj)
+        (values (alist-cons key value alist)
+                obj))
+      (define (ignore obj)
+        (values alist obj))
+      (failure insert ignore))
+    (cond
+     ((assoc key alist key=) => handle-success)
+     (else (handle-failure))))
+
+  (define (alist-search dtd alist key failure success)
+    (alist-search* dtd alist-delete alist key failure success))
+
+  (define (alist-search! dtd alist key failure success)
+    (alist-search* dtd alist-delete! alist key failure success))
+
+  (define (alist-size dtd alist)
+    (length alist))
+
+  (define (alist-foreach dtd proc alist)
+    (define (proc* e)
+      (proc (car e) (cdr e)))
+    (for-each proc* alist))
+
+  (define (alist->alist dtd alist)
+    alist)
+
+  (define (alist-comparator dtd dictionary)
+    (make-comparator (lambda args #t)
+                     key=
+                     #f
+                     #f))
+
+  (make-dtd
+   make-dictionary-index make-alist
+   dictionary?-index alist?
+   dict-map-index alist-map
+   dict-map!-index alist-map!
+   dict-filter-index alist-filter
+   dict-filter!-index alist-filter!
+   dict-search-index alist-search
+   dict-search!-index alist-search!
+   dict-size-index alist-size
+   dict-for-each-index alist-foreach
+   dict->alist-index alist->alist
+   dict-comparator-index alist-comparator))
+
+(define alist-eqv-dtd (make-alist-dtd eqv?))
+(define alist-equal-dtd (make-alist-dtd equal?))
diff --git a/srfi/assumptions.scm b/srfi/assumptions.scm
new file mode 100644
index 0000000..86ef435
--- /dev/null
+++ b/srfi/assumptions.scm
@@ -0,0 +1,7 @@
+(define-syntax assume
+  (syntax-rules ()
+    ((assume expression message ...)
+     (or expression
+         (error "invalid assumption" (quote expression) (list message ...))))
+    ((assume . _)
+     (syntax-error "invalid assume syntax"))))
diff --git a/srfi/default-impl.scm b/srfi/default-impl.scm
new file mode 100644
index 0000000..649b6be
--- /dev/null
+++ b/srfi/default-impl.scm
@@ -0,0 +1,369 @@
+(define default-dtd
+  (let ()
+
+    ;; implementation of "default" dtd, used as a filler for undefined
+    ;; functions in other dtds
+
+    ;; primitives
+    (define (not-implemented name)
+      (lambda (dtd . args)
+        (raise (dictionary-error (string-append name " not implemented") dtd))))
+    (define default-make-dictionary (not-implemented "make-dictionary"))
+    (define default-dictionary? (not-implemented "dictionary?"))
+    (define default-dict-size (not-implemented "dict-size"))
+    (define default-dict-search (not-implemented "dict-search"))
+    (define default-dict-search! (not-implemented "dict-search!"))
+    (define default-dict-for-each (not-implemented "dict-for-each"))
+
+    (define (default-dict-empty? dtd dictionary)
+      (= 0 (dict-size dtd dictionary)))
+
+    (define (default-dict-contains? dtd dictionary key)
+      (dict-ref dtd dictionary key
+                (lambda () #f) (lambda (x) #t)))
+
+    (define (default-dict-ref dtd dictionary key failure success)
+      (define-values
+          (new-dict result)
+        (dict-search dtd dictionary key
+                     (lambda (_ ignore)
+                       (ignore (failure)))
+                     (lambda (key value update _)
+                       (update key value (success value)))))
+      result)
+
+    (define (default-dict-ref/default dtd dictionary key default)
+      (dict-ref dtd dictionary key
+                (lambda () default)
+                (lambda (x) x)))
+
+    ;; private
+    (define (default-dict-set* dtd dictionary dict-search-proc use-old? objs)
+      (let loop ((objs objs)
+                 (dictionary dictionary))
+        (cond
+         ((null? objs)
+          dictionary)
+         ((null? (cdr objs))
+          (error "mismatch of key / values argument list" objs))
+         (else (let*-values
+                   (((key) (car objs))
+                    ((value) (cadr objs))
+                    ((new-d _) (dict-search-proc dtd dictionary key
+                                                 (lambda (insert ignore)
+                                                   (insert value #f))
+                                                 (lambda (key old-value update delete)
+                                                   (update key (if use-old? old-value value) #f)))))
+                 (loop (cddr objs)
+                       new-d))))))
+
+    (define (default-dict-set dtd dictionary . objs)
+      (default-dict-set* dtd dictionary dict-search #f objs))
+
+    (define (default-dict-set! dtd dictionary . objs)
+      (default-dict-set* dtd dictionary dict-search! #f objs))
+
+    (define (default-dict-adjoin dtd dictionary . objs)
+      (default-dict-set* dtd dictionary dict-search #t objs))
+
+    (define (default-dict-adjoin! dtd dictionary . objs)
+      (default-dict-set* dtd dictionary dict-search! #t objs))
+
+    (define (default-dict-delete dtd dictionary . keys)
+      (dict-delete-all dtd dictionary keys))
+
+    (define (default-dict-delete! dtd dictionary . keys)
+      (dict-delete-all! dtd dictionary keys))
+
+    (define (default-dict-delete-all* dtd dictionary dict-search-proc keylist)
+      (let loop ((keylist keylist)
+                 (dictionary dictionary))
+        (cond
+         ((null? keylist) dictionary)
+         (else (let*-values
+                   (((key) (car keylist))
+                    ((new-d _) (dict-search-proc dtd dictionary key
+                                                 (lambda (_ ignore)
+                                                   (ignore #f))
+                                                 (lambda (key old-value _ delete)
+                                                   (delete #f)))))
+                 (loop (cdr keylist)
+                       new-d))))))
+
+    (define (default-dict-delete-all dtd dictionary keylist)
+      (default-dict-delete-all* dtd dictionary dict-search keylist))
+
+    (define (default-dict-delete-all! dtd dictionary keylist)
+      (default-dict-delete-all* dtd dictionary dict-search! keylist))
+
+    (define (default-dict-replace* dtd dictionary dict-search-proc key value)
+      (define-values
+          (new-dict _)
+        (dict-search-proc dtd dictionary key
+                          (lambda (_ ignore)
+                            (ignore #f))
+                          (lambda (key old-value update _)
+                            (update key value #f))))
+      new-dict)
+
+    (define (default-dict-replace dtd dictionary key value)
+      (default-dict-replace* dtd dictionary dict-search key value))
+
+    (define (default-dict-replace! dtd dictionary key value)
+      (default-dict-replace* dtd dictionary dict-search! key value))
+
+    (define (default-dict-intern* dtd dictionary dict-search-proc key failure)
+      (dict-search-proc dtd dictionary key
+                        (lambda (insert _)
+                          (let ((value (failure)))
+                            (insert value value)))
+                        (lambda (key value update _)
+                          (update key value value))))
+
+    (define (default-dict-intern dtd dictionary key failure)
+      (default-dict-intern* dtd dictionary dict-search key failure))
+
+    (define (default-dict-intern! dtd dictionary key failure)
+      (default-dict-intern* dtd dictionary dict-search! key failure))
+
+    (define (default-dict-update* dtd dictionary dict-search-proc key updater failure success)
+      (define-values
+          (new-dict _)
+        (dict-search-proc dtd dictionary key
+                          (lambda (insert ignore)
+                            (insert (updater (failure)) #f))
+                          (lambda (key value update _)
+                            (update key (updater (success value)) #f))))
+      new-dict)
+
+    (define (default-dict-update dtd dictionary key updater failure success)
+      (default-dict-update* dtd dictionary dict-search key updater failure success))
+
+    (define (default-dict-update! dtd dictionary key updater failure success)
+      (default-dict-update* dtd dictionary dict-search! key updater failure success))
+
+    (define (default-dict-update/default* dtd dictionary dict-update-proc key updater default)
+      (dict-update-proc dtd dictionary key updater
+                        (lambda () default)
+                        (lambda (x) x)))
+
+    (define (default-dict-update/default dtd dictionary key updater default)
+      (default-dict-update/default* dtd dictionary dict-update key updater default))
+
+    (define (default-dict-update/default! dtd dictionary key updater default)
+      (default-dict-update/default* dtd dictionary dict-update! key updater default))
+
+    (define (default-dict-pop* dtd dictionary dict-delete-proc)
+      (define (do-pop)
+        (call/cc
+         (lambda (cont)
+           (dict-for-each dtd
+                          (lambda (key value)
+                            (define new-dict
+                              (dict-delete-proc dtd dictionary key))
+                            (cont new-dict key value))
+                          dictionary))))
+      (define empty? (dict-empty? dtd dictionary))
+      (if empty?
+          (error "popped empty dictionary")
+          (do-pop)))
+
+    (define (default-dict-pop dtd dictionary)
+      (default-dict-pop* dtd dictionary dict-delete))
+
+    (define (default-dict-pop! dtd dictionary)
+      (default-dict-pop* dtd dictionary dict-delete!))
+
+    (define (default-dict-map* dtd dict-replace-proc mapper dictionary)
+      (define keys (dict-keys dtd dictionary))
+      (let loop ((keys keys)
+                 (dict dictionary))
+        (if (null? keys)
+            dict
+            (let* ((key (car keys))
+                   (val (mapper key (dict-ref dtd dict key))))
+              (loop (cdr keys)
+                    (dict-replace-proc dtd dict key val))))))
+
+    (define (default-dict-map dtd mapper dictionary)
+      (default-dict-map* dtd dict-replace mapper dictionary))
+
+    (define (default-dict-map! dtd mapper dictionary)
+      (default-dict-map* dtd dict-replace! mapper dictionary))
+
+    (define (default-dict-filter* dtd dict-delete-all-proc pred dictionary)
+      (define keys (dict-keys dtd dictionary))
+      (define keys-to-delete
+        (filter
+         (lambda (key)
+           (not (pred key (dict-ref dtd dictionary key))))
+         keys))
+      (dict-delete-all-proc dtd dictionary keys))
+
+    (define (default-dict-filter dtd pred dictionary)
+      (default-dict-filter* dtd dict-delete-all pred dictionary))
+
+    (define (default-dict-filter! dtd pred dictionary)
+      (default-dict-filter* dtd dict-delete-all! pred dictionary))
+
+    (define (default-dict-remove* dtd dict-filter-proc pred dictionary)
+      (dict-filter-proc dtd
+                        (lambda (key value)
+                          (not (pred key value)))
+                        dictionary))
+
+    (define (default-dict-remove dtd pred dictionary)
+      (default-dict-remove* dtd dict-filter pred dictionary))
+
+    (define (default-dict-remove! dtd pred dictionary)
+      (default-dict-remove* dtd dict-filter! pred dictionary))
+
+    (define (default-dict-copy dtd dictionary)
+      (dict-map dtd
+                (lambda (key value) value)
+                dictionary))
+
+    (define (default-dict-count dtd pred dictionary)
+      (dict-fold dtd
+                 (lambda (key value acc)
+                   (if (pred key value)
+                       (+ 1 acc)
+                       acc))
+                 0
+                 dictionary))
+
+    (define (default-dict-any dtd pred dictionary)
+      (call/cc
+       (lambda (cont)
+         (dict-for-each dtd
+                        (lambda (key value)
+                          (define ret (pred key value))
+                          (when ret
+                            (cont ret)))
+                        dictionary)
+         #f)))
+
+    (define (default-dict-every dtd pred dictionary)
+      (define last #t)
+      (call/cc
+       (lambda (cont)
+         (dict-for-each dtd
+                        (lambda (key value)
+                          (define ret (pred key value))
+                          (when (not ret)
+                            (cont #f))
+                          (set! last ret))
+                        dictionary)
+         last)))
+
+    (define (default-dict-keys dtd dictionary)
+      (reverse
+       (dict-fold dtd
+                  (lambda (key value acc)
+                    (cons key acc))
+                  '()
+                  dictionary)))
+
+    (define (default-dict-values dtd dictionary)
+      (reverse
+       (dict-fold dtd
+                  (lambda (key value acc)
+                    (cons value acc))
+                  '()
+                  dictionary)))
+
+    (define (default-dict-entries dtd dictionary)
+      (define pair
+        (dict-fold dtd
+                   (lambda (key value acc)
+                     (cons (cons key (car acc))
+                           (cons value (cdr acc))))
+                   (cons '() '())
+                   dictionary))
+      (values (reverse (car pair))
+              (reverse (cdr pair))))
+
+    (define (default-dict-fold dtd proc knil dictionary)
+      (define acc knil)
+      (dict-for-each dtd
+                     (lambda (key value)
+                       (set! acc (proc key value acc)))
+                     dictionary)
+      acc)
+
+    (define (default-dict-map->list dtd proc dictionary)
+      (define reverse-lst
+        (dict-fold dtd
+                   (lambda (key value lst)
+                     (cons (proc key value) lst))
+                   '()
+                   dictionary))
+      (reverse reverse-lst))
+
+    (define (default-dict->alist dtd dictionary)
+      (dict-map->list dtd
+                      cons
+                      dictionary))
+
+    (define default-dict-comparator (not-implemented "dict-comparator"))
+
+    (let ()
+      (define null-dtd (make-dtd-private (make-vector dict-procedures-count #f)))
+      (define default-dtd
+        (make-modified-dtd
+         null-dtd
+         make-dictionary-index default-make-dictionary
+         dictionary?-index default-dictionary?
+         dict-empty?-index default-dict-empty?
+         dict-contains?-index default-dict-contains?
+         dict-ref-index default-dict-ref
+         dict-ref/default-index default-dict-ref/default
+         dict-set-index default-dict-set
+         dict-set!-index default-dict-set!
+         dict-adjoin-index default-dict-adjoin
+         dict-adjoin!-index default-dict-adjoin!
+         dict-delete-index default-dict-delete
+         dict-delete!-index default-dict-delete!
+         dict-delete-all-index default-dict-delete-all
+         dict-delete-all!-index default-dict-delete-all!
+         dict-replace-index default-dict-replace
+         dict-replace!-index default-dict-replace!
+         dict-intern-index default-dict-intern
+         dict-intern!-index default-dict-intern!
+         dict-update-index default-dict-update
+         dict-update!-index default-dict-update!
+         dict-update/default-index default-dict-update/default
+         dict-update/default!-index default-dict-update/default!
+         dict-pop-index default-dict-pop
+         dict-pop!-index default-dict-pop!
+         dict-map-index default-dict-map
+         dict-map!-index default-dict-map!
+         dict-filter-index default-dict-filter
+         dict-filter!-index default-dict-filter!
+         dict-remove-index default-dict-remove
+         dict-remove!-index default-dict-remove!
+         dict-search-index default-dict-search
+         dict-search!-index default-dict-search!
+         dict-copy-index default-dict-copy
+         dict-size-index default-dict-size
+         dict-for-each-index default-dict-for-each
+         dict-count-index default-dict-count
+         dict-any-index default-dict-any
+         dict-every-index default-dict-every
+         dict-keys-index default-dict-keys
+         dict-values-index default-dict-values
+         dict-entries-index default-dict-entries
+         dict-fold-index default-dict-fold
+         dict-map->list-index default-dict-map->list
+         dict->alist-index default-dict->alist
+         dict-comparator-index default-dict-comparator))
+
+      ;; sanity check
+      (vector-for-each
+       (lambda (proc index)
+         (unless (and proc (procedure? proc))
+           (error "Missing or wrong default procedure definition" proc index)))
+       (procvec default-dtd)
+       (list->vector (iota dict-procedures-count)))
+
+      default-dtd)))
diff --git a/srfi/externals.scm b/srfi/externals.scm
new file mode 100644
index 0000000..8fee936
--- /dev/null
+++ b/srfi/externals.scm
@@ -0,0 +1,140 @@
+;; procedure definitions that don't rely on concrete implementations
+
+(define-record-type <dtd>
+  (make-dtd-private procvec)
+  dtd?
+  (procvec procvec))
+
+(define-record-type <dtd-err>
+  (make-dictionary-error message irritants)
+  dictionary-error?
+  (message dictionary-message)
+  (irritants dictionary-irritants))
+
+(define-syntax define/dict-proc
+  (syntax-rules ()
+    ((_ proc index)
+     (define (proc dtd . args)
+       (assume (dtd? dtd))
+       (apply (vector-ref (procvec dtd) index) dtd args)))))
+
+(define/dict-proc make-dictionary make-dictionary-index)
+(define/dict-proc dictionary? dictionary?-index)
+(define/dict-proc dict-empty? dict-empty?-index)
+(define/dict-proc dict-contains? dict-contains?-index)
+
+(define dict-ref
+  (case-lambda
+    ((dtd dict key)
+     (dict-ref dtd dict key
+               (lambda () (error "Key not found in dictionary" dict key))
+               values))
+
+    ((dtd dict key failure)
+     (dict-ref dtd dict key failure values))
+
+    ((dtd dict key failure success)
+     (assume (dtd? dtd))
+     ((vector-ref (procvec dtd) dict-ref-index) dtd dict key failure success))))
+
+(define/dict-proc dict-ref/default dict-ref/default-index)
+(define/dict-proc dict-set dict-set-index)
+(define/dict-proc dict-set! dict-set!-index)
+(define/dict-proc dict-adjoin dict-adjoin-index)
+(define/dict-proc dict-adjoin! dict-adjoin!-index)
+(define/dict-proc dict-delete dict-delete-index)
+(define/dict-proc dict-delete! dict-delete!-index)
+(define/dict-proc dict-delete-all dict-delete-all-index)
+(define/dict-proc dict-delete-all! dict-delete-all!-index)
+(define/dict-proc dict-replace dict-replace-index)
+(define/dict-proc dict-replace! dict-replace!-index)
+(define/dict-proc dict-intern dict-intern-index)
+(define/dict-proc dict-intern! dict-intern!-index)
+
+(define dict-update
+  (case-lambda
+    ((dtd dict key updater)
+     (dict-update dtd dict key updater
+                  (lambda () (error "Key not found in dictionary" dict key))
+                  values))
+
+    ((dtd dict key updater failure)
+     (dict-update dtd dict key  updater failure values))
+
+    ((dtd dict key updater failure success)
+     (assume (dtd? dtd))
+     ((vector-ref (procvec dtd) dict-update-index) dtd dict key updater failure success))))
+
+(define dict-update!
+  (case-lambda
+    ((dtd dict key updater)
+     (dict-update! dtd dict key updater
+                   (lambda () (error "Key not found in dictionary" dict key))
+                   values))
+
+    ((dtd dict key updater failure)
+     (dict-update! dtd dict key  updater failure values))
+
+    ((dtd dict key updater failure success)
+     (assume (dtd? dtd))
+     ((vector-ref (procvec dtd) dict-update!-index) dtd dict key updater failure success))))
+
+(define/dict-proc dict-update/default dict-update/default-index)
+(define/dict-proc dict-update/default! dict-update/default!-index)
+(define/dict-proc dict-pop dict-pop-index)
+(define/dict-proc dict-pop! dict-pop!-index)
+(define/dict-proc dict-map dict-map-index)
+(define/dict-proc dict-map! dict-map!-index)
+(define/dict-proc dict-filter dict-filter-index)
+(define/dict-proc dict-filter! dict-filter!-index)
+(define/dict-proc dict-remove dict-remove-index)
+(define/dict-proc dict-remove! dict-remove!-index)
+(define/dict-proc dict-search dict-search-index)
+(define/dict-proc dict-search! dict-search!-index)
+(define/dict-proc dict-copy dict-copy-index)
+(define/dict-proc dict-size dict-size-index)
+(define/dict-proc dict-for-each dict-for-each-index)
+(define/dict-proc dict-count dict-count-index)
+(define/dict-proc dict-any dict-any-index)
+(define/dict-proc dict-every dict-every-index)
+(define/dict-proc dict-keys dict-keys-index)
+(define/dict-proc dict-values dict-values-index)
+(define/dict-proc dict-entries dict-entries-index)
+(define/dict-proc dict-fold dict-fold-index)
+(define/dict-proc dict-map->list dict-map->list-index)
+(define/dict-proc dict->alist dict->alist-index)
+(define/dict-proc dict-comparator dict-comparator-index)
+
+(define (dtd-ref dtd procindex)
+  (vector-ref (procvec dtd) procindex))
+
+(define (make-modified-dtd dtd . lst)
+  (define vec (vector-copy (procvec dtd)))
+  (do ((lst lst (cddr lst)))
+      ((null? lst))
+    (when (null? (cdr lst))
+      (error "Uneven amount of arguments" lst))
+    (let ((proc-index (car lst))
+          (proc (cadr lst)))
+      (unless (procedure? proc)
+        (error "Not a procedure" proc))
+      (vector-set! vec proc-index proc)))
+  (make-dtd-private vec))
+
+(define (make-dtd . lst)
+  (apply make-modified-dtd default-dtd lst))
+
+(define-syntax dtd-helper
+  (syntax-rules ()
+    ((_ (arg ...) (index proc) rest ...)
+     (dtd-helper (arg ... index proc) rest ...))
+    ((_ (arg ...))
+     (make-dtd arg ...))))
+
+(define-syntax dtd
+  (syntax-rules ()
+    ((_ (index proc) ...)
+     (dtd-helper () (index proc) ...))))
+
+(define (dictionary-error message . irritants)
+  (make-dictionary-error message irritants))
diff --git a/srfi/indexes.scm b/srfi/indexes.scm
new file mode 100644
index 0000000..da99b57
--- /dev/null
+++ b/srfi/indexes.scm
@@ -0,0 +1,53 @@
+;; procedure index definitions
+
+(define proc-index 0)
+(define (proc-index-inc)
+  (define v proc-index)
+  (set! proc-index (+ 1 proc-index))
+  v)
+(define make-dictionary-index (proc-index-inc))
+(define dictionary?-index (proc-index-inc))
+(define dict-empty?-index (proc-index-inc))
+(define dict-contains?-index (proc-index-inc))
+(define dict-ref-index (proc-index-inc))
+(define dict-ref/default-index (proc-index-inc))
+(define dict-set-index (proc-index-inc))
+(define dict-set!-index (proc-index-inc))
+(define dict-adjoin-index (proc-index-inc))
+(define dict-adjoin!-index (proc-index-inc))
+(define dict-delete-index (proc-index-inc))
+(define dict-delete!-index (proc-index-inc))
+(define dict-delete-all-index (proc-index-inc))
+(define dict-delete-all!-index (proc-index-inc))
+(define dict-replace-index (proc-index-inc))
+(define dict-replace!-index (proc-index-inc))
+(define dict-intern-index (proc-index-inc))
+(define dict-intern!-index (proc-index-inc))
+(define dict-update-index (proc-index-inc))
+(define dict-update!-index (proc-index-inc))
+(define dict-update/default-index (proc-index-inc))
+(define dict-update/default!-index (proc-index-inc))
+(define dict-pop-index (proc-index-inc))
+(define dict-pop!-index (proc-index-inc))
+(define dict-map-index (proc-index-inc))
+(define dict-map!-index (proc-index-inc))
+(define dict-filter-index (proc-index-inc))
+(define dict-filter!-index (proc-index-inc))
+(define dict-remove-index (proc-index-inc))
+(define dict-remove!-index (proc-index-inc))
+(define dict-search-index (proc-index-inc))
+(define dict-search!-index (proc-index-inc))
+(define dict-copy-index (proc-index-inc))
+(define dict-size-index (proc-index-inc))
+(define dict-for-each-index (proc-index-inc))
+(define dict-count-index (proc-index-inc))
+(define dict-any-index (proc-index-inc))
+(define dict-every-index (proc-index-inc))
+(define dict-keys-index (proc-index-inc))
+(define dict-values-index (proc-index-inc))
+(define dict-entries-index (proc-index-inc))
+(define dict-fold-index (proc-index-inc))
+(define dict-map->list-index (proc-index-inc))
+(define dict->alist-index (proc-index-inc))
+(define dict-comparator-index (proc-index-inc))
+(define dict-procedures-count (proc-index-inc))
diff --git a/srfi/plist-impl.scm b/srfi/plist-impl.scm
new file mode 100644
index 0000000..e73bc94
--- /dev/null
+++ b/srfi/plist-impl.scm
@@ -0,0 +1,124 @@
+(define plist-dtd
+  (let ()
+
+    (define (make-plist dtd comparator)
+      (when comparator
+        (raise (dictionary-error "plist dtd doesn't accept comparator" dtd)))
+      '())
+
+    (define (plist? dtd l)
+      (and (list? l)
+           (or (null? l)
+               (symbol? (car l)))))
+
+    (define (plist-map dtd proc plist)
+      (plist-map! dtd proc (dict-copy dtd plist)))
+
+    (define (plist-map! dtd proc plist)
+      (let loop ((pl plist))
+        (cond
+         ((null? pl) plist)
+         ((null? (cdr pl)) (error "Malformed plist" plist))
+         (else
+          (let ((key (car pl))
+                (value (cadr pl))
+                (rest (cddr pl)))
+            (set-car! (cdr pl)
+                      (proc key value))
+            (loop rest))))))
+
+    (define (plist-filter dtd pred plist)
+      (plist-filter! dtd pred (dict-copy dtd plist)))
+
+    (define (plist-filter! dtd pred plist)
+      (define head (cons #f plist))
+      (let loop ((pl plist)
+                 (parent-cell head))
+        (cond
+         ((null? pl) (cdr head))
+         ((null? (cdr pl)) (error "Malformed plist" plist))
+         (else
+          (let ((key (car pl))
+                (value (cadr pl))
+                (rest (cddr pl)))
+            (if (pred key value)
+                (loop rest
+                      (cdr pl))
+                (loop (begin
+                        (set-cdr! parent-cell rest)
+                        rest)
+                      parent-cell)))))))
+
+    ;; head is a pair, whose cdr is the plist
+    ;; if found, returns a pair, whose cdr is rest of plist, and cadr is key that was searched for
+    ;; if not found, returns #f
+    ;;
+    ;; the pair indirection is used so that calling set-cdr! on the result allows the plist to be mutated
+    (define (find-plist-entry key head)
+      (define plist (cdr head))
+      (cond
+       ((null? plist) #f)
+       ((equal? key (car plist)) head)
+       (else (find-plist-entry key (cdr plist)))))
+
+    (define (plist-search dtd plist key failure success)
+      (plist-search! dtd (dict-copy dtd plist) key failure success))
+
+    (define (plist-search! dtd plist key failure success)
+      (define plist-head (cons #t plist))
+      (define (handle-success head)
+        (define key-cell (cdr head))
+        (define val-cell (cddr head))
+        (define (update new-key new-value obj)
+          (set-car! key-cell new-key)
+          (set-car! val-cell new-value)
+          (values plist obj))
+        (define (remove obj)
+          (set-cdr! head (cddr (cdr head)))
+          (values (cdr plist-head) obj))
+        (success (car key-cell) (car val-cell) update remove))
+
+      (define (handle-failure)
+        (define (insert value obj)
+          (values (cons key (cons value plist))
+                  obj))
+        (define (ignore obj)
+          (values plist obj))
+        (failure insert ignore))
+      (cond
+       ((find-plist-entry key plist-head) => handle-success)
+       (else (handle-failure))))
+
+    (define (plist-copy dtd plist)
+      (list-copy plist))
+
+    (define (plist-size dtd plist)
+      (/ (length plist) 2))
+
+    (define (plist-foreach dtd proc plist)
+      (let loop ((pl plist))
+        (if (null? pl) #t
+            (begin
+              (proc (car pl) (cadr pl))
+              (loop (cddr pl))))))
+
+    (define (plist-comparator dtd plist)
+      (make-comparator symbol?
+                       equal?
+                       #f
+                       #f))
+
+    (make-dtd
+     make-dictionary-index make-plist
+     dictionary?-index plist?
+     dict-map-index plist-map
+     dict-map!-index plist-map!
+     dict-filter-index plist-filter
+     dict-filter!-index plist-filter!
+     dict-search-index plist-search
+     dict-search!-index plist-search!
+     dict-copy-index plist-copy
+     dict-size-index plist-size
+     dict-for-each-index plist-foreach
+     dict-comparator-index plist-comparator)
+    ))
diff --git a/srfi/srfi-125-impl.scm b/srfi/srfi-125-impl.scm
new file mode 100644
index 0000000..61863b5
--- /dev/null
+++ b/srfi/srfi-125-impl.scm
@@ -0,0 +1,160 @@
+(define hash-table-dtd
+  (let ()
+
+    (define (t125:make-hash-table* dtd comparator)
+      (t125:hash-table comparator))
+
+    (define (t125:hash-table-set!* dtd table . obj)
+      (apply t125:hash-table-set! (cons table obj))
+      table)
+
+    (define (t125:hash-table-update!* dtd table key updater fail success)
+      (t125:hash-table-update! table key updater fail success)
+      table)
+
+    (define (t125:hash-table-update!/default* dtd table key proc default)
+      (t125:hash-table-update!/default table key proc default)
+      table)
+
+    (define (t125:hash-table-intern!* dtd table key failure)
+      (define val (t125:hash-table-intern! table key failure))
+      (values table val))
+
+    (define (t125:hash-table-pop!* dtd table)
+      (if (t125:hash-table-empty? table)
+          (error "popped empty dictionary")
+          (call-with-values
+              (lambda () (t125:hash-table-pop! table))
+            (lambda (key value) (values table key value)))))
+
+    (define (t125:hash-table-delete-all!* dtd table keys)
+      (for-each
+       (lambda (key)
+         (t125:hash-table-delete! table key))
+       keys)
+      table)
+
+    (define (t125:hash-table-map!* dtd proc table)
+      (t125:hash-table-map! proc table)
+      table)
+
+    (define (t125:hash-table-filter!* dtd proc table)
+      (t125:hash-table-prune!
+       (lambda (key value)
+         (not (proc key value)))
+       table)
+      table)
+
+    (define (t125:hash-table-filter* dtd proc table)
+      (dict-filter! dtd proc (dict-copy dtd table)))
+
+    (define (t125:hash-table-remove!* dtd proc table)
+      (t125:hash-table-prune! proc table)
+      table)
+
+    (define (t125:hash-table-remove* dtd proc table)
+      (dict-remove! dtd proc (dict-copy dtd table)))
+
+    (define (t125:hash-table-search!* dtd table key fail success)
+      (define (handle-success value)
+        (define (update new-key new-value obj)
+          (unless (eq? new-key key)
+            (t125:hash-table-delete! table key))
+          (t125:hash-table-set! table new-key new-value)
+          (values table obj))
+        (define (remove obj)
+          (t125:hash-table-delete! table key)
+          (values table obj))
+        (success key value update remove))
+      (define (handle-fail)
+        (define (ignore obj)
+          (values table obj))
+        (define (insert value obj)
+          (t125:hash-table-set! table key value)
+          (values table obj))
+        (fail insert ignore))
+
+      (define default (cons #f #f))
+      (t125:hash-table-ref table key handle-fail handle-success))
+
+    (define (t125:hash-table-search* dtd table key fail success)
+      (t125:hash-table-search!* dtd (dict-copy dtd table) key fail success))
+
+    (define (t125:hash-table-comparator* dtd table)
+      (make-comparator (lambda args #t)
+                       (t125:hash-table-equivalence-function table)
+                       #f
+                       (t125:hash-table-hash-function table)))
+
+    (define (t125:hash-table-copy* dtd table)
+      (t125:hash-table-copy table))
+
+    (define (t125:hash-table-size* dtd table)
+      (t125:hash-table-size table))
+
+    (define (t125:hash-table-for-each* dtd proc table)
+      (t125:hash-table-for-each proc table))
+
+    (define (t125:hash-table-keys* dtd table)
+      (t125:hash-table-keys table))
+
+    (define (t125:hash-table-values* dtd table)
+      (t125:hash-table-values table))
+
+    (define (t125:hash-table-entries* dtd table)
+      (t125:hash-table-entries table))
+
+    (define (t125:hash-table-fold* dtd proc knil table)
+      (t125:hash-table-fold proc knil table))
+
+    (define (t125:hash-table-map->list* dtd proc table)
+      (t125:hash-table-map->list proc table))
+
+    (define (t125:hash-table->alist* dtd table)
+      (t125:hash-table->alist table))
+
+    (define (t125:hash-table?* dtd table)
+      (t125:hash-table? table))
+
+    (define (t125:hash-table-empty?* dtd table)
+      (t125:hash-table-empty? table))
+
+    (define (t125:hash-table-contains?* dtd table key)
+      (t125:hash-table-contains? table key))
+
+    (define (t125:hash-table-ref* dtd table key failure success)
+      (t125:hash-table-ref table key failure success))
+
+    (define (t125:hash-table-ref/default* dtd table key default)
+      (t125:hash-table-ref/default table key default))
+
+    (make-dtd
+     make-dictionary-index t125:make-hash-table*
+     dictionary?-index t125:hash-table?*
+     dict-empty?-index t125:hash-table-empty?*
+     dict-contains?-index t125:hash-table-contains?*
+     dict-ref-index t125:hash-table-ref*
+     dict-ref/default-index t125:hash-table-ref/default*
+     dict-set!-index t125:hash-table-set!*
+     dict-delete-all!-index t125:hash-table-delete-all!*
+     dict-intern!-index t125:hash-table-intern!*
+     dict-update!-index t125:hash-table-update!*
+     dict-update/default!-index t125:hash-table-update!/default*
+     dict-pop!-index t125:hash-table-pop!*
+     dict-map!-index t125:hash-table-map!*
+     dict-filter!-index t125:hash-table-filter!*
+     dict-filter-index t125:hash-table-filter*
+     dict-remove!-index t125:hash-table-remove!*
+     dict-remove-index t125:hash-table-remove*
+     dict-search!-index t125:hash-table-search!*
+     dict-search-index t125:hash-table-search*
+     dict-size-index t125:hash-table-size*
+     dict-for-each-index t125:hash-table-for-each*
+     dict-keys-index t125:hash-table-keys*
+     dict-values-index t125:hash-table-values*
+     dict-entries-index t125:hash-table-entries*
+     dict-fold-index t125:hash-table-fold*
+     dict-map->list-index t125:hash-table-map->list*
+     dict->alist-index t125:hash-table->alist*
+     dict-comparator-index t125:hash-table-comparator*
+     dict-copy-index t125:hash-table-copy*)))
diff --git a/srfi/srfi-69-impl.scm b/srfi/srfi-69-impl.scm
new file mode 100644
index 0000000..f0e397e
--- /dev/null
+++ b/srfi/srfi-69-impl.scm
@@ -0,0 +1,142 @@
+(define srfi-69-dtd
+  (let ()
+
+    (define (t69:make-hash-table* dtd comparator)
+      (define constructor-args
+        (if (not comparator)
+            '()
+            (let ((pred (comparator-equality-predicate comparator))
+                  (hash (comparator-hash-function comparator)))
+              (if hash
+                  (list pred hash)
+                  (list pred)))))
+      (apply t69:make-hash-table constructor-args))
+
+    (define (t69:hash-table-ref* dtd table key fail success)
+      (define default (cons #f #f))
+      (define found (t69:hash-table-ref/default table key default))
+      (if (eq? found default)
+          (fail)
+          (success found)))
+
+    (define (t69:hash-table-set!* dtd table . obj)
+      (let loop ((obj obj))
+        (if (null? obj)
+            table
+            (begin
+              (t69:hash-table-set! table (car obj) (cadr obj))
+              (loop (cddr obj))))))
+
+    (define (t69:hash-table-update!/default* dtd table key proc default)
+      (t69:hash-table-update!/default table key proc default)
+      table)
+
+    (define (t69:hash-table-delete-all!* dtd table keys)
+      (for-each
+       (lambda (key)
+         (t69:hash-table-delete! table key))
+       keys)
+      table)
+
+    (define (t69:hash-table-foreach* dtd proc table)
+      (t69:hash-table-walk table proc))
+
+    (define (t69:hash-table-map!* dtd proc table)
+      (t69:hash-table-walk table (lambda (key value)
+                               (t69:hash-table-set! table key (proc key value))))
+      table)
+
+    (define (t69:hash-table-filter!* dtd proc table)
+      (t69:hash-table-walk table
+                       (lambda (key value)
+                         (unless (proc key value)
+                           (t69:hash-table-delete! table key))))
+      table)
+
+    (define (t69:hash-table-filter* dtd proc table)
+      (dict-filter! dtd proc (dict-copy dtd table)))
+
+    (define (t69:hash-table-fold* dtd proc knil table)
+      (t69:hash-table-fold table proc knil))
+
+    (define (t69:hash-table-search!* dtd table key fail success)
+      (define (handle-success value)
+        (define (update new-key new-value obj)
+          (unless (eq? new-key key)
+            (t69:hash-table-delete! table key))
+          (t69:hash-table-set! table new-key new-value)
+          (values table obj))
+        (define (remove obj)
+          (t69:hash-table-delete! table key)
+          (values table obj))
+        (success key value update remove))
+      (define (handle-fail)
+        (define (ignore obj)
+          (values table obj))
+        (define (insert value obj)
+          (t69:hash-table-set! table key value)
+          (values table obj))
+        (fail insert ignore))
+
+      (define default (cons #f #f))
+      (define found (t69:hash-table-ref/default table key default))
+      (if (eq? default found)
+          (handle-fail)
+          (handle-success found)))
+
+    (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)
+                           equal?)
+                       #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?*
+     dict-ref-index t69:hash-table-ref*
+     dict-ref/default-index 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-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-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-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*)))