work

1 files changed, 30 insertions, 15 deletions

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)