work

12 files changed, 432 insertions, 297 deletions

diff --git a/docker-chibi.sh b/docker-chibi.sh
index 1445bbc..6e4ef0c 100644
--- a/docker-chibi.sh
+++ b/docker-chibi.sh
@@ -1,6 +1,7 @@
 chibi-scheme\
     -I /test/srfi-225\
     -I /dependencies/srfi-126\
+    -I /dependencies/srfi-146\
     -I /dependencies/r6rs-enums-0.0.1\
     -I /dependencies/r6rs-lists-0.0.1\
     -I /dependencies/r6rs-sorting-0.0.1\
diff --git a/docker-compose.yml b/docker-compose.yml
index de354b9..3aa9e00 100644
--- a/docker-compose.yml
+++ b/docker-compose.yml
@@ -4,14 +4,8 @@ services:
     build: .
     volumes:
       - dependencies-volume:/dependencies
-  akku:
-    image: "akkuscm/akku"
-    depends_on:
-      - srfi_225_test
-    volumes:
-      - dependencies-volume:/dependencies
-  kawa:
-    image: "schemers/kawa"
+  gauche:
+    image: "schemers/gauche"
     depends_on:
       - srfi_225_test
     volumes:
@@ -19,7 +13,7 @@ services:
       - type: bind
         source: .
         target: /test/srfi-225
-    command: "sh /test/srfi-225/docker-kawa.sh"
+    command: "sh /test/srfi-225/docker-gauche.sh"
   chibi:
     image: "schemers/chibi"
     depends_on:
diff --git a/docker-gauche.sh b/docker-gauche.sh
new file mode 100644
index 0000000..8b00b60
--- /dev/null
+++ b/docker-gauche.sh
@@ -0,0 +1,10 @@
+ #without importing, gauche doesn't recognize cond-expand in test
+gosh\
+    -I /test/srfi-225\
+    -I /dependencies/srfi-126\
+    -I /dependencies/r6rs-enums-0.0.1\
+    -I /dependencies/r6rs-lists-0.0.1\
+    -I /dependencies/r6rs-sorting-0.0.1\
+    -I /dependencies/srfi-146\
+    -e '(import (srfi 125) (srfi 126) (srfi 146) (srfi 146 hash))'\
+    /test/srfi-225/srfi-225-test.scm
diff --git a/makefile b/makefile
index 4890c1c..20e4509 100644
--- a/makefile
+++ b/makefile
@@ -1,4 +1,16 @@
 .PHONY: test-chibi
 
-test-chibi:
+# Testing through docker
+# pulls in srfi 126 implementation
+# which other wise is untested
+test-chibi-docker:
 	docker-compose run --rm chibi
+
+test-gauche-docker:
+	docker-compose run --rm gauche
+
+test-chibi:
+	chibi-scheme -I . srfi-225-test.scm
+
+test-gauche:
+	gosh -I . srfi-225-test.scm
diff --git a/srfi-225-test.scm b/srfi-225-test.scm
index cb09a22..dd4b8ca 100644
--- a/srfi-225-test.scm
+++ b/srfi-225-test.scm
@@ -2,16 +2,33 @@
         (scheme case-lambda)
         (scheme write)
         (srfi 1)
-        (prefix (srfi 69) t69-)
-        ;(prefix (srfi 125) t125-)
-        ;(prefix (srfi 126) t126-)
         (srfi 128)
