fix default implementation

3 files changed, 378 insertions, 362 deletions

diff --git a/srfi-225-test.scm b/srfi-225-test.scm
index a14b51a..7d258aa 100644
--- a/srfi-225-test.scm
+++ b/srfi-225-test.scm
@@ -1,5 +1,6 @@
 (import (scheme base)
         (scheme case-lambda)
+        (scheme write)
         (srfi 1)
         (prefix (srfi 69) t69:)
         (prefix (srfi 125) t125:)
@@ -41,10 +42,11 @@
 
 (define (do-test real-dtd alist->dict comparator test-get-comparator)
 
+  (define dtd real-dtd)
+
   (define-values
       (dtd counter)
     (wrap-dtd real-dtd))
-
   (test-group
    "make-dictionary"
    (define dict (make-dictionary dtd comparator))
@@ -52,31 +54,31 @@
    (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))))))
+   "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)))))))
+   "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)))
+   "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))))
+   "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))
+   "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"
@@ -88,10 +90,10 @@
    (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)))
+   "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"
@@ -102,10 +104,10 @@
    (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)))
+   "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"
@@ -115,9 +117,9 @@
    (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))))
+   "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"
@@ -127,38 +129,38 @@
    (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))))
+   "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)))
+   (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)))
+   "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 ()
+   "dict-intern"
+   ;; intern existing
+   (let ()
      (define-values
-       (d value)
+         (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))))
+   ;; intern missing
+   (let ()
+     (define dict-original (alist->dict '((a . b))))
      (define-values
-       (d value)
+         (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))
@@ -166,111 +168,111 @@
      (test-equal #f (dict-ref/default dtd dict-original 'c #f))))
 
   (test-group
-    "dict-intern!"
-    ;; intern existing
-    (let ()
+   "dict-intern!"
+   ;; intern existing
+   (let ()
      (define-values
-       (d value)
+         (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 ()
+   ;; intern missing
+   (let ()
      (define-values
-       (d value)
+         (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 ()
+   "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"))))
+                            (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 ()
+   ;; 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"))))
+                            (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 ()
+   "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"))))
+                             (lambda (value)
+                               (string-append value "2"))
+                             error
+                             (lambda (x) (string-append x "1"))))
      (test-equal "b12" (dict-ref dtd d 'a)))
-    ;; update missing
-    (let ()
+   ;; 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"))))
+                             (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 ()
+   "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"))
+                                    (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 ()
+   ;; update missing
+   (let ()
      (define d (dict-update/default dtd dict-original 'c
-                      (lambda (value)
-                        (string-append value "2"))
-                      "d1"))
+                                    (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 ()
+   "dict-update/default!"
+   ;; update existing
+   (let ()
      (define d (dict-update/default! dtd (alist->dict '((a . "b"))) 'a
-                      (lambda (value)
-                        (string-append value "2"))
-                      "d1"))
+                                     (lambda (value)
+                                       (string-append value "2"))
+                                     "d1"))
      (test-equal "b2" (dict-ref dtd d 'a)))
 
-    ;; update missing
-    (let ()
+   ;; update missing
+   (let ()
      (define d (dict-update/default! dtd (alist->dict '((a . "b"))) 'c
-                      (lambda (value)
-                        (string-append value "2"))
-                      "d1"))
+                                     (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
+   (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))
@@ -278,16 +280,16 @@
         (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-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
+   "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))
@@ -299,166 +301,167 @@
   (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)))
+   (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-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)))
+
+   (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)))
+   "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)))
+   "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)))
+   "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 ()
+   "dict-search"
+   ;; ignore
+   (let ()
      (define-values
-       (dict value)
+         (dict value)
        (dict-search dtd (alist->dict '((a . b))) 'c
-              (lambda (insert ignore)
-                (ignore 'foo))
-              (lambda args
-                (error "shouldn't happen"))))
+                    (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))))
+   ;; insert
+   (let ()
+     (define dict-original (alist->dict '((a . b))))
      (define-values
-       (dict value)
+         (dict value)
        (dict-search dtd dict-original 'c
-              (lambda (insert ignore)
-                (insert 'd 'foo))
-              (lambda args
-                (error "shouldn't happen"))))
+                    (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))))
+   ;; update
+   (let ()
+     (define dict-original (alist->dict '((a . b))))
      (define-values
-       (dict value)
+         (dict value)
        (dict-search dtd dict-original 'a
-              (lambda args
-                (error "shouldn't happen"))
-              (lambda (key value update delete)
-                (update 'a2 'b2 'foo))))
+                    (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))))
+   ;; delete
+   (let ()
+     (define dict-original (alist->dict '((a . b) (c . d))))
      (define-values
-       (dict value)
+         (dict value)
        (dict-search dtd dict-original 'a
-              (lambda args
-                (error "shouldn't happen"))
-              (lambda (key value update delete)
-                (delete 'foo))))
+                    (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 ()
+   "dict-search!"
+   ;; ignore
+   (let ()
      (define-values
-       (dict value)
+         (dict value)
        (dict-search! dtd (alist->dict '((a . b))) 'c
-              (lambda (insert ignore)
-                (ignore 'foo))
-              (lambda args
-                (error "shouldn't happen"))))
+                     (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 ()
+   ;; insert
+   (let ()
      (define-values
-       (dict value)
+         (dict value)
        (dict-search! dtd (alist->dict '((a . b))) 'c
-              (lambda (insert ignore)
-                (insert 'd 'foo))
-              (lambda args
-                (error "shouldn't happen"))))
+                     (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 ()
+   ;; update
+   (let ()
      (define-values
-       (dict value)
+         (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))))
+                     (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 ()
+   ;; delete
+   (let ()
      (define-values
-       (dict value)
+         (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))))
+                     (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)))
 
@@ -466,138 +469,138 @@
    "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)))
+                                        ;(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 '()))))
+   "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))))
+   "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))
+   "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"
+   "dict-any"
 
-    (let ()
+   (let ()
      (define value
        (dict-any dtd
-              (lambda (key value)
-                (if (equal? 'b value) 'foo #f))
-              (alist->dict '((a . b) (c . d)))))
+                 (lambda (key value)
+                   (if (equal? 'b value) 'foo #f))
+                 (alist->dict '((a . b) (c . d)))))
      (test-equal value 'foo))
 
-    (let ()
+   (let ()
      (define value
        (dict-any dtd
-              (lambda (key value)
-                (if (equal? 'e value) 'foo #f))
-              (alist->dict '((a . b) (c . d)))))
+                 (lambda (key value)
+                   (if (equal? 'e value) 'foo #f))
+                 (alist->dict '((a . b) (c . d)))))
      (test-equal value #f)))
 
   (test-group
-    "dict-every"
-    (let ()
+   "dict-every"
+   (let ()
      (define value
        (dict-every dtd
-              (lambda (key value)
-                (if (equal? 'b value) 'foo #f))
-              (alist->dict '((a . b) (c . b)))))
+                   (lambda (key value)
+                     (if (equal? 'b value) 'foo #f))
+                   (alist->dict '((a . b) (c . b)))))
      (test-equal value 'foo))
 
-    (let ()
+   (let ()
      (define value
        (dict-every dtd
-              (lambda (key value)
-                (if (equal? 'b value) 'foo #f))
-              (alist->dict '())))
+                   (lambda (key value)
+                     (if (equal? 'b value) 'foo #f))
+                   (alist->dict '())))
      (test-equal value #t))
 
-    (let ()
+   (let ()
      (define value
        (dict-every dtd
-              (lambda (key value)
-                (if (equal? 'b value) 'foo #f))
-              (alist->dict '((a . b) (c . d)))))
+                   (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))))
+   "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"
@@ -621,49 +624,49 @@
  "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
+ (define minimal-alist-dtd
+   (make-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)))
+    dict-search!-index (dtd-ref alist-dtd dict-search!-index)
+    dict-for-each-index (dtd-ref alist-dtd dict-for-each-index)
+    dict-comparator-index (dtd-ref alist-dtd dict-comparator-index)))
  (do-test
-  default-dtd
+  minimal-alist-dtd
   alist-copy
   #f
   #t))
 
 (test-group
-  "alist"
-  (do-test
-   (make-alist-dtd equal?)
-   ;; copy to a mutable list
-   ;; so that mutating procedures don't fail
-   alist-copy
-   #f
-   #t)
-
-  ;; TODO test alist handling with different alist-dtd variants
-  ;; TODO test comparator
-  )
+ "alist"
+ (do-test
+  (make-alist-dtd equal?)
+  ;; copy to a mutable list
+  ;; so that mutating procedures don't fail
+  alist-copy
+  #f
+  #t)
 
-(test-group
-  "plist"
-  (do-test
-   plist-dtd
-    (lambda (alist)
-      (apply append
-             (map (lambda (pair)
-                    (list (car pair) (cdr pair)))
-                  alist)))
-    #f
-    #t)
-  ;; TODO test comparator
-  )
+ ;; 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
+  #t)
+ ;; TODO test comparator
+ )
+(test-group
  "srfi-69"
  (do-test
   srfi-69-dtd
@@ -681,7 +684,6 @@
   #t)
  ;; TODO test comparator
  )
-
 (test-group
  "srfi-125"
  (do-test
@@ -748,5 +750,4 @@
   cmp
   #t))
 
-
 (test-end)
diff --git a/srfi/default-impl.scm b/srfi/default-impl.scm
index 4253f6a..dfd3f58 100644
--- a/srfi/default-impl.scm
+++ b/srfi/default-impl.scm
@@ -77,12 +77,12 @@
 
     (define (default-dict-delete-all* dtd dictionary dict-search-proc keylist)
       (let loop ((keylist keylist)
-                 (dictionary dictionary))
+                 (d dictionary))
         (cond
-         ((null? keylist) dictionary)
+         ((null? keylist) d)
          (else (let*-values
                    (((key) (car keylist))
-                    ((new-d _) (dict-search-proc dtd dictionary key
+                    ((new-d _) (dict-search-proc dtd d key
                                                  (lambda (_ ignore)
                                                    (ignore #f))
                                                  (lambda (key old-value _ delete)
@@ -198,7 +198,7 @@
          (lambda (key)
            (not (pred key (dict-ref dtd dictionary key))))
          keys))
-      (dict-delete-all-proc dtd dictionary keys))
+      (dict-delete-all-proc dtd dictionary keys-to-delete))
 
     (define (default-dict-filter dtd pred dictionary)
       (default-dict-filter* dtd dict-delete-all pred dictionary))
@@ -218,11 +218,20 @@
     (define (default-dict-remove! dtd pred dictionary)
       (default-dict-remove* dtd dict-filter! pred dictionary))
 
+    (define (create-fresh-dict-from-existing dtd dictionary)
+      (call/cc
+       (lambda (k)
+         (with-exception-handler
+             (lambda (err)
+               (k (make-dictionary dtd #f)))
+           (lambda ()
+             (make-dictionary dtd (dict-comparator dictionary)))))))
+
     (define (default-dict-copy dtd dictionary)
-      (define dict (make-dictionary (dict-comparator dtd dictionary)))
+      (define dict (create-fresh-dict-from-existing dtd dictionary))
       (dict-for-each dtd
                      (lambda (key value)
-                       (set! dict (dict-set! dtd key value)))
+                       (set! dict (dict-set! dtd dict key value)))
                      dictionary)
       dict)
 
diff --git a/srfi/externals.scm b/srfi/externals.scm
index 8fee936..34c8450 100644
--- a/srfi/externals.scm
+++ b/srfi/externals.scm
@@ -11,12 +11,18 @@
   (message dictionary-message)
   (irritants dictionary-irritants))
 
+(define-syntax dtd-ref-stx
+  (syntax-rules ()
+    ((_ dtd index)
+     (begin
+       (vector-ref (procvec dtd) index)))))
+
 (define-syntax define/dict-proc
   (syntax-rules ()
     ((_ proc index)
      (define (proc dtd . args)
        (assume (dtd? dtd))
-       (apply (vector-ref (procvec dtd) index) dtd args)))))
+       (apply (dtd-ref-stx dtd index) dtd args)))))
 
 (define/dict-proc make-dictionary make-dictionary-index)
 (define/dict-proc dictionary? dictionary?-index)
@@ -35,7 +41,7 @@
 
     ((dtd dict key failure success)
      (assume (dtd? dtd))
-     ((vector-ref (procvec dtd) dict-ref-index) dtd dict key failure success))))
+     ((dtd-ref-stx 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)
@@ -63,7 +69,7 @@
 
     ((dtd dict key updater failure success)
      (assume (dtd? dtd))
-     ((vector-ref (procvec dtd) dict-update-index) dtd dict key updater failure success))))
+     ((dtd-ref-stx dtd dict-update-index) dtd dict key updater failure success))))
 
 (define dict-update!
   (case-lambda
@@ -77,7 +83,7 @@
 
     ((dtd dict key updater failure success)
      (assume (dtd? dtd))
-     ((vector-ref (procvec dtd) dict-update!-index) dtd dict key updater failure success))))
+     ((dtd-ref-stx 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)
@@ -106,7 +112,7 @@
 (define/dict-proc dict-comparator dict-comparator-index)
 
 (define (dtd-ref dtd procindex)
-  (vector-ref (procvec dtd) procindex))
+  (dtd-ref-stx dtd procindex))
 
 (define (make-modified-dtd dtd . lst)
   (define vec (vector-copy (procvec dtd)))