update implementation

8 files changed, 165 insertions, 255 deletions

diff --git a/srfi-225-test.scm b/srfi-225-test.scm
index 8a81504..5f4553a 100644
--- a/srfi-225-test.scm
+++ b/srfi-225-test.scm
@@ -152,9 +152,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-set!"
+   "dict-set"
    (define d (alist->dict '((a . b))))
-   (dict-set! dto d 'a 'c 'a2 'b2)
+   (dict-set dto d 'a 'c 'a2 'b2)
    (test-equal 'c (dict-ref dto d 'a ))
    (test-equal 'b2 (dict-ref dto d 'a2)))
 
@@ -171,9 +171,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-adjoin!"
+   "dict-adjoin"
    (define d (alist->dict '((a . b))))
-   (dict-adjoin! dto d 'a 'c 'a2 'b2)
+   (dict-adjoin dto d 'a 'c 'a2 'b2)
    (test-equal 'b (dict-ref dto d 'a))
    (test-equal 'b2 (dict-ref dto d 'a2)))
 
@@ -189,9 +189,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-delete!"
+   "dict-delete"
    (define d (alist->dict '((a . b) (c . d))))
-   (dict-delete! dto d 'a 'b)
+   (dict-delete dto d 'a 'b)
    (test-equal (dict->alist dto d) '((c . d))))
 
   (when mutable?
@@ -206,9 +206,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-delete-all!"
+   "dict-delete-all"
    (define d (alist->dict '((a . b) (c . d))))
-   (dict-delete-all! dto d '(a b))
+   (dict-delete-all dto d '(a b))
    (test-equal (dict->alist dto d) '((c . d))))
 
   (when mutable?
@@ -224,9 +224,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-replace!"
+   "dict-replace"
    (define d (alist->dict '((a . b) (c . d))))
-   (dict-replace! dto d 'a 'b2)
+   (dict-replace dto d 'a 'b2)
    (test-equal 'b2 (dict-ref dto d 'a))
    (test-equal 'd (dict-ref dto d 'c)))
 
@@ -255,17 +255,17 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-intern!"
+   "dict-intern"
    ;; intern existing
    (let ()
     (define d (alist->dict '((a . b))))
-    (define value (dict-intern! dto d 'a (lambda () 'd)))
+    (define-values (new-dict value) (dict-intern dto d 'a (lambda () 'd)))
     (test-equal 'b (dict-ref dto d 'a))
     (test-equal 'b value))
    ;; intern missing
    (let ()
     (define d (alist->dict '((a . b))))
-    (define value (dict-intern! dto d 'c (lambda () 'd)))
+    (define-values (new-dict value) (dict-intern dto d 'c (lambda () 'd)))
     (test-equal 'b (dict-ref dto d 'a))
     (test-equal 'd (dict-ref dto d 'c))
     (test-equal 'd value)))
@@ -297,11 +297,11 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-update!"
+   "dict-update"
    ;; update existing
    (let ()
     (define d (alist->dict '((a . "b"))))
-    (dict-update! dto d 'a
+    (dict-update dto d 'a
                   (lambda (value)
                     (string-append value "2"))
                   error
@@ -310,7 +310,7 @@
    ;; update missing
    (let ()
     (define d (alist->dict '((a . "b"))))
-    (dict-update! dto d 'c
+    (dict-update dto d 'c
                   (lambda (value)
                     (string-append value "2"))
                   (lambda () "d1")
@@ -343,11 +343,11 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-update/default!"
+   "dict-update/default"
    ;; update existing
    (let ()
     (define d (alist->dict '((a . "b"))))
-    (dict-update/default! dto d 'a
+    (dict-update/default dto d 'a
                           (lambda (value)
                             (string-append value "2"))
                           "d1")
@@ -356,7 +356,7 @@
    ;; update missing
    (let ()
     (define d (alist->dict '((a . "b"))))
-    (dict-update/default! dto d 'c
+    (dict-update/default dto d 'c
                           (lambda (value)
                             (string-append value "2"))
                           "d1")
@@ -385,11 +385,12 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-pop!"
+   "dict-pop"
    (define d (alist->dict '((a . b) (c . d))))
    (define-values
-       (key value)
-     (dict-pop! dto d))
+       (new-dict key value)
+     (dict-pop dto d))
+   (test-assert (eq? new-dict d))
    (test-assert
        (or
         (and (equal? (dict->alist dto d) '((c . d)))
@@ -417,9 +418,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-map!"
+   "dict-map"
    (define d (alist->dict '((a . "a") (b . "b"))))
-   (dict-map! dto
+   (dict-map dto
               (lambda (key value)
                 (string-append value "2"))
               d)
@@ -442,9 +443,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-filter!"
+   "dict-filter"
    (define d (alist->dict '((a . b) (c . d))))
-   (dict-filter! dto
+   (dict-filter dto
                  (lambda (key value)
                    (equal? value 'b))
                  d)
@@ -465,9 +466,9 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-remove!"
+   "dict-remove"
    (define d (alist->dict '((a . b) (c . d))))
-   (dict-remove! dto
+   (dict-remove dto
                  (lambda (key value)
                    (equal? value 'b))
                  d)
@@ -524,11 +525,11 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-   "dict-find-update!"
+   "dict-find-update"
    ;; ignore
    (let ()
     (define dict (alist->dict '((a . b))))
-    (dict-find-update! dto dict 'c
+    (dict-find-update dto dict 'c
                               (lambda (insert ignore)
                                 (ignore))
                               (lambda args
@@ -538,7 +539,7 @@
    ;; insert
    (let ()
     (define dict (alist->dict '((a . b))))
-    (dict-find-update! dto dict 'c
+    (dict-find-update dto dict 'c
                        (lambda (insert ignore)
                          (insert 'd))
                        (lambda args
@@ -549,7 +550,7 @@
    ;; update
    (let ()
     (define dict (alist->dict '((a . b))))
-    (dict-find-update! dto dict 'a
+    (dict-find-update dto dict 'a
                        (lambda args
                          (error "shouldn't happen"))
                        (lambda (key value update delete)
@@ -559,7 +560,7 @@
    ;; delete
    (let ()
     (define dict (alist->dict '((a . b) (c . d))))
-    (dict-find-update! dto dict 'a
+    (dict-find-update dto dict 'a
                        (lambda args
                          (error "shouldn't happen"))
                        (lambda (key value update delete)
@@ -818,8 +819,8 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-    "dict-set!-accumulator"
-    (define acc (dict-set!-accumulator dto (alist->dict '())))
+    "dict-set-accumulator"
+    (define acc (dict-set-accumulator dto (alist->dict '())))
     (acc (cons 1 'a))
     (acc (cons 2 'b))
     (acc (cons 2 'c))
@@ -838,8 +839,8 @@
   (unless mutable?
     (test-skip 1))
   (test-group
-    "dict-adjoin!-accumulator"
-    (define acc (dict-adjoin!-accumulator dto (alist->dict '())))
+    "dict-adjoin-accumulator"
+    (define acc (dict-adjoin-accumulator dto (alist->dict '())))
     (acc (cons 1 'a))
     (acc (cons 2 'b))
     (acc (cons 2 'c))
@@ -857,35 +858,60 @@
 (test-group
  "default"
  ;; test defaults by overring only procedures that raise error otherwise
- (define alist-dto (make-alist-dto equal?))
+
+  (define (alist-find-update dto alist key failure success)
+    (define (handle-success pair)
+      (define old-key (car pair))
+      (define old-value (cdr pair))
+      (define (update new-key new-value)
+        (cond
+          ((and (eq? old-key
+                     new-key)
+                (eq? old-value
+                     new-value))
+           alist)
+          (else
+            (let ((new-list
+                    (alist-cons
+                      new-key new-value
+                      (alist-delete old-key alist))))
+              new-list))))
+      (define (remove)
+        (alist-delete old-key alist))
+      (success old-key old-value update remove))
+
+    (define (handle-failure)
+      (define (insert value)
+        (alist-cons key value alist))
+      (define (ignore)
+        alist)
+      (failure insert ignore))
+    (cond
+      ((assoc key alist equal?) => handle-success)
+      (else (handle-failure))))
+
+  (define (alist-map dto proc alist)
+    (map
+     (lambda (e)
+       (define key (car e))
+       (define value (cdr e))
+       (cons key (proc key value)))
+     alist))
+
  (define minimal-alist-dto
    (make-dto
-    dictionary?-id (dto-ref alist-dto dictionary?-id)
-    dict-pure?-id (dto-ref alist-dto dict-pure?-id)
-    dict-size-id (dto-ref alist-dto dict-size-id)
-    dict-find-update-id (dto-ref alist-dto dict-find-update-id)
-    dict-map-id (dto-ref alist-dto dict-map-id)
-    dict-comparator-id (dto-ref alist-dto dict-comparator-id)))
+    dictionary?-id (lambda (dto obj) (list? obj))
+    dict-pure?-id (lambda _ #t)
+    dict-size-id (lambda (dto alist) (length alist))
+    dict-find-update-id alist-find-update
+    dict-map-id alist-map
+    dict-comparator-id (lambda _ #f)))
  (do-test
   minimal-alist-dto
   alist-copy
   #f
   #f))
 
-(test-group
- "alist"
- (do-test
-  (make-alist-dto equal?)
-  ;; copy to a mutable list instead of using identity function
-  ;; so that mutating procedures don't fail
-  alist-copy
-  #f
-  #f)
-
- (test-group
-  "alist dict-comparator"
-  (test-assert (not (dict-comparator alist-equal-dto '())))))
-
 (cond-expand
   ((and (library (srfi 69))
         (not gauche) ;; gauche has bug with comparator retrieval from srfi 69 table
diff --git a/srfi-225.html b/srfi-225.html
index fb0a093..705346a 100644
--- a/srfi-225.html
+++ b/srfi-225.html
@@ -321,7 +321,7 @@ key <em>key</em>.
 <p>Returns an alist whose keys and values are the keys and values of <em>dict</em>.</p>
 <blockquote><pre>
 (dict-&gt;alist dto dict) =&gt;
-  {1:2, 3:4, 5:6}
+  ((1 . 2) (3 . 4) (5 . 6))
 </pre></blockquote>
 <h3 id="iteration">Iteration</h3>
   <p><code>(dict-for-each</code>&nbsp;<em>dto proc dict</em> [ <em>start</em> [ <em>end</em> ] ] <code>)</code></p>
@@ -352,7 +352,7 @@ key <em>key</em>.
   as a key and value of <em>dict</em> as if by <code>dict-set</code>, eventually returning the new value of <em>dict</em>.
   If invoked on an end-of-file object, no action is taken and <em>dict</em> is returned.</p>
 <p><code>(dict-adjoin-accumulator</code>&nbsp;<em>dto dict</em><code>)</code></p>
-<p>The same as <code>dict-set(!)-accumulator</code>, except using <code>dict-adjoin</code>. </p>
+<p>The same as <code>dict-set-accumulator</code>, except using <code>dict-adjoin</code>. </p>
 <h3 id="dictionary-type-object-procedures">Dictionary type object procedures (non-generic)</h3>
 <p><code>(dto?</code>&nbsp;<em>obj</em><code>)</code></p>
 <p>Returns <code>#t</code> if <em>obj</em> is a DTO, and <code>#f</code> otherwise.</p>
@@ -521,7 +521,7 @@ new dictionary types that may not have complete dictionary APIs:</p>
     <dd>dict-fold</dd>
 
     <dt>dict-for-each</dt>
-    <dd>dict-map or dict-map!</dd>
+    <dd>dict-map</dd>
 
     <dt>dict-&gt;generator</dt>
     <dd>dict-for-each</dd>
@@ -529,15 +529,8 @@ new dictionary types that may not have complete dictionary APIs:</p>
     <dt>dict-set-accumulator</dt>
     <dd>dict-set</dd>
 
-    <dt>dict-set!-accumulator</dt>
-    <dd>dict-set!</dd>
-
     <dt>dict-adjoin-accumulator</dt>
     <dd>dict-set</dd>
-
-    <dt>dict-adjoin!-accumulator</dt>
-    <dd>dict-adjoin!</dd>
-
 </dl>
 </code>
 
diff --git a/srfi/225.sld b/srfi/225.sld
index 7e93f20..d9d38ec 100644
--- a/srfi/225.sld
+++ b/srfi/225.sld
@@ -23,34 +23,22 @@
     ;; lookup
     dict-ref
     dict-ref/default
+    dict-comparator
 
     ;; 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-find-update
-    dict-find-update!
 
     ;; whole dictionary
     dict-size
@@ -63,20 +51,16 @@
     dict-fold
     dict-map->list
     dict->alist
-    dict-comparator
 
     ;; iteration
     dict-for-each
     dict->generator
     dict-set-accumulator
-    dict-set!-accumulator
     dict-adjoin-accumulator
-    dict-adjoin!-accumulator
 
     ;; dictionary type descriptors
     dto?
     make-dto
-    make-alist-dto
     dto-ref
 
     ;; exceptions
@@ -126,17 +110,12 @@
     dict-update/default-id
     dict-values-id
     dict=?-id
-    dict->generator-id
-
-    ;; basic DTOs
-    alist-eqv-dto
-    alist-equal-dto)
+    dict->generator-id)
 
     ;; implementations
     (include "indexes.scm")
     (include "externals.scm")
     (include "default-impl.scm")
-    (include "alist-impl.scm")
 
     ;; library-dependent DTO exports
     ;; and implementations
diff --git a/srfi/default-impl.scm b/srfi/default-impl.scm
index 24b20d6..ef1eb6c 100644
--- a/srfi/default-impl.scm
+++ b/srfi/default-impl.scm
@@ -13,46 +13,6 @@
     (define default-dict-size (not-implemented "dict-size"))
     (define default-dict-find-update (not-implemented "dict-find-update"))
 
-    (define (dict-find-update* dto dict key fail success)
-      (if (dict-pure? dto dict)
-          (dict-find-update dto dict key fail success)
-          (dict-find-update! dto dict key fail success)))
-    
-    (define (dict-find-update*/dict dto dict key fail success)
-      (if (dict-pure? dto dict)
-          (dict-find-update dto dict key fail success)
-          (begin
-            (dict-find-update! dto dict key fail success)
-            dict)))
-
-    (define (dict-delete-all* dto dict keys)
-      (if (dict-pure? dto dict)
-          (dict-delete-all dto dict keys)
-          (begin
-            (dict-delete-all! dto dict keys)
-            dict)))
-
-    (define (dict-update* dto dict key updater fail success)
-      (if (dict-pure? dto dict)
-          (dict-update dto dict key updater fail success)
-          (begin
-            (dict-update! dto dict key updater fail success)
-            dict)))
-
-    (define (dict-filter* dto pred dictionary)
-      (if (dict-pure? dto dictionary)
-          (dict-filter dto pred dictionary)
-          (begin
-            (dict-filter! dto pred dictionary)
-            dictionary)))
-
-    (define (dict-replace* dto dict key val)
-      (if (dict-pure? dto dict)
-          (dict-replace dto dict key val)
-          (begin
-            (dict-replace! dto dict key val)
-            dict)))
-
     (define (default-dict-empty? dto dictionary)
       (= 0 (dict-size dto dictionary)))
 
@@ -78,7 +38,7 @@
                 (lambda (x) #t)))
 
     (define (default-dict-ref dto dictionary key failure success)
-      (dict-find-update* dto dictionary key
+      (dict-find-update dto dictionary key
                      (lambda (insert ignore)
                        (failure))
                      (lambda (key value update remove)
@@ -100,7 +60,7 @@
           (error "mismatch of key / values argument list" objs))
          (else (let* ((key (car objs))
                       (value (cadr objs))
-                      (new-d (dict-find-update*/dict dto dictionary key
+                      (new-d (dict-find-update dto dictionary key
                                          (lambda (insert ignore)
                                            (insert value))
                                          (lambda (key old-value update delete)
@@ -115,7 +75,7 @@
       (default-dict-set* dto dictionary #t objs))
 
     (define (default-dict-delete dto dictionary . keys)
-      (dict-delete-all* dto dictionary keys))
+      (dict-delete-all dto dictionary keys))
 
     (define (default-dict-delete-all dto dictionary keylist)
       (let loop ((keylist keylist)
@@ -123,7 +83,7 @@
         (cond
           ((null? keylist) d)
           (else (let* ((key (car keylist))
-                       (new-d (dict-find-update*/dict dto d key
+                       (new-d (dict-find-update dto d key
                                           (lambda (_ ignore)
                                             (ignore))
                                           (lambda (key old-value _ delete)
@@ -132,36 +92,29 @@
                         new-d))))))
 
     (define (default-dict-replace dto dictionary key value)
-      (dict-find-update* dto dictionary key
+      (dict-find-update dto dictionary key
                   (lambda (_ ignore)
                     (ignore))
                   (lambda (key old-value update _)
                     (update key value))))
 
     (define (default-dict-intern dto dictionary key failure)
-      (define pure (dict-pure? dto dictionary))
-      (dict-find-update* dto dictionary key
+      (dict-find-update dto dictionary key
                   (lambda (insert _)
                     (let ((value (failure)))
-                     (if pure
-                         (values (insert value) value)   
-                         (begin
-                           (insert value)
-                           value))))
+                     (values (insert value) value)))
                   (lambda (key value update _)
-                    (if pure
-                        (values dictionary value)
-                        value))))
+                    (values dictionary value))))
 
     (define (default-dict-update dto dictionary key updater failure success)
-      (dict-find-update* dto dictionary key
+      (dict-find-update dto dictionary key
                   (lambda (insert ignore)
                     (insert (updater (failure))))
                   (lambda (key value update _)
                     (update key (updater (success value))))))
 
     (define (default-dict-update/default dto dictionary key updater default)
-      (dict-update* dto dictionary key updater
+      (dict-update dto dictionary key updater
                     (lambda () default)
                     (lambda (x) x)))
 
@@ -172,10 +125,8 @@
            (dict-for-each dto
                           (lambda (key value)
                             (define new-dict
-                              (dict-delete-all* dto dictionary (list key)))
-                            (if (dict-pure? dto dictionary)
-                                (cont new-dict key value)   
-                                (cont key value)))
+                              (dict-delete-all dto dictionary (list key)))
+                            (cont new-dict key value))
                           dictionary))))
       (define empty? (dict-empty? dto dictionary))
       (if empty?
@@ -191,10 +142,10 @@
          (lambda (key)
            (not (pred key (dict-ref dto dictionary key))))
          keys))
-      (dict-delete-all* dto dictionary keys-to-delete))
+      (dict-delete-all dto dictionary keys-to-delete))
 
     (define (default-dict-remove dto pred dictionary)
-      (dict-filter* dto (lambda (key value)
+      (dict-filter dto (lambda (key value)
                           (not (pred key value)))
                     dictionary))
 
@@ -295,12 +246,8 @@
             any))
       (define (accept el)
         (and (upper el) (lower el)))
-      (define map-proc
-        (if (dict-pure? dto dict)
-            dict-map
-            dict-map!))
       
-      (map-proc 
+      (dict-map 
         dto
         (lambda (key value)
           (when (accept key)
@@ -370,23 +317,16 @@
         (call/cc get-next-value)))
 
     (define (default-dict-accumulator dto dict acc-proc)
-      (define pure (dict-pure? dto dict))
       (lambda (arg)
         (if (eof-object? arg)
             dict
-            (if pure
-                (set! dict (acc-proc dto dict (car arg) (cdr arg)))   
-                (acc-proc dto dict (car arg) (cdr arg))))))
+            (set! dict (acc-proc dto dict (car arg) (cdr arg))))))
 
     (define (default-dict-set-accumulator dto dict)
-      (if (dict-pure? dto dict)
-          (default-dict-accumulator dto dict dict-set)
-          (default-dict-accumulator dto dict dict-set!)))
+      (default-dict-accumulator dto dict dict-set))
 
     (define (default-dict-adjoin-accumulator dto dict)
-      (if (dict-pure? dto dict)
-          (default-dict-accumulator dto dict dict-adjoin)
-          (default-dict-accumulator dto dict dict-adjoin!)))
+      (default-dict-accumulator dto dict dict-adjoin))
 
     (let ()
       (define null-dto (make-dto-private (make-vector dict-procedures-count #f)))
diff --git a/srfi/externals.scm b/srfi/externals.scm
index d08f4a4..f1045e5 100644
--- a/srfi/externals.scm
+++ b/srfi/externals.scm
@@ -26,38 +26,6 @@
        (assume (dto? dto))
        (apply (dto-ref-stx dto index) dto args)))))
 
-;; define mutable and immutable versions of a procedure (such as dict-set! and dict-set)
-;; with appropriate assertion for dict-mutable? value
-;; when dto is first arg, and dict is second arg
-(define-syntax define/dict-proc-pair
-  (syntax-rules ()
-    ((_ proc-immutable proc-mutable index)
-     (begin
-       (define (proc-mutable dto dict . args)
-         (assume (dto? dto))
-         (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict)) index)
-         (apply (dto-ref-stx dto index) dto dict args))
-       (define (proc-immutable dto dict . args)
-         (assume (dto? dto))
-         (assume ((dto-ref-stx dto dict-pure?-id) dto dict) index)
-         (apply (dto-ref-stx dto index) dto dict args))))))
-
-;; define mutable and immutable versions of a procedure (such as dict-set! and dict-set)
-;; with appropriate assertion for dict-mutable? value
-;; when dto is first arg, and dict is third arg (ie filter, map shape signature)
-(define-syntax define/dict-proc-pair*
-  (syntax-rules ()
-    ((_ proc-immutable proc-mutable index)
-     (begin
-       (define (proc-mutable dto proc dict)
-         (assume (dto? dto))
-         (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict)) index)
-         ((dto-ref-stx dto index) dto proc dict))
-       (define (proc-immutable dto proc dict)
-         (assume (dto? dto))
-         (assume ((dto-ref-stx dto dict-pure?-id) dto dict) index)
-         ((dto-ref-stx dto index) dto proc dict))))))
-
 (define/dict-proc dictionary? dictionary?-id)
 (define/dict-proc dict-empty? dict-empty?-id)
 (define/dict-proc dict-contains? dict-contains?-id)
@@ -79,12 +47,12 @@
      ((dto-ref-stx dto dict-ref-id) dto dict key failure success))))
 
 (define/dict-proc dict-ref/default dict-ref/default-id)
-(define/dict-proc-pair dict-set dict-set! dict-set-id)
-(define/dict-proc-pair dict-adjoin dict-adjoin! dict-adjoin-id)
-(define/dict-proc-pair dict-delete dict-delete! dict-delete-id)
-(define/dict-proc-pair dict-delete-all dict-delete-all! dict-delete-all-id)
-(define/dict-proc-pair dict-replace dict-replace! dict-replace-id)
-(define/dict-proc-pair dict-intern dict-intern! dict-intern-id)
+(define/dict-proc dict-set dict-set-id)
+(define/dict-proc dict-adjoin dict-adjoin-id)
+(define/dict-proc dict-delete dict-delete-id)
+(define/dict-proc dict-delete-all dict-delete-all-id)
+(define/dict-proc dict-replace dict-replace-id)
+(define/dict-proc dict-intern dict-intern-id)
 
 (define dict-update
   (case-lambda
@@ -98,30 +66,14 @@
 
     ((dto dict key updater failure success)
      (assume (dto? dto))
-     (assume ((dto-ref-stx dto dict-pure?-id) dto dict))
-     ((dto-ref-stx dto dict-update-id) dto dict key updater failure success))))
-
-(define dict-update!
-  (case-lambda
-    ((dto dict key updater)
-     (dict-update dto dict key updater
-                  (lambda () (error "Key not found in dictionary" dict key))
-                  values))
-
-    ((dto dict key updater failure)
-     (dict-update dto dict key  updater failure values))
-
-    ((dto dict key updater failure success)
-     (assume (dto? dto))
-     (assume (not ((dto-ref-stx dto dict-pure?-id) dto dict)))
      ((dto-ref-stx dto dict-update-id) dto dict key updater failure success))))
 
-(define/dict-proc-pair dict-update/default dict-update/default! dict-update/default-id)
-(define/dict-proc-pair dict-pop dict-pop! dict-pop-id)
-(define/dict-proc-pair* dict-map dict-map! dict-map-id)
-(define/dict-proc-pair* dict-filter dict-filter! dict-filter-id)
-(define/dict-proc-pair* dict-remove dict-remove! dict-remove-id)
-(define/dict-proc-pair dict-find-update dict-find-update! dict-find-update-id)
+(define/dict-proc dict-update/default dict-update/default-id)
+(define/dict-proc dict-pop dict-pop-id)
+(define/dict-proc dict-map dict-map-id)
+(define/dict-proc dict-filter dict-filter-id)
+(define/dict-proc dict-remove dict-remove-id)
+(define/dict-proc dict-find-update dict-find-update-id)
 (define/dict-proc dict-size dict-size-id)
 (define/dict-proc dict-count dict-count-id)
 (define/dict-proc dict-any dict-any-id)
@@ -146,8 +98,8 @@
     ((dto dict start) (dict->generator dto dict start #f))
     ((dto dict start end) ((dto-ref-stx dto dict->generator-id) dto dict start end))))
 
-(define/dict-proc-pair dict-set-accumulator dict-set!-accumulator dict-set-accumulator-id)
-(define/dict-proc-pair dict-adjoin-accumulator dict-adjoin!-accumulator dict-adjoin-accumulator-id)
+(define/dict-proc dict-set-accumulator dict-set-accumulator-id)
+(define/dict-proc dict-adjoin-accumulator dict-adjoin-accumulator-id)
 
 (define (dto-ref dto procindex)
   (dto-ref-stx dto procindex))
diff --git a/srfi/srfi-125-impl.scm b/srfi/srfi-125-impl.scm
index 736a27c..b3affe4 100644
--- a/srfi/srfi-125-impl.scm
+++ b/srfi/srfi-125-impl.scm
@@ -5,27 +5,32 @@
      #f)
 
     (define (t125-hash-table-set* dto table . obj)
-      (apply t125-hash-table-set! (cons table obj)))
+      (apply t125-hash-table-set! (cons table obj))
+      table)
 
     (define (t125-hash-table-update* dto table key updater fail success)
-      (t125-hash-table-update! table key updater fail success))
+      (t125-hash-table-update! table key updater fail success)
+      table)
 
     (define (t125-hash-table-update/default* dto table key proc default)
-      (t125-hash-table-update!/default table key proc default))
+      (t125-hash-table-update!/default table key proc default)
+      table)
 
     (define (t125-hash-table-intern* dto table key failure)
-      (t125-hash-table-intern! table key failure))
+      (values table (t125-hash-table-intern! table key failure)))
 
     (define (t125-hash-table-pop* dto table)
       (if (t125-hash-table-empty? table)
           (error "popped empty dictionary")
-          (t125-hash-table-pop! table)))
+          (call-with-values (lambda () (t125-hash-table-pop! table))
+                            (lambda (key value) (values table key value)))))
 
     (define (t125-hash-table-delete-all* dto table keys)
       (for-each
           (lambda (key)
             (t125-hash-table-delete! table key))
-          keys))
+          keys)
+      table)
 
     (define (t125-hash-table-map* dto proc table)
       (t125-hash-table-map! proc table))
@@ -34,10 +39,12 @@
       (t125-hash-table-prune!
           (lambda (key value)
             (not (proc key value)))
-          table))
+          table)
+      table)
 
     (define (t125-hash-table-remove* dto proc table)
-      (t125-hash-table-prune! proc table))
+      (t125-hash-table-prune! proc table)
+      table)
 
     (define (t125-hash-table-find-update* dto table key fail success)
       ;; instead of running immediately,
@@ -47,19 +54,21 @@
         (define (update new-key new-value)
           (unless (eq? new-key key)
             (t125-hash-table-delete! table key))
-          (t125-hash-table-set! table new-key new-value))
+          (t125-hash-table-set! table new-key new-value)
+          table)
         (define (remove)
-          (t125-hash-table-delete! table key))
+          (t125-hash-table-delete! table key)
+          table)
         (lambda ()
           (success key value update remove) ))
       (define (make-failure-thunk)
         (define (ignore)
           table)
         (define (insert value)
-          (t125-hash-table-set! table key value))
+          (t125-hash-table-set! table key value)
+          table)
         (lambda ()
           (fail insert ignore)))
-
       (define thunk (t125-hash-table-ref table key make-failure-thunk make-success-thunk))
       (thunk))
 
diff --git a/srfi/srfi-126-impl.scm b/srfi/srfi-126-impl.scm
index b4c9845..4bdb53d 100644
--- a/srfi/srfi-126-impl.scm
+++ b/srfi/srfi-126-impl.scm
@@ -23,50 +23,60 @@
              #t
              (begin
                (t126-hashtable-set! table (car obj) (cadr obj))
-               (loop (cddr obj))))))
+               (loop (cddr obj)))))
+      table)
 
     (define (t126-hashtable-delete-all* dto table keys)
       (for-each
           (lambda (key)
             (t126-hashtable-delete! table key))
-          keys))
+          keys)
+      table)
 
     (define (t126-hashtable-intern* dto table key default)
-      (t126-hashtable-intern! table key default))
+      (values table (t126-hashtable-intern! table key default)))
 
     (define (t126-hashtable-update/default* dto table key updater default)
-      (t126-hashtable-update! table key updater default))
+      (t126-hashtable-update! table key updater default)
+      table)
 
     (define (t126-hashtable-pop* dto table)
       (if (t126-hashtable-empty? table)
           (error "popped empty dictionary")
-          (t126-hashtable-pop! table)))
+          (call-with-values (lambda () (t126-hashtable-pop! table))
+                            (lambda (key value) (values table key value)))))
 
     (define (t126-hashtable-update-all* dto proc table)
-      (t126-hashtable-update-all! table proc))
+      (t126-hashtable-update-all! table proc)
+      table)
 
     (define (t126-hashtable-filter* dto proc table)
       (t126-hashtable-prune! table
                                (lambda (key value)
-                                 (not (proc key value)))))
+                                 (not (proc key value))))
+      table)
 
     (define (t126-hashtable-remove* dto proc table)
-      (t126-hashtable-prune! table proc))
+      (t126-hashtable-prune! table proc)
+      table)
 
     (define (t126-hashtable-find-update* dto table key fail success)
       (define (handle-success value)
         (define (update new-key new-value)
           (unless (eq? new-key key)
               (t126-hashtable-delete! table key))
-            (t126-hashtable-set! table new-key new-value))
+          (t126-hashtable-set! table new-key new-value)
+          table)
         (define (remove)
-          (t126-hashtable-delete! table key))
+          (t126-hashtable-delete! table key)
+          table)
         (success key value update remove))
       (define (handle-fail)
         (define (ignore)
           table)
         (define (insert value)
-          (t126-hashtable-set! table key value))
+          (t126-hashtable-set! table key value)
+          table)
         (fail insert ignore))
 
       (define default (cons #f #f))
diff --git a/srfi/srfi-69-impl.scm b/srfi/srfi-69-impl.scm
index dfa9b76..02e3d4a 100644
--- a/srfi/srfi-69-impl.scm
+++ b/srfi/srfi-69-impl.scm
@@ -21,7 +21,8 @@
             table
             (begin
               (t69-hash-table-set! table (car obj) (cadr obj))
-              (loop (cddr obj))))))
+              (loop (cddr obj)))))
+      table)
 
     (define (t69-hash-table-update!/default* dto table key proc default)
       (t69-hash-table-update!/default table key proc default)