-        ;(srfi 146)
-        ;(srfi 146 hash)
         (srfi 158)
         (srfi 225))
 
 (cond-expand
+  ((library (srfi 69))
+   (import (prefix (srfi 69) t69-)))
+  (else))
+
+(cond-expand
+  ((library (srfi 125))
+   (import (prefix (srfi 125) t125-)))
+  (else))
+
+(cond-expand
+  ((library (srfi 126))
+   (import (prefix (srfi 126) t126-)))
+  (else))
+
+(cond-expand
+  ((and (library (srfi 146))
+        (library (srfi 146 hash)))
+   (import (srfi 146)
+           (srfi 146 hash)))
+  (else))
+
+(cond-expand
   (chibi
    (import (rename (except (chibi test) test-equal)
                    (test test-equal)
@@ -901,80 +918,122 @@
   "plist dict-comparator"
   (test-assert (not (dict-comparator plist-dtd '())))))
 
-(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-default-comparator)
-  #t))
-
-#|
-(test-group
- "srfi-125"
- (do-test
-  hash-table-dtd
-  (lambda (alist)
-    (define table (t125-hash-table-empty-copy (t125-make-hash-table equal?)))
-    (for-each
-     (lambda (pair)
-       (t125-hash-table-set! table (car pair) (cdr pair)))
-     alist)
-    table)
-  (make-default-comparator)))
+(cond-expand
+  ((and (library (srfi 69))
+        (not gauche)) ;; gauche has bug with comparator retrieval from srfi 69 table
+   (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-default-comparator)
+       #t)))
+  (else))
 
-(test-group
- "srfi-126 (r6rs)"
- (do-test
-  srfi-126-dtd
-  (lambda (alist)
-    (define table (t126-make-eqv-hashtable))
-    (for-each
-     (lambda (pair)
-       (t126-hashtable-set! table (car pair) (cdr pair)))
-     alist)
-    table)
-  (make-default-comparator)))
+(cond-expand
+  ((library (srf 125))
+   (test-group
+     "srfi-125 mutable"
+     (do-test
+       hash-table-dtd
+       (lambda (alist)
+         (define table (t125-hash-table-empty-copy (t125-make-hash-table equal?)))
+         (for-each
+           (lambda (pair)
+             (t125-hash-table-set! table (car pair) (cdr pair)))
+           alist)
+         table)
+       (make-default-comparator)
+       #t))
+   (test-group
+     "srfi-125 immutable"
+     (do-test
+       hash-table-dtd
+       (lambda (alist)
+         (define table (t125-hash-table-empty-copy (t125-make-hash-table equal?)))
+         (for-each
+           (lambda (pair)
+             (t125-hash-table-set! table (car pair) (cdr pair)))
+           alist)
+         (t125-hash-table-copy table #f))
+       (make-default-comparator)
+       #f))) 
+  (else))
 
-(test-group
- "srfi-146"
- (define cmp (make-default-comparator))
- (do-test
-  mapping-dtd
-  (lambda (alist)
-    (let loop ((table (mapping cmp))
-               (entries alist))
-      (if (null? entries)
-          table
-          (loop (mapping-set! table (caar entries) (cdar entries))
-                (cdr entries)))))
-  cmp)
- (test-group
-  "srfi-146 dict-comparator"
-  (test-equal cmp (dict-comparator mapping-dtd (make-dictionary mapping-dtd cmp)))))
+(cond-expand
+  ((library (srfi 126))
+   (test-group
+     "srfi-126 (r6rs) mutable"
+     (do-test
+       srfi-126-dtd
+       (lambda (alist)
+         (define table (t126-make-eqv-hashtable))
+         (for-each
+           (lambda (pair)
+             (t126-hashtable-set! table (car pair) (cdr pair)))
+           alist)
+         table)
+       (make-default-comparator)
+       #t))
+   (test-group
+     "srfi-126 (r6rs) immutable"
+     (do-test
+       srfi-126-dtd
+       (lambda (alist)
+         (define table (t126-make-eqv-hashtable))
+         (for-each
+           (lambda (pair)
+             (t126-hashtable-set! table (car pair) (cdr pair)))
+           alist)
+         (t126-hashtable-copy table #f))
+       (make-default-comparator)
+       #f)))
+  (else))
 
-(test-group
- "srfi-146 hash"
- (define cmp (make-default-comparator))
- (do-test
-  hash-mapping-dtd
-  (lambda (alist)
-    (let loop ((table (hashmap cmp))
-               (entries alist))
-      (if (null? entries)
-          table
-          (loop (hashmap-set! table (caar entries) (cdar entries))
-                (cdr entries)))))
-  cmp)
- (test-group
-  "srfi-146 hash dict-comparator"
-  (test-equal cmp (dict-comparator hash-mapping-dtd (make-dictionary hash-mapping-dtd cmp)))))
-|#
+(cond-expand
+  ((and (library (srfi 146))
+        (library (srfi 146 hash)))
+   (test-group
+     "srfi-146"
+     (define cmp (make-default-comparator))
+     (do-test
+       mapping-dtd
+       (lambda (alist)
+         (let loop ((table (mapping cmp))
+                    (entries alist))
+           (if (null? entries)
+               table
+               (loop (mapping-set! table (caar entries) (cdar entries))
+                     (cdr entries)))))
+       cmp
+       #f)
+     (test-group
+       "srfi-146 dict-comparator"
+       (test-equal cmp (dict-comparator mapping-dtd (mapping cmp)))))
+
+   (test-group
+     "srfi-146 hash"
+     (define cmp (make-default-comparator))
+     (do-test
+       hash-mapping-dtd
+       (lambda (alist)
+         (let loop ((table (hashmap cmp))
+                    (entries alist))
+           (if (null? entries)
+               table
+               (loop (hashmap-set! table (caar entries) (cdar entries))
+                     (cdr entries)))))
+       cmp
+       #f)
+     (test-group
+       "srfi-146 hash dict-comparator"
+       (test-equal cmp (dict-comparator hash-mapping-dtd (hashmap cmp))))))
+  (else))
 
 (test-end)
diff --git a/srfi/225.sld b/srfi/225.sld
index c93f579..6e389a7 100644
--- a/srfi/225.sld
+++ b/srfi/225.sld
@@ -171,7 +171,6 @@
          (export srfi-69-dtd))
         (else))
 
-#|
     (cond-expand
         ((library (srfi 125))
          (import (prefix (srfi 125) t125-))
@@ -187,13 +186,12 @@
         (else))
 
     (cond-expand
-        ((library (srfi 146))
+        ((and (library (srfi 146))
+              (library (srfi 146 hash)))
          (import (srfi 146)
                  (srfi 146 hash))
          (include "srfi-146-impl.scm"
                   "srfi-146-hash-impl.scm")
          (export mapping-dtd
                  hash-mapping-dtd))
-        (else))
-|#
-)
+        (else)))
diff --git a/srfi/default-impl.scm b/srfi/default-impl.scm
index 24aa197..d5bfdec 100644
--- a/srfi/default-impl.scm
+++ b/srfi/default-impl.scm
@@ -17,6 +17,26 @@
       (if (dict-mutable? dtd dict)
           (dict-alter! dtd dict key fail success)
           (dict-alter dtd dict key fail success)))
+    
+    (define (dict-delete-all* dtd dict keys)
+      (if (dict-mutable? dtd dict)
+          (dict-delete-all! dtd dict keys)
+          (dict-delete-all dtd dict keys)))
+    
+    (define (dict-update* dtd dict key updater fail success)
+      (if (dict-mutable? dtd dict)
+          (dict-update! dtd dict key updater fail success)
+          (dict-update dtd dict key updater fail success)))
+    
+    (define (dict-filter* dtd pred dictionary)
+      (if (dict-mutable? dtd dictionary)
+          (dict-filter! dtd pred dictionary)
+          (dict-filter dtd pred dictionary)))
+    
+    (define (dict-replace* dtd dict key val)
+      (if (dict-mutable? dtd dict)
+          (dict-replace! dtd dict key val)
+          (dict-replace dtd dict key val)))
 
     (define (default-dict-empty? dtd dictionary)
       (= 0 (dict-size dtd dictionary)))
@@ -101,7 +121,7 @@
       (default-dict-set* dtd dictionary #t objs))
 
     (define (default-dict-delete dtd dictionary . keys)
-      (dict-delete-all dtd dictionary keys))
+      (dict-delete-all* dtd dictionary keys))
 
     (define (default-dict-delete-all dtd dictionary keylist)
       (let loop ((keylist keylist)
@@ -139,15 +159,10 @@
                   (lambda (key value update _)
                     (update key (updater (success value))))))
 
-    (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)
-      (dict-update dtd dictionary key updater
-                        (lambda () default)
-                        (lambda (x) x)))
+      (dict-update* dtd dictionary key updater
+                    (lambda () default)
+                    (lambda (x) x)))
 
     (define (default-dict-pop dtd dictionary)
       (define (do-pop)
@@ -156,7 +171,7 @@
            (dict-for-each dtd
                           (lambda (key value)
                             (define new-dict
-                              (dict-delete dtd dictionary key))
+                              (dict-delete-all* dtd dictionary (list key)))
                             (cont new-dict key value))
                           dictionary))))
       (define empty? (dict-empty? dtd dictionary))
@@ -173,7 +188,7 @@
             (let* ((key (car keys))
                    (val (mapper key (dict-ref dtd dict key))))
               (loop (cdr keys)
-                    (dict-replace dtd dict key val))))))
+                    (dict-replace* dtd dict key val))))))
 
     (define (default-dict-filter dtd pred dictionary)
       (define keys (dict-keys dtd dictionary))
@@ -182,12 +197,12 @@
          (lambda (key)
            (not (pred key (dict-ref dtd dictionary key))))
          keys))
-      (dict-delete-all dtd dictionary keys-to-delete))
+      (dict-delete-all* dtd dictionary keys-to-delete))
 
     (define (default-dict-remove dtd pred dictionary)
-      (dict-filter dtd (lambda (key value)
-                         (not (pred key value)))
-                   dictionary))
+      (dict-filter* dtd (lambda (key value)
+                          (not (pred key value)))
+                    dictionary))
 
     (define (default-dict-count dtd pred dictionary)
       (dict-fold dtd
@@ -303,7 +318,7 @@
     (define (default-dict-for-each>= dtd proc dict key)
       (define cmp (dict-comparator dtd dict))
       (define (pred k)
-        (>? cmp k key))
+        (>=? cmp k key))
       (default-dict-for-each/filtered dtd pred proc dict))
     
     (define (default-dict-for-each-in-open-interval dtd proc dict key1 key2)
@@ -403,7 +418,7 @@
          dict-for-each<-id default-dict-for-each<
          dict-for-each<=-id default-dict-for-each<=
          dict-for-each>-id default-dict-for-each>
-         dict-for-each>=-id default-dict-for-each>
+         dict-for-each>=-id default-dict-for-each>=
          dict-for-each-in-open-interval-id default-dict-for-each-in-open-interval
          dict-for-each-in-closed-interval-id default-dict-for-each-in-closed-interval
          dict-for-each-in-open-closed-interval-id default-dict-for-each-in-open-closed-interval
diff --git a/srfi/externals.scm b/srfi/externals.scm
index 8b0bf8e..5d77c86 100644
--- a/srfi/externals.scm
+++ b/srfi/externals.scm
@@ -35,7 +35,7 @@
      (begin
        (define (proc-mutable dtd dict . args)
          (assume (dtd? dtd))
-         (assume ((dtd-ref-stx dtd dict-mutable?-id) dtd dict))
+         (assume ((dtd-ref-stx dtd dict-mutable?-id) dtd dict) index)
          (apply (dtd-ref-stx dtd index) dtd dict args))
        (define (proc-immutable dtd dict . args)
          (assume (dtd? dtd))
@@ -51,11 +51,11 @@
      (begin
        (define (proc-mutable dtd proc dict)
          (assume (dtd? dtd))
-         (assume ((dtd-ref-stx dtd dict-mutable?-id) dtd dict))
+         (assume ((dtd-ref-stx dtd dict-mutable?-id) dtd dict) index)
          ((dtd-ref-stx dtd index) dtd proc dict))
        (define (proc-immutable dtd proc dict)
          (assume (dtd? dtd))
-         (assume (not ((dtd-ref-stx dtd dict-mutable?-id) dtd dict)))
+         (assume (not ((dtd-ref-stx dtd dict-mutable?-id) dtd dict)) index)
          ((dtd-ref-stx dtd index) dtd proc dict))))))
 
 (define/dict-proc dictionary? dictionary?-id)
diff --git a/srfi/srfi-125-impl.scm b/srfi/srfi-125-impl.scm
index f594f6b..5705613 100644
--- a/srfi/srfi-125-impl.scm
+++ b/srfi/srfi-125-impl.scm
@@ -1,86 +1,101 @@
 (define hash-table-dtd
   (let ()
 
-    (define (t125-make-hash-table* dtd comparator)
-      ;; make mutable table
-      (t125-hash-table-empty-copy (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)
+   (define-syntax guard-immutable
+     (syntax-rules ()
+       ((_ table body ... final-expr)
+        (if (t125-hash-table-mutable? table)
+            (let ()
+             body ...
+             final-expr)
+            (let ((table (t125-hash-table-copy table #t)))
+             body ...
+             (let ((table (t125-hash-table-copy table #f)))
+              final-expr))))))
+   
+   (define (t125-hash-table-mutable?* dtd table)
+     (t125-hash-table-mutable? table))
+
+    (define (t125-hash-table-set* dtd table . obj)
+      (guard-immutable table
+        (apply t125-hash-table-set! (cons table obj))
+        table))
+
+    (define (t125-hash-table-update* dtd table key updater fail success)
+      (guard-immutable table
+        (t125-hash-table-update! table key updater fail success)
+        table))
+
+    (define (t125-hash-table-update/default* dtd table key proc default)
+      (guard-immutable table
+        (t125-hash-table-update!/default table key proc default)
+        table))
+
+    (define (t125-hash-table-intern* dtd table key failure)
+      (guard-immutable table
+        (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)
+          (guard-immutable table
+            (define-values
+              (key value)
+              (t125-hash-table-pop! table))
+            (values table key value))))
+
+    (define (t125-hash-table-delete-all* dtd table keys)
+      (guard-immutable table
+        (for-each
+          (lambda (key)
+            (t125-hash-table-delete! table key))
+          keys)
+        table))
 
-    (define (t125-hash-table-filter* dtd proc table)
-      (dict-filter! dtd proc (dict-copy dtd table)))
+    (define (t125-hash-table-map* dtd proc table)
+      (guard-immutable table
+        (t125-hash-table-map! proc table)  
+        table))
 
-    (define (t125-hash-table-remove!* dtd proc table)
-      (t125-hash-table-prune! proc table)
-      table)
+    (define (t125-hash-table-filter* dtd proc table)
+      (guard-immutable table
+        (t125-hash-table-prune!
+          (lambda (key value)
+            (not (proc key value)))
+          table)
+        table))
 
     (define (t125-hash-table-remove* dtd proc table)
-      (dict-remove! dtd proc (dict-copy dtd table)))
+      (guard-immutable table
+        (t125-hash-table-prune! proc table)
+        table))
 
-    (define (t125-hash-table-search!* dtd table key fail success)
+    (define (t125-hash-table-alter* 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))
+        (define (update new-key new-value)
+          (guard-immutable table
+            (unless (eq? new-key key)
+              (t125-hash-table-delete! table key))
+            (t125-hash-table-set! table new-key new-value)
+            table))
+        (define (remove)
+          (guard-immutable table
+            (t125-hash-table-delete! table key)
+            table))
         (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))
+        (define (ignore)
+          table)
+        (define (insert value)
+          (guard-immutable table
+            (t125-hash-table-set! table key value)
+            table))
         (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)
@@ -130,25 +145,22 @@
       (t125-hash-table-ref/default table key default))
 
     (make-dtd
-     make-dictionary-id t125-make-hash-table*
      dictionary?-id t125-hash-table?*
+     dict-mutable?-id t125-hash-table-mutable?*
      dict-empty?-id t125-hash-table-empty?*
      dict-contains?-id t125-hash-table-contains?*
      dict-ref-id t125-hash-table-ref*
      dict-ref/default-id t125-hash-table-ref/default*
-     dict-set!-id t125-hash-table-set!*
-     dict-delete-all!-id t125-hash-table-delete-all!*
-     dict-intern!-id t125-hash-table-intern!*
-     dict-update!-id t125-hash-table-update!*
-     dict-update/default!-id t125-hash-table-update!/default*
-     dict-pop!-id t125-hash-table-pop!*
-     dict-map!-id t125-hash-table-map!*
-     dict-filter!-id t125-hash-table-filter!*
+     dict-set-id t125-hash-table-set*
+     dict-delete-all-id t125-hash-table-delete-all*
+     dict-intern-id t125-hash-table-intern*
+     dict-update-id t125-hash-table-update*
+     dict-update/default-id t125-hash-table-update/default*
+     dict-pop-id t125-hash-table-pop*
+     dict-map-id t125-hash-table-map*
      dict-filter-id t125-hash-table-filter*
-     dict-remove!-id t125-hash-table-remove!*
      dict-remove-id t125-hash-table-remove*
-     dict-search!-id t125-hash-table-search!*
-     dict-search-id t125-hash-table-search*
+     dict-alter-id t125-hash-table-alter*
      dict-size-id t125-hash-table-size*
      dict-for-each-id t125-hash-table-for-each*
      dict-keys-id t125-hash-table-keys*
@@ -157,5 +169,4 @@
      dict-fold-id t125-hash-table-fold*
      dict-map->list-id t125-hash-table-map->list*
      dict->alist-id t125-hash-table->alist*
-     dict-comparator-id t125-hash-table-comparator*
-     dict-copy-id t125-hash-table-copy*)))
+     dict-comparator-id t125-hash-table-comparator*)))
diff --git a/srfi/srfi-126-impl.scm b/srfi/srfi-126-impl.scm
index 43dd9b5..d5de302 100644
--- a/srfi/srfi-126-impl.scm
+++ b/srfi/srfi-126-impl.scm
@@ -1,14 +1,22 @@
 (define srfi-126-dtd
   (let ()
 
+   (define-syntax guard-immutable
+     (syntax-rules ()
+       ((_ table body ... final-expr)
+        (if (t126-hashtable-mutable? table)
+            (let ()
+             body ...
+             final-expr)
+            (let ((table (t126-hashtable-copy table #t)))
+             body ...
+             (let ((table (t126-hashtable-copy table #f)))
+              final-expr))))))
+
     (define (prep-dtd-arg proc)
       (lambda (dtd . args)
         (apply proc args)))
-
-    (define (t126-make-hashtable* dtd comparator)
-      (t126-make-hashtable (comparator-hash-function comparator)
-                           (comparator-equality-predicate comparator)))
-
+    
     (define (t126-hashtable-ref* dtd table key fail success)
       (define-values (value found?) (t126-hashtable-lookup table key))
       (if found?
@@ -18,73 +26,80 @@
     (define (t126-hashtable-ref/default* dtd table key default)
       (t126-hashtable-ref table key default))
 
-    (define (t126-hashtable-set!* dtd table . obj)
-      (let loop ((obj obj))
-        (if (null? obj)
-            table
-            (begin
-              (t126-hashtable-set! table (car obj) (cadr obj))
-              (loop (cddr obj))))))
-
-    (define (t126-hashtable-delete-all!* dtd table keys)
-      (for-each
-       (lambda (key)
-         (t126-hashtable-delete! table key))
-       keys)
-      table)
+    (define (t126-hashtable-set* dtd table . obj)
+      (guard-immutable table
+        (let loop ((obj obj))
+         (if (null? obj)
+             #t
+             (begin
+               (t126-hashtable-set! table (car obj) (cadr obj))
+               (loop (cddr obj)))))
+        table))
+
+    (define (t126-hashtable-delete-all* dtd table keys)
+      (guard-immutable table
+        (for-each
+          (lambda (key)
+            (t126-hashtable-delete! table key))
+          keys)
+        table))
 
-    (define (t126-hashtable-intern!* dtd table key default)
-      (define val (t126-hashtable-intern! table key default))
-      (values table val))
+    (define (t126-hashtable-intern* dtd table key default)
+      (guard-immutable table
+        (define val (t126-hashtable-intern! table key default))
+        (values table val)))
 
-    (define (t126-hashtable-update/default!* dtd table key updater default)
-      (t126-hashtable-update! table key updater default)
-      table)
+    (define (t126-hashtable-update/default* dtd table key updater default)
+      (guard-immutable table
+        (t126-hashtable-update! table key updater default)
+        table))
 
-    (define (t126-hashtable-pop!* dtd table)
+    (define (t126-hashtable-pop* dtd table)
       (if (t126-hashtable-empty? table)
           (error "popped empty dictionary")
-          (call-with-values
-              (lambda () (t126-hashtable-pop! table))
-            (lambda (key value) (values table key value)))))
-
-    (define (t126-hashtable-update-all!* dtd proc table)
-      (t126-hashtable-update-all! table proc)
-      table)
+          (guard-immutable table
+            (define-values
+              (key value)
+              (t126-hashtable-pop! table))
+            (values table key value))))
 
-    (define (t126-hashtable-filter!* dtd proc table)
-      (t126-hashtable-prune! table
-                             (lambda (key value)
-                               (not (proc key value))))
-      table)
+    (define (t126-hashtable-update-all* dtd proc table)
+      (guard-immutable table
+        (t126-hashtable-update-all! table proc)
+        table))
 
     (define (t126-hashtable-filter* dtd proc table)
-      (dict-filter! dtd proc (dict-copy dtd table)))
-
-    (define (t126-hashtable-remove!* dtd proc table)
-      (t126-hashtable-prune! table proc)
-      table)
+      (guard-immutable table
+        (t126-hashtable-prune! table
+                               (lambda (key value)
+                                 (not (proc key value))))
+        table))
 
     (define (t126-hashtable-remove* dtd proc table)
-      (dict-remove! dtd proc (dict-copy dtd table)))
+      (guard-immutable table
+        (t126-hashtable-prune! table proc)
+        table))
 
-    (define (t126-hashtable-search!* dtd table key fail success)
+    (define (t126-hashtable-alter* dtd table key fail success)
       (define (handle-success value)
-        (define (update new-key new-value obj)
-          (unless (eq? new-key key)
-            (t126-hashtable-delete! table key))
-          (t126-hashtable-set! table new-key new-value)
-          (values table obj))
-        (define (remove obj)
-          (t126-hashtable-delete! table key)
-          (values table obj))
+        (define (update new-key new-value)
+          (guard-immutable table
+            (unless (eq? new-key key)
+              (t126-hashtable-delete! table key))
+            (t126-hashtable-set! table new-key new-value)
+            table))
+        (define (remove)
+          (guard-immutable table
+            (t126-hashtable-delete! table key)
+            table))
         (success key value update remove))
       (define (handle-fail)
-        (define (ignore obj)
-          (values table obj))
-        (define (insert value obj)
-          (t126-hashtable-set! table key value)
-          (values table obj))
+        (define (ignore)
+          table)
+        (define (insert value)
+          (guard-immutable table
+            (t126-hashtable-set! table key value)
+            table))
         (fail insert ignore))
 
       (define default (cons #f #f))
@@ -93,9 +108,6 @@
           (handle-fail)
           (handle-success found)))
 
-    (define (t126-hashtable-search* dtd table key fail success)
-      (dict-search! dtd (dict-copy dtd table) key fail success))
-
     (define (t126-hashtable-for-each* dtd proc table)
       (t126-hashtable-walk table proc)
       table)
@@ -117,36 +129,29 @@
            (vector->list keys)
            (vector->list vals)))))
 
-    (define (t126-hashtable-copy* dtd table)
-      (t126-hashtable-copy table #t))
-
     (define (t126-hashtable-comparator* dtd table)
       #f)
 
     (make-dtd
-     make-dictionary-id t126-make-hashtable*
      dictionary?-id (prep-dtd-arg t126-hashtable?)
+     dict-mutable?-id (prep-dtd-arg t126-hashtable-mutable?)
      dict-empty?-id (prep-dtd-arg t126-hashtable-empty?)
      dict-contains?-id (prep-dtd-arg t126-hashtable-contains?)
      dict-ref-id t126-hashtable-ref*
      dict-ref/default-id t126-hashtable-ref/default*
-     dict-set!-id t126-hashtable-set!*
-     dict-delete-all!-id t126-hashtable-delete-all!*
-     dict-intern!-id t126-hashtable-intern!*
-     dict-update/default!-id t126-hashtable-update/default!*
-     dict-pop!-id t126-hashtable-pop!*
-     dict-map!-id t126-hashtable-update-all!*
-     dict-filter!-id t126-hashtable-filter!*
+     dict-set-id t126-hashtable-set*
+     dict-delete-all-id t126-hashtable-delete-all*
+     dict-intern-id t126-hashtable-intern*
+     dict-update/default-id t126-hashtable-update/default*
+     dict-pop-id t126-hashtable-pop*
+     dict-map-id t126-hashtable-update-all*
      dict-filter-id t126-hashtable-filter*
-     dict-remove!-id t126-hashtable-remove!*
      dict-remove-id t126-hashtable-remove*
-     dict-search!-id t126-hashtable-search!*
-     dict-search-id t126-hashtable-search*
+     dict-alter-id t126-hashtable-alter*
      dict-size-id (prep-dtd-arg t126-hashtable-size)
      dict-for-each-id t126-hashtable-for-each*
      dict-keys-id t126-hashtable-keys*
      dict-values-id t126-hashtable-values*
      dict-entries-id t126-hashtable-entries*
      dict-map->list-id t126-hashtable-map->lset*
-     dict-copy-id t126-hashtable-copy*
      dict-comparator-id t126-hashtable-comparator*)))
diff --git a/srfi/srfi-146-hash-impl.scm b/srfi/srfi-146-hash-impl.scm
index 40e893f..323e259 100644
--- a/srfi/srfi-146-hash-impl.scm
+++ b/srfi/srfi-146-hash-impl.scm
@@ -4,39 +4,54 @@
     (define (prep-dtd-arg proc)
       (lambda (dtd . args)
         (apply proc args)))
+    
+    (define (hashmap-alter* dtd dict key failure success)
+      (call/cc
+        ;; escape from whole hashmap-search entirely, when success / failure
+        ;; return something other than through passed in continuation procedures
+        (lambda (k)
+          (define-values
+            (new-dict ignored)
+            (hashmap-search dict key
+                            (lambda (insert ignore)
+                              ;; handle when continuation procedure is called
+                              ;; and force it into tail call
+                              (call/cc (lambda (k2)
+                                         (define result 
+                                           (failure (lambda (value) (k2 (insert value #f)))
+                                                    (lambda () (k2 (ignore #f)))))
+                                         ;; neither insert nor ignore called -- return result to top level escape
+                                         (k result))))
+                            (lambda (key value update remove)
+                              (call/cc (lambda (k2)
+                                         (define result
+                                           (success 
+                                             key
+                                             value
+                                             (lambda (new-key new-value) (k2 (update new-key new-value #f)))
+                                             (lambda () (k2 (remove #f)))))
+                                         (k result))))))
+          new-dict)))
 
     (make-dtd
-     make-dictionary-id (prep-dtd-arg hashmap)
      dictionary?-id (prep-dtd-arg hashmap?)
+     dict-mutable?-id (lambda _ #f)
      dict-empty?-id (prep-dtd-arg hashmap-empty?)
      dict-contains?-id (prep-dtd-arg hashmap-contains?)
      dict-ref-id (prep-dtd-arg hashmap-ref)
      dict-ref/default-id (prep-dtd-arg hashmap-ref/default)
      dict-set-id (prep-dtd-arg hashmap-set)
-     dict-set!-id (prep-dtd-arg hashmap-set!)
      dict-adjoin-id (prep-dtd-arg hashmap-adjoin)
-     dict-adjoin!-id (prep-dtd-arg hashmap-adjoin!)
      dict-delete-id (prep-dtd-arg hashmap-delete)
-     dict-delete!-id (prep-dtd-arg hashmap-delete!)
      dict-delete-all-id (prep-dtd-arg hashmap-delete-all)
-     dict-delete-all!-id (prep-dtd-arg hashmap-delete-all!)
      dict-replace-id (prep-dtd-arg hashmap-replace)
-     dict-replace!-id (prep-dtd-arg hashmap-replace!)
      dict-intern-id (prep-dtd-arg hashmap-intern)
-     dict-intern!-id (prep-dtd-arg hashmap-intern!)
      dict-update-id (prep-dtd-arg hashmap-update)
-     dict-update!-id (prep-dtd-arg hashmap-update!)
      dict-update/default-id (prep-dtd-arg hashmap-update/default)
-     dict-update/default!-id (prep-dtd-arg hashmap-update!/default)
      dict-pop-id (prep-dtd-arg hashmap-pop)
-     dict-pop!-id (prep-dtd-arg hashmap-pop!)
      dict-filter-id (prep-dtd-arg hashmap-filter)
-     dict-filter!-id (prep-dtd-arg hashmap-filter!)
      dict-remove-id (prep-dtd-arg hashmap-remove)
-     dict-remove!-id (prep-dtd-arg hashmap-remove!)
-     dict-search-id (prep-dtd-arg hashmap-search)
-     dict-search!-id (prep-dtd-arg hashmap-search!)
-     dict-copy-id (prep-dtd-arg hashmap-copy)
+     dict-alter-id hashmap-alter*
      dict-size-id (prep-dtd-arg hashmap-size)
      dict-for-each-id (prep-dtd-arg hashmap-for-each)
      dict-count-id (prep-dtd-arg hashmap-count)
diff --git a/srfi/srfi-146-impl.scm b/srfi/srfi-146-impl.scm
index 7d36dc8..49b4737 100644
--- a/srfi/srfi-146-impl.scm
+++ b/srfi/srfi-146-impl.scm
@@ -4,39 +4,54 @@
     (define (prep-dtd-arg proc)
       (lambda (dtd . args)
         (apply proc args)))
+    
+    (define (mapping-alter* dtd dict key failure success)
+      (call/cc
+        ;; escape from whole hashmap-search entirely, when success / failure
+        ;; return something other than through passed in continuation procedures
+        (lambda (k)
+          (define-values
+            (new-dict ignored)
+            (mapping-search dict key
+                            (lambda (insert ignore)
+                              ;; handle when continuation procedure is called
+                              ;; and force it into tail call
+                              (call/cc (lambda (k2)
+                                         (define result 
+                                           (failure (lambda (value) (k2 (insert value #f)))
+                                                    (lambda () (k2 (ignore #f)))))
+                                         ;; neither insert nor ignore called -- return result to top level escape
+                                         (k result))))
+                            (lambda (key value update remove)
+                              (call/cc (lambda (k2)
+                                         (define result
+                                           (success 
+                                             key
+                                             value
+                                             (lambda (new-key new-value) (k2 (update new-key new-value #f)))
+                                             (lambda () (k2 (remove #f)))))
+                                         (k result))))))
+          new-dict)))
 
     (make-dtd
-     make-dictionary-id (prep-dtd-arg mapping)
      dictionary?-id (prep-dtd-arg mapping?)
+     dict-mutable?-id (lambda _ #f)
      dict-empty?-id (prep-dtd-arg mapping-empty?)
      dict-contains?-id (prep-dtd-arg mapping-contains?)
      dict-ref-id (prep-dtd-arg mapping-ref)
      dict-ref/default-id (prep-dtd-arg mapping-ref/default)
      dict-set-id (prep-dtd-arg mapping-set)
-     dict-set!-id (prep-dtd-arg mapping-set!)
      dict-adjoin-id (prep-dtd-arg mapping-adjoin)
-     dict-adjoin!-id (prep-dtd-arg mapping-adjoin!)
      dict-delete-id (prep-dtd-arg mapping-delete)
-     dict-delete!-id (prep-dtd-arg mapping-delete!)
      dict-delete-all-id (prep-dtd-arg mapping-delete-all)
-     dict-delete-all!-id (prep-dtd-arg mapping-delete-all!)
      dict-replace-id (prep-dtd-arg mapping-replace)
-     dict-replace!-id (prep-dtd-arg mapping-replace!)
      dict-intern-id (prep-dtd-arg mapping-intern)
-     dict-intern!-id (prep-dtd-arg mapping-intern!)
      dict-update-id (prep-dtd-arg mapping-update)
-     dict-update!-id (prep-dtd-arg mapping-update!)
      dict-update/default-id (prep-dtd-arg mapping-update/default)
-     dict-update/default!-id (prep-dtd-arg mapping-update!/default)
      dict-pop-id (prep-dtd-arg mapping-pop)
-     dict-pop!-id (prep-dtd-arg mapping-pop!)
      dict-filter-id (prep-dtd-arg mapping-filter)
-     dict-filter!-id (prep-dtd-arg mapping-filter!)
      dict-remove-id (prep-dtd-arg mapping-remove)
-     dict-remove!-id (prep-dtd-arg mapping-remove!)
-     dict-search-id (prep-dtd-arg mapping-search)
-     dict-search!-id (prep-dtd-arg mapping-search!)
-     dict-copy-id (prep-dtd-arg mapping-copy)
+     dict-alter-id mapping-alter*
      dict-size-id (prep-dtd-arg mapping-size)
      dict-for-each-id (prep-dtd-arg mapping-for-each)
      dict-count-id (prep-dtd-arg mapping-count)