Merge remote-tracking branch 'origin/master'

7 files changed, 543 insertions, 75 deletions

diff --git a/alist-impl.scm b/alist-impl.scm
index fab350d..4946457 100644
--- a/alist-impl.scm
+++ b/alist-impl.scm
@@ -18,6 +18,33 @@
       (lambda (e)
         (pred (car e) (cdr e))) 
       alist))
+  
+  (define (alist-delete key alist)
+    ;; find the tail of alist that will be kept
+    ;; ie rest entries after the last entry with matched key
+    (define kept-tail
+      (let loop ((tail alist)
+                 (lst alist))
+      (cond
+        ((null? lst) tail)
+        (else 
+          (if (equal? key (caar lst))
+              (loop (cdr lst) (cdr lst))
+              (loop tail (cdr lst)))))))
+    ;; if tail == alist; just return,
+    ;; else filter elements before the tail, and append the tail
+    (if (eq? alist kept-tail)
+        alist
+        (let loop ((lst alist)
+                   (result/reversed '()))
+          (if (eq? lst kept-tail)
+              (append (reverse result/reversed) kept-tail)
+              (let* ((entry (car lst))
+                     (keep? (not (equal? key (car entry))))
+                     (result/reversed* (if keep? 
+                                           (cons entry result/reversed)
+                                           result/reversed)))
+                (loop (cdr lst) result/reversed*))))))
 
   (define (alist-search! alist key failure success)
     (define (handle-success pair)
diff --git a/dictionaries-impl.scm b/dictionaries-impl.scm
index 60e5b86..29da4c4 100644
--- a/dictionaries-impl.scm
+++ b/dictionaries-impl.scm
@@ -12,9 +12,23 @@
  (register-plist!)) 
 
 (cond-expand
-  ((or srfi-69 srfi-125 chibi kawa)
-   (begin
-     (let ()
-      (include "srfi-69-impl.scm")
-      (register-srfi-69!))))
+  ((library (srfi 126))
+   (let ()
+    (include "srfi-126-impl.scm")
+    (register-srfi-126!)))
+  (else))
+
+(cond-expand
+  ((library (srfi 125))
+   (let ()
+    (include "srfi-125-impl.scm")
+    (register-srfi-125!)))
+  (else))
+
+(cond-expand
+  ((and (library (srfi 69))
+        (not (library (srfi 125))))
+   (let ()
+    (include "srfi-69-impl.scm")
+    (register-srfi-69!)))
   (else))
diff --git a/dictionaries-test.scm b/dictionaries-test.scm
index ede4fe7..099229b 100644
--- a/dictionaries-test.scm
+++ b/dictionaries-test.scm
@@ -1,32 +1,48 @@
 (import (scheme base)
-        (srfi 1)
-        (dictionaries))
+        (scheme case-lambda)
+        (srfi 1))
 
 (cond-expand
-  ((or srfi-64 kawa) 
-    (import (srfi 64)))
+  (kawa (import (srfi 69 basic-hash-tables)))
+  ((library (srfi 125))
+   (import (srfi 125)))
+  ((library (srfi 69))
+   (import (srfi 69)))
+  (else))
+
+(cond-expand
+  ((library (srfi 126))
+   (import (srfi 126)))
+  (else))
+
+(cond-expand
+  ((library (srfi 64)) 
+   (import (srfi 64)))
   (chibi 
-    (begin
-      (import (except (chibi test) test-equal))
-      (define-syntax test-equal
-        (syntax-rules ()
-          ((_ args ...) (test args ...))))
-      ))
+    (import (except (chibi test) test-equal)))
   (else (error "No testing framework")))
 
 (cond-expand
-  ((or srfi-125 chibi)
-   (import (srfi 125)))
-  (kawa
-    (import (srfi 69 basic-hash-tables)))
-  (srfi-69
-    (import (srfi 69)))
+  (chibi
+    (define-syntax test-equal
+        (syntax-rules ()
+          ((_ args ...) (test args ...)))))
   (else))
 
+; use include instead of import
+; so that registering is done in isolated way
+(include "indexes.scm")
+(include "internals.scm")
+(include "externals.scm")
+
+(define (clear-registry!)
+  (set! registry '()))
+
 (define (do-test alist->dict)
 
   (test-group
     "dictionary?"
+    (test-assert (not (dictionary? 'foo)))
     (test-assert (dictionary? (alist->dict '())))
     (test-assert (dictionary? (alist->dict '((a . b))))))
 
@@ -75,7 +91,7 @@
 
   (test-group
     "dict-replace!"
-    (define d (dict-replace! '((a . b) (c . d)) 'a 'b2))
+    (define d (dict-replace! (alist->dict '((a . b) (c . d))) 'a 'b2))
     (test-equal 'b2 (dict-ref d 'a))
     (test-equal 'd (dict-ref d 'c)))
 
@@ -185,7 +201,7 @@
     (let ()
      (define-values 
        (dict value)
-       (dict-search!  '((a . b)) 'c
+       (dict-search! (alist->dict '((a . b))) 'c
               (lambda (insert ignore)
                 (ignore 'foo))
               (lambda args
@@ -362,10 +378,20 @@
 
 (test-group 
   "alist"
+  (include "alist-impl.scm")
+  (clear-registry!)
+  (register-alist!)
   (do-test (lambda (alist) alist)))
 
 (test-group
   "plist"
+  ; empty list isn't valid plist dictionary, thus alist impl also has to be
+  ; added just for this edge case
+  (include "alist-impl.scm")
+  (include "plist-impl.scm")
+  (clear-registry!)
+  (register-plist!)
+  (register-alist!)
   (do-test 
     (lambda (alist) 
       (apply append 
@@ -374,17 +400,49 @@
                   alist)))))
 
 (cond-expand
-  ((or srfi-69 srfi-125 chibi kawa)
-   (begin
-     (test-group
-       "srfi-69"
-       (do-test (lambda (alist) 
-                  (define table (make-hash-table equal?))
-                  (for-each
-                    (lambda (pair)
-                      (hash-table-set! table (car pair) (cdr pair)))
-                    alist)
-                  table)))))
-  (else))
+  ((or (library (srfi 69))
+       (library (srfi 125)))
+   (test-group
+     "srfi-69"
+     (include "srfi-69-impl.scm")
+     (clear-registry!)
+     (register-srfi-69!)
+     (do-test (lambda (alist) 
+                (define table (make-hash-table equal?))
+                (for-each
+                  (lambda (pair)
+                    (hash-table-set! table (car pair) (cdr pair)))
+                  alist)
+                table)))))
+
+(cond-expand
+  ((library (srfi 125))
+   (test-group
+     "srfi-125"
+     (include "srfi-125-impl.scm")
+     (clear-registry!)
+     (register-srfi-125!)
+     (do-test (lambda (alist) 
+                (define table (make-hash-table equal?))
+                (for-each
+                  (lambda (pair)
+                    (hash-table-set! table (car pair) (cdr pair)))
+                  alist)
+                table)))))
+
+(cond-expand
+  ((library (srfi 126))
+   (test-group
+     "srfi-126 (r6rs)"
+     (include "srfi-126-impl.scm")
+     (clear-registry!)
+     (register-srfi-126!)
+     (do-test (lambda (alist) 
+                (define table (make-eqv-hashtable))
+                (for-each
+                  (lambda (pair)
+                    (hashtable-set! table (car pair) (cdr pair)))
+                  alist)
+                table)))))
 
 (test-end)
diff --git a/dictionaries.scm b/dictionaries.scm
index 1920f6f..e90d1f9 100644
--- a/dictionaries.scm
+++ b/dictionaries.scm
@@ -5,10 +5,17 @@
           (srfi 1))
   
   (cond-expand
-    ((and srfi-69 (not srfi-125)) (import (srfi 69)))
-    (srfi-125 (import (srfi 125)))
-    (chibi (import (srfi 125)))
-    (kawa (import (srfi 69 basic-hash-tables))))
+    (kawa (import (srfi 69 basic-hash-tables)))
+    ((library (srfi 69)) (import (srfi 69))) 
+    (else))
+  
+  (cond-expand
+    ((library (srfi 125)) (import (srfi 125))) 
+    (else))
+  
+  (cond-expand
+    ((library (srfi 126)) (import (srfi 126)))
+    (else))
   
   (export 
     
diff --git a/spec.md b/spec.md
index e2a52ed..ba85c91 100644
--- a/spec.md
+++ b/spec.md
@@ -60,6 +60,32 @@ Dictionaries are said in this SRFI to be *similar* if they are of the same
 type and have the same [SRFI 128](http://srfi.schemers.org/srfi-128/srfi-128.html)
 comparator.
 
+## Lists as dictionaries
+
+The exact set of pre-registered dictionaries depends on their
+availability in a given implementation.  However, lists are
+supported as dictionaries using the specification in this section.
+If two keys are the same (in the sense of the specified equality predicate),
+then all but the first are treated as if they did not exist.
+
+If the car of a list is a symbol, then the list is assumed to be a property
+list, alternating symbol keys with values.
+Mutation operations actually mutate the property list whenever possible.
+The equality predicate of this type of dictionary is `eq?`.
+
+If a list is empty, or its car is a pair, then the list is assumed
+to be an alist.  New values are added to the beginning of an alist
+and the new alist is returned;
+deletion does not mutate the alist, but returns an alist
+that may or may not share storage with the original alist.
+If an association has been updated, then both the new and the old
+association may be processed by the whole-dictionary procedures.
+The equality predicate of this type of dictionary is `equal?`.
+The examples in this SRFI use alists.
+
+In all other cases, lists are not treated as dictionaries
+unless an appropriate dictionary type has been registered.
+
 ## Predicates
 
 `(dictionary? `*obj*`)`
@@ -67,12 +93,26 @@ comparator.
 Returns `#t` if *obj* answers `#t` to some registered predicate,
 and `#f` otherwise.
 
+```
+(define dict '((1 . 2) (3 . 4) (5 . 6)))
+(dictionary? dict) => #t
+```
+
 `(dict-empty? `*dictionary*`)`
 
 Returns `#t` if *dictionary* contains no associations
 and `#f` if it does contain associations.
 
+```
+(dict-empty? '()) => #t
+(dict-empty? dict) => #f
+```
+
 `(dict-contains? `*dictionary key*`)`
+```
+(dict-contains? dict 1) => #t
+(dict-contains? dict 2) => #f
+```
 
 Returns `#t `if one of the keys of *dictionary* is the same as *key*
 and `#f` otherwise.
@@ -89,12 +129,22 @@ then invokes the thunk *failure* and returns its result.
 The default value of *failure* signals an error;
 the default value of *success* is the identity procedure.
 
+```
+(dict-ref dict 1 (lambda () '() list) => (1)  ; success wraps value in a list
+(dict-ref dict 2 (lambda () '() list)) => ()  ; failure returns empty list
+```
+
 `(dict-ref/default `*dictionary key default*`)`
 
 If *key* is the same as some key of *dictionary*
 then returns the corresponding value.
 If not, then returns *default*.
 
+```
+(dict-ref/default dict 1 #f) => 1
+(dict-ref/default dict 1 #f) => #f
+```
+
 ## Mutation
 
 All these procedures are linear-update: that is, they may return a new
@@ -109,22 +159,44 @@ Returns a dictionary that contains all the associations of *dictionary*
 plus those specified by *objs*, which alternate between keys and values.
 If a key to be added already exists in *dictionary*, the new value prevails.
 
+```
+; alists are changed non-destructively
+(dict-set! dict 7 8) => ((7 . 8) (1 . 2) (3 . 4) (5 . 6))
+(dict-set! dict 3 5) => ((1 . 2) (3 . 5) (5 . 6) ; may share last alist entry
+```
+
 `(dict-adjoin! `dictionary obj ...`)`
 
 Returns a dictionary that contains all the associations of *dictionary*
-plus those spsecified by *objs*, which alternate between keys and values.
+plus those specified by *objs*, which alternate between keys and values.
 If a key to be added already exists in *dictionary*, the old value prevails.
 
+```
+; alists are changed non-destructively
+(dict-adjoin! dict 7 8) => ((7 . 8) (1 . 2) (3 . 4) (5 . 6))
+(dict-adjoin! dict 3 5) => ((1 . 2) (3 . 5) (5 . 6) ; may share last alist entry
+```
+
 `(dict-delete! `*dictionary key* ...`)`
 
 Returns a dictionary that contains all the associations of *dictionary* except those
 whose keys are the same as one of the *keys*.
 
+```
+; alists are changed non-destructively
+(dict-delete! dict 1 3) => ((7 . 8) (1 . 2) (3 . 4) (5 . 6))
+(dict-delete! dict 3 5) => ((1 . 2) (3 . 4) (5 . 6) ; may share whole alist
+```
+
 `(dict-delete-all! `*dictionary keylist*`)`
 
 Returns a dictionary with all the associations of *dictionary* except those whose
 keys are the same as some member of *keylist*.
 
+```
+(dict-delete-all! dict '(1 3)) => ((5 . 6))
+```
+
 `(dict-replace! `*dictionary key value*`)`
 
 Returns a dictionary that
@@ -135,6 +207,11 @@ defined by the pair *key* and *value*.
 If there is no such key in *dictionary*,
 then dictionary is returned unchanged.
 
+```
+(dict-replace! dict 1 3) => ((1 . 3) (3 . 4) (5 . 6))
+(dict-replace! dict 2 3) => ((1 . 2) (3 . 4) (5 . 6))
+```
+
 `(dict-intern! `dictionary key failure`)`
 
 Extracts the value associated with the key in *dictionary* that is the same as *key*,
@@ -146,6 +223,15 @@ a dictionary that contains all the associations of *dictionary*
 and in addition a new association that maps *key* to the result of invoking *failure*, 
 and the result of invoking *failure*.
 
+```
+(dict-intern! dict 1 (lambda () #f)) => ; 2 values
+  ((1 . 2) (3 . 4) (5 . 6))
+  3
+(dict-intern! dict 2 (lambda () #f)) => ; 2 values
+  ((2 . #f) (1 . 2) (3 . 4) (5 . 6))
+  #f
+```
+
 `(dict-update! `*dictionary key updater* [*failure* [*success*] ]`)`
 
 Retrieves the value of *key* as if by `dict-ref`,
@@ -162,7 +248,7 @@ invokes *updater* on it, and sets the value of *key* to be
 the result of calling *updater* as if by `dict-set`,
 but may do so more efficiently.  Returns the updated dictionary.
 
-`(dict-pop! `*dictionary* [*failure*]`)`
+`(dict-pop! `*dictionary*`)`
 
 Chooses an  association from *dictionary* and returns three values:
 a dictionary that contains all associations of *dictionary* except the chosen one,
@@ -171,8 +257,14 @@ If the dictionary is ordered, the first association is chosen;
 otherwise the chosen association is arbitrary.
 
 If dictionary contains no associations and *failure* is supplied,
-then the thunk *failure* is invoked and its values returned.
-Otherwise, it is an error.
+it is an error.
+
+```
+(dict-pop! dict) => # 3 values
+  ((3 . 4) (5 . 6))
+  1
+  2
+```
 
 `(dict-map! `*proc dictionary*`)`
 
@@ -180,16 +272,28 @@ Returns a dictionary similar to *dictionary* that maps each key of *dictionary*
 to the value that results
 from invoking *proc* on the corresponding key and value of *dictionary*.
 
+```
+(dict-map! (lambda (k v) (cons v k)) dict) => ((2 . 1) (4 . 3) (6 . 5))
+```
+
 `(dict-filter! `*pred dictionary*`)`  
 
 Returns a dictionary similar to *dictionary* that contains just the associations of *dictionary*
 that satisfy *pred* when it is invoked on the key and value of the association.
 
+```
+(dict-filter (lambda (x) (= x 1)) dict) => ((1 . 2))
+```
+
 `(dict-remove! `*pred dictionary*`)`
 
 Returns a dictionary that contains all the associations of *dictionary*
 except those that satisfy *pred* when called on the key and value.
 
+```
+(dict-remove (lambda (x) (= x 1)) dict) => ((3 . 4) (5 . 6))
+```
+
 `(dict-search! `*dictionary key failure success*`)`
 
 This procedure is a workhorse for dictionary lookup, insert, and delete.
@@ -225,7 +329,10 @@ The behaviors of the continuations are as follows
  *  Invoking `(`*update new-key new-value obj*`)` returns a dictionary that
     contains all the associations of *dictionary*,
     except for the association whose key is the same as *key*,
-    which is replaced or hidden by a new association that maps *new-key* to *new-value*.
+    which is replaced or hidden by a new association
+    that maps *new-key* to *new-value*.
+    It is an error if *key* and *new-key* are not the same
+    in the sense of the dictionary's equality predicate.
 
  *  Invoking `(`*remove obj*`)` returns a dictionary that
     contains all the associations of *dictionary*,
@@ -239,6 +346,10 @@ In all cases, *obj* is returned as a second value.
 
 Returns an exact integer representing the number of associations in *dictionary*.
 
+```
+(dict-size dict) => 0
+```
+
 `(dict-for-each `*proc dictionary*`)`
 
 Invokes *proc* on each key of *dictionary* and its corresponding value in that order.
@@ -247,29 +358,52 @@ If the dictionary type is inherently ordered, associations are processed in the
 inherent order; otherwise in an arbitrary order.
 Returns an unspecified value.
 
+```
+(dict-for-each write dict) => unspecified
+  ; writes "135" to current output
+```
+
 `(dict-count `*pred dictionary*`)`
 
 Passes each association of dictionary as two arguments to *pred*
 and returns the number of times
 that *pred* returned true as an an exact integer.
 
+```
+(dict-count dict (lambda (k v) (even? k) => 0
+```
+
 `(dict-any `*pred dictionary*`)`
 
 Passes each association of *dictionary* as two arguments to *pred*
-and returns the value of the first call to *pred* that returns true.
+and returns the value of the first call to *pred* that returns true,
+after which no further calls are made.
 If the dictionary type is inherently ordered, associations are processed in the
 inherent order; otherwise in an arbitrary order.
 If all calls return false, `dict-any` returns false.
 
+```
+(define (both-even? k v) (and (even? k) (even? v))
+(dict-any both-even? '((2 . 4) (3 . 5))) => #t
+(dict-any both-even? '((1 . 2) (3 . 4))) => #f
+```
+
 `(dict-every `*pred dictionary*`)`
 
 Passes each association of *dictionary* as two arguments to *pred*
-and returns `#f` after the first call to *pred* that returns false.
+and returns `#f` after the first call to *pred* that returns false
+after which no further calls are made.
 If the dictionary type is inherently ordered, associations are processed in the
 inherent order; otherwise in an arbitrary order.
 If all calls return true, `dict-any` returns the value of the last call,
 or `#t` if no calls are made.
 
+```
+(define (some-even? k v) (or (even? k) (even? v))
+(dict-every some-even? '((2 . 3) (3 . 4))) => #t
+(dict-every some-even? '((1 . 3) (3 . 4))) => #f
+```
+
 `(dict-keys `*dictionary*`)`
 
 Returns a list of the keys of *dictionary*.
@@ -277,16 +411,30 @@ If the dictionary type is inherently ordered, associations are processed in the
 inherent order; otherwise in an arbitrary order.
 The order may change when new elements are added to *dictionary*.
 
+```
+(dict-keys dict) => (1 3 5)
+```
+
 `(dict-values `*dictionary*`)`
 
 Returns a list of the values of *dictionary*.  The results returned
 by `dict-keys` and `dict-values` are ordered consistently.
 
+```
+(dict-values dict) => (2 4 6)
+```
+
 `(dict-entries `*dictionary*`)`
 
 Returns two values, the result of calling `dict-keys` and the
 result of calling `dict-values` on *dictionary*.
 
+```
+(dict-entries dict) => ; 2 values
+  (1 3 5)
+  (2 4 6)
+```
+
 `(dict-fold `*proc knil dictionary*`)`
 
 Invokes *proc* on each association of *dictionary* with three arguments:
@@ -296,15 +444,28 @@ For the first invocation, *knil* is used as the third argument.
 Returns the result of the last invocation,
 or *knil* if there was no invocation.
 
+```
+(dict-fold + 0 '((1 . 2) (3 . 4))) => 10
+```
+
 `(dict-map->list `*proc dictionary*`)`
 
 Returns a list of values that result from invoking *proc*
 on the keys and corresponding values of *dictionary*.
 
+```
+(dict-map->list - dict) => (-1 -1 -1)
+```
+
 `(dict->alist `*dictionary*`)`
 
 Returns an alist whose keys and values are the keys and values of *dictionary*.
 
+```
+; plist to alist
+(dict->alist '(1 2 3 4 5 6)) => ((1 . 2) (3 . 4) (5 . 6))
+```
+
 ## Registering dictionary types
 
 The following procedure registers new dictionary types.
@@ -322,7 +483,7 @@ of the procedures defined in this SRFI (other than
 `register-dictionary!` itself), and a *proc* argument
 is the specific procedure implementing it for this type.
 These procedures only need to handle the full argument list
-when defining `dict-ref`, `dict-update!`, and `dict-pop!`, as the
+when defining `dict-ref` and `dict-update!`, as the
 defaults have already been supplied by the framework.
 
 Arguments for the six procedures `dictionary?`, `dict-size`,
@@ -330,48 +491,34 @@ Arguments for the six procedures `dictionary?`, `dict-size`,
 The others are optional, but if provided can be more efficient
 than the versions automatically provided by the implementation of this SRFI.
 
-## Lists as dictionaries
-
-The exact set of pre-registered dictionaries depends on their
-availability in a given implementation.  However, lists are
-supported as dictionaries using the specification in this section.
-If two keys are the same (in the sense of the specified equality predicate),
-then all but the first are treated as if they did not exist.
-
-If the car of a list is a symbol, then the list is assumed to be a property
-list, alternating symbol keys with values.
-Mutation operations actually mutate the property list whenever possible.
-The equality predicate of this type of dictionary is `eq?`.
-
-If a list is empty, or its car is a pair, then the list is assumed
-to be an alist.  New values are added to the beginning of an alist
-and the new alist is returned;
-deletion does not mutate the alist, but returns an alist
-that may or may not share storage with the original alist.
-If an association has been updated, then both the new and the old
-association may be processed by the whole-dictionary procedures.
-The equality predicate of this type of dictionary is `equal?`.
-
-In all other cases, lists are not treated as dictionaries
-unless an appropriate dictionary type has been registered.
-
 ## Implementation
 
 The sample implementation of this SRFI can be found in its repository.
 The following list of dependencies is designed to ease registering
 new dictionary types that may not have complete dictionary APIs:
 
+
+ * `dict-empty?` depends on `dict-size`
  * `dict-contains?` depends on `dict-ref`
+ * `dict-ref` depends on `dict-search!`
  * `dict-ref/default` depends on `dict-ref`
- * `dict-adjoin` depends on `dict-search!`
+ * `dict-set!` depends on `dict-search!`
+ * `dict-adjoin!` depends on `dict-search!`
  * `dict-delete!` depends on `dict-delete-all!`
- * `dict-update/default` depends on `dict-update`
- * `dict-pop` depends on `dict-delete!` and `dict-empty?`
+ * `dict-delete-all!` depends on `dict-search!`
+ * `dict-replace!` depends on `dict-search!`
+ * `dict-intern!` depends on `dict-search!`
+ * `dict-update!` depends on `dict-search!`
+ * `dict-update/default!` depends on `dict-update!`
+ * `dict-pop!` depends on `dict-for-each`, `dict-delete!` and `dict-empty?`
  * `dict-remove!` depends on `dict-filter!`
  * `dict-count` depends on `dict-fold`
+ * `dict-any` depends on `dict-for-each`
+ * `dict-every` depends on `dict-for-each`
  * `dict-keys` depends on `dict-fold`
  * `dict-values` depends on `dict-fold`
  * `dict-entries` depends on `dict-fold`
+ * `dict-fold` depends on `dict-for-each`
  * `dict-map->list` depends on `dict-fold`
  * `dict->alist` depends on `dict-map->list`
 
diff --git a/srfi-125-impl.scm b/srfi-125-impl.scm
new file mode 100644
index 0000000..b683a2a
--- /dev/null
+++ b/srfi-125-impl.scm
@@ -0,0 +1,93 @@
+(define (register-srfi-125!)
+  
+  (define (hash-table-set!* table . obj)
+    (apply hash-table-set! (cons table obj))
+    table)
+  
+  (define (hash-table-update!* table key updater fail success)
+    (hash-table-update! table key updater fail success)
+    table)
+  
+  (define (hash-table-update!/default* table key proc default)
+    (hash-table-update!/default table key proc default)
+    table)
+  
+  (define (hash-table-intern!* table key failure)
+    (define val (hash-table-intern! table key failure))
+    (values table val))
+  
+  (define (hash-table-pop!* table fail)
+    (if (hash-table-empty? table)
+        (fail)
+        (call-with-values
+          (lambda () (hash-table-pop! table))
+          (lambda (key value) (values table key value)))))
+  
+  (define (hash-table-delete-all!* table keys)
+    (for-each
+      (lambda (key)
+        (hash-table-delete! table key))
+      keys)
+    table)
+  
+  (define (hash-table-map!* proc table)
+    (hash-table-map! proc table)
+    table)
+  
+  (define (hash-table-filter* proc table)
+    (hash-table-prune! 
+      (lambda (key value)
+        (not (proc key value)))
+      table)
+    table)
+  
+  (define (hash-table-remove!* proc table)
+    (hash-table-prune! proc table)
+    table)
+  
+  (define (hash-table-search* table key fail success)
+    (define (handle-success value)
+      (define (update new-key new-value obj)
+        (unless (eq? new-key key)
+          (hash-table-delete! table key))
+        (hash-table-set! table new-key new-value)
+        (values table obj))
+      (define (remove obj)
+        (hash-table-delete! table key)
+        (values table obj))
+      (success key value update remove))
+    (define (handle-fail)
+      (define (ignore obj) 
+        (values table obj))
+      (define (insert value obj)
+        (hash-table-set! table key value)
+        (values table obj))
+      (fail insert ignore))
+    
+    (define default (cons #f #f))
+    (hash-table-ref table key handle-fail handle-success))
+  
+  (register-dictionary!
+    'dictionary? hash-table?
+    'dict-empty? hash-table-empty?
+    'dict-contains? hash-table-contains?
+    'dict-ref hash-table-ref
+    'dict-ref/default hash-table-ref/default
+    'dict-set! hash-table-set!*
+    'dict-delete-all! hash-table-delete-all!*
+    'dict-intern! hash-table-intern!*
+    'dict-update! hash-table-update!*
+    'dict-update/default! hash-table-update!/default*
+    'dict-pop! hash-table-pop!*
+    'dict-map! hash-table-map!*
+    'dict-filter! hash-table-filter*
+    'dict-remove! hash-table-remove!*
+    'dict-search! hash-table-search* 
+    'dict-size hash-table-size
+    'dict-for-each hash-table-for-each
+    'dict-keys hash-table-keys
+    'dict-values hash-table-values
+    'dict-entries hash-table-entries
+    'dict-fold hash-table-fold
+    'dict-map->list hash-table-map->list
+    'dict->alist hash-table->alist))
diff --git a/srfi-126-impl.scm b/srfi-126-impl.scm
new file mode 100644
index 0000000..6ac67da
--- /dev/null
+++ b/srfi-126-impl.scm
@@ -0,0 +1,122 @@
+(define (register-srfi-126!)
+  
+  (define (hashtable-ref* table key fail success)
+    (define-values (value found?) (hashtable-lookup table key))
+    (if found?
+        (success value)
+        (fail)))
+  
+  (define (hashtable-ref/default* table key default)
+    (hashtable-ref table key default))
+  
+  (define (hashtable-set!* table . obj)
+    (let loop ((obj obj))
+     (if (null? obj)
+         table
+         (begin
+           (hashtable-set! table (car obj) (cadr obj))
+           (loop (cddr obj))))))
+  
+  (define (hashtable-delete-all!* table keys)
+    (for-each
+      (lambda (key)
+        (hashtable-delete! table key))
+      keys)
+    table)
+  
+  (define (hashtable-intern!* table key default)
+    (define val (hashtable-intern! table key default))
+    (values table val))
+  
+  (define (hashtable-update/default!* table key updater default)
+    (hashtable-update! table key updater default)
+    table)
+
+  (define (hashtable-pop!* table fail)
+    (if (hashtable-empty? table)
+        (fail)
+        (call-with-values
+          (lambda () (hashtable-pop! table))
+          (lambda (key value) (values table key value)))))
+  
+  (define (hashtable-update-all!* proc table)
+    (hashtable-update-all! table proc)
+    table)
+  
+  (define (hashtable-filter!* proc table)
+    (hashtable-prune! table 
+                      (lambda (key value) 
+                        (not (proc key value))))
+    table)
+  
+  (define (hashtable-remove!* proc table)
+    (hashtable-prune! table proc)
+    table)
+  
+  (define (hashtable-search* table key fail success)
+    (define (handle-success value)
+      (define (update new-key new-value obj)
+        (unless (eq? new-key key)
+          (hashtable-delete! table key))
+        (hashtable-set! table new-key new-value)
+        (values table obj))
+      (define (remove obj)
+        (hashtable-delete! table key)
+        (values table obj))
+      (success key value update remove))
+    (define (handle-fail)
+      (define (ignore obj) 
+        (values table obj))
+      (define (insert value obj)
+        (hashtable-set! table key value)
+        (values table obj))
+      (fail insert ignore))
+    
+    (define default (cons #f #f))
+    (define found (hashtable-ref table key default))
+    (if (eq? default found)
+        (handle-fail)
+        (handle-success found)))
+  
+  (define (hashtable-for-each* proc table)
+    (hashtable-walk table proc)
+    table)
+  
+  (define (hashtable-map->lset* proc table)
+    (hashtable-map->lset table proc))
+  
+  (define (hashtable-keys* table)
+    (vector->list (hashtable-keys table)))
+  
+  (define (hashtable-values* table)
+    (vector->list (hashtable-values table)))
+  
+  (define (hashtable-entries* table)
+    (call-with-values
+      (lambda () (hashtable-entries table))
+      (lambda (keys vals)
+        (values
+          (vector->list keys)
+          (vector->list vals)))))
+  
+  (register-dictionary!
+    'dictionary? hashtable?
+    'dict-empty? hashtable-empty?
+    'dict-contains? hashtable-contains?
+    'dict-ref hashtable-ref*
+    'dict-ref/default hashtable-ref/default*
+    'dict-set! hashtable-set!*
+    'dict-delete-all! hashtable-delete-all!*
+    'dict-intern! hashtable-intern!*
+    'dict-update/default! hashtable-update/default!*
+    'dict-pop! hashtable-pop!*
+    'dict-map! hashtable-update-all!*
+    'dict-filter! hashtable-filter!*
+    'dict-remove! hashtable-remove!*
+    'dict-search! hashtable-search*
+    'dict-size hashtable-size
+    'dict-for-each hashtable-for-each*
+    'dict-keys hashtable-keys*
+    'dict-values hashtable-values*
+    'dict-entries hashtable-entries*
+    'dict-map->list hashtable-map->lset*))