Merge pull request #2 from arvyy/master

Create library, rewrite tests against external api, add alist, plist and srfi69/125 implementation

11 files changed, 834 insertions, 447 deletions

diff --git a/alist-impl.scm b/alist-impl.scm
new file mode 100644
index 0000000..fab350d
--- /dev/null
+++ b/alist-impl.scm
@@ -0,0 +1,72 @@
+(define (register-alist!)
+  
+  (define (alist? l)
+    (and (list? l)
+         (or (null? l)
+             (pair? (car l)))))
+
+  (define (alist-map! proc alist)
+    (map 
+      (lambda (e)
+        (define key (car e))
+        (define value (cdr e))
+        (cons key (proc key value))) 
+      alist))
+
+  (define (alist-filter! pred alist)
+    (filter
+      (lambda (e)
+        (pred (car e) (cdr e))) 
+      alist))
+
+  (define (alist-search! alist key failure success)
+    (define (handle-success pair)
+      (define old-key (car pair))
+      (define old-value (cdr pair))
+      (define (update new-key new-value obj)
+        (cond 
+          ((and (eq? old-key
+                     new-key)
+                (eq? old-value
+                     new-value))
+           (values alist obj))
+          (else
+            (let ((new-list 
+                    (alist-cons
+                      new-key new-value
+                      (alist-delete old-key alist))))
+              (values new-list obj)))))
+      (define (remove obj)
+        (values (alist-delete old-key alist) obj))
+      (success old-key old-value update remove))
+
+    (define (handle-failure)
+      (define (insert value obj)
+        (values (alist-cons key value alist)
+                obj))
+      (define (ignore obj)
+        (values alist obj))
+      (failure insert ignore))
+    (cond
+      ((assoc key alist) => handle-success)
+      (else (handle-failure))))
+
+  (define (alist-size alist)
+    (length alist))
+
+  (define (alist-foreach proc alist)
+    (define (proc* e)
+      (proc (car e) (cdr e)))
+    (for-each proc* alist))
+  
+  (define (alist->alist alist)
+    alist)
+
+  (register-dictionary! 
+    'dictionary? alist?
+    'dict-map! alist-map!
+    'dict-filter! alist-filter!
+    'dict-search! alist-search!
+    'dict-size alist-size
+    'dict-for-each alist-foreach
+    'dict->alist alist->alist))
diff --git a/dictionaries-impl.scm b/dictionaries-impl.scm
new file mode 100644
index 0000000..60e5b86
--- /dev/null
+++ b/dictionaries-impl.scm
@@ -0,0 +1,20 @@
+(include "indexes.scm")
+(include "internals.scm")
+(include "externals.scm")
+
+;; register
+(let ()
+ (include "alist-impl.scm")
+ (register-alist!))
+
+(let ()
+ (include "plist-impl.scm")
+ (register-plist!)) 
+
+(cond-expand
+  ((or srfi-69 srfi-125 chibi kawa)
+   (begin
+     (let ()
+      (include "srfi-69-impl.scm")
+      (register-srfi-69!))))
+  (else))
diff --git a/dictionaries-test.scm b/dictionaries-test.scm
new file mode 100644
index 0000000..ede4fe7
--- /dev/null
+++ b/dictionaries-test.scm
@@ -0,0 +1,390 @@
+(import (scheme base)
+        (srfi 1)
+        (dictionaries))
+
+(cond-expand
+  ((or srfi-64 kawa) 
+    (import (srfi 64)))
+  (chibi 
+    (begin
+      (import (except (chibi test) test-equal))
+      (define-syntax test-equal
+        (syntax-rules ()
+          ((_ args ...) (test args ...))))
+      ))
+  (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)))
+  (else))
+
+(define (do-test alist->dict)
+
+  (test-group
+    "dictionary?"
+    (test-assert (dictionary? (alist->dict '())))
+    (test-assert (dictionary? (alist->dict '((a . b))))))
+
+  (test-group
+    "dict-empty?"
+    (test-assert (dict-empty? (alist->dict '())))
+    (test-assert (not (dict-empty? (alist->dict '((a . b)))))))
+
+  (test-group
+    "dict-contains?"
+    (test-assert (not (dict-contains? (alist->dict '()) 'a)))
+    (test-assert (not (dict-contains? (alist->dict '((b . c))) 'a)))
+    (test-assert (dict-contains? (alist->dict '((a . b))) 'a)))
+
+  (test-group
+    "dict-ref"
+    (test-assert (dict-ref (alist->dict '((a . b))) 'a (lambda () #f) (lambda (x) #t)))
+    (test-assert (dict-ref (alist->dict '((a . b))) 'b (lambda () #t) (lambda (x) #f))))
+
+  (test-group
+    "dict-ref/default"
+    (test-equal (dict-ref/default (alist->dict '((a . b))) 'a 'c) 'b)
+    (test-equal (dict-ref/default (alist->dict '((a* . b))) 'a 'c) 'c))
+
+  (test-group
+    "dict-set!"
+    (define d (dict-set! (alist->dict '((a . b))) 'a 'c 'a2 'b2))
+    (test-equal 'c (dict-ref d 'a ))
+    (test-equal 'b2 (dict-ref d 'a2)))
+
+  (test-group
+    "dict-adjoin!"
+    (define d (dict-adjoin! (alist->dict '((a . b))) 'a 'c 'a2 'b2))
+    (test-equal 'b (dict-ref d 'a))
+    (test-equal 'b2 (dict-ref d 'a2)))
+
+  (test-group
+    "dict-delete!"
+    (define d (dict-delete! (alist->dict '((a . b) (c . d))) 'a 'b))
+    (test-equal (dict->alist d) '((c . d))))
+
+  (test-group
+    "dict-delete-all!"
+    (define d (dict-delete-all! (alist->dict '((a . b) (c . d))) '(a b)))
+    (test-equal (dict->alist d) '((c . d))))
+
+  (test-group
+    "dict-replace!"
+    (define d (dict-replace! '((a . b) (c . d)) 'a 'b2))
+    (test-equal 'b2 (dict-ref d 'a))
+    (test-equal 'd (dict-ref d 'c)))
+
+  (test-group
+    "dict-intern!"
+
+    ;; intern existing
+    (let ()
+     (define-values 
+       (d value) 
+       (dict-intern! (alist->dict '((a . b))) 'a (lambda () 'd))) 
+     (test-equal 'b (dict-ref d 'a))
+     (test-equal 'b value))
+
+    ;; intern missing
+    (let ()
+     (define-values
+       (d value)
+       (dict-intern! (alist->dict '((a . b))) 'c (lambda () 'd)))
+     (test-equal 'b (dict-ref d 'a))
+     (test-equal 'd (dict-ref d 'c))
+     (test-equal 'd value)))
+
+  (test-group
+    "dict-update!"
+
+    ;; update existing
+    (let ()
+     (define d (dict-update! (alist->dict '((a . "b"))) 'a 
+                      (lambda (value) 
+                        (string-append value "2"))
+                      error
+                      (lambda (x) (string-append x "1")))) 
+     (test-equal "b12" (dict-ref d 'a)))
+
+    ;; update missing
+    (let ()
+     (define d (dict-update! (alist->dict '((a . "b"))) 'c
+                      (lambda (value) 
+                        (string-append value "2"))
+                      (lambda () "d1")
+                      (lambda (x) (string-append x "1")))) 
+     (test-equal "d12" (dict-ref d 'c))))
+
+  (test-group
+    "dict-update/default!"
+    ;; update existing
+    (let ()
+     (define d (dict-update/default!  (alist->dict '((a . "b"))) 'a 
+                      (lambda (value) 
+                        (string-append value "2"))
+                      "d1")) 
+     (test-equal "b2" (dict-ref d 'a)))
+
+    ;; update missing
+    (let ()
+     (define d (dict-update/default!  (alist->dict '((a . "b"))) 'c
+                      (lambda (value) 
+                        (string-append value "2"))
+                      "d1")) 
+     (test-equal "d12" (dict-ref d 'c))))
+
+  (test-group
+    "dict-pop!"
+    (define-values
+      (new-dict key value)
+      (dict-pop! (alist->dict '((a . b) (c . d))) error))
+    (test-assert
+      (or 
+        (and (equal? (dict->alist new-dict) '((c . d)))
+             (equal? key 'a)
+             (equal? value 'b))
+        
+        (and (equal? (dict->alist new-dict) '((a . b)))
+             (equal? key 'c)
+             (equal? value 'd)))))
+
+  (test-group
+    "dict-map!"
+    (define d (dict-map!  
+                     (lambda (key value)
+                       (string-append value "2"))
+                     (alist->dict '((a . "a") (b . "b")))))
+    (test-equal "a2" (dict-ref d 'a))
+    (test-equal "b2" (dict-ref d 'b)))
+
+  (test-group
+    "dict-filter!"
+    (define d (dict-filter! 
+                     (lambda (key value)
+                       (equal? value 'b))
+                     (alist->dict '((a . b) (c . d)))))
+    (test-equal '((a . b)) (dict->alist d)))
+
+  (test-group
+    "dict-remove!"
+    (define d (dict-remove! 
+                     (lambda (key value)
+                       (equal? value 'b))
+                     (alist->dict '((a . b) (c . d)))))
+    (test-equal '((c . d)) (dict->alist d)))
+
+  (test-group
+    "dict-search!"
+
+    ;; ignore 
+    (let ()
+     (define-values 
+       (dict value)
+       (dict-search!  '((a . b)) 'c
+              (lambda (insert ignore)
+                (ignore 'foo))
+              (lambda args
+                (error))))
+     (test-equal '((a . b)) (dict->alist dict))
+     (test-equal value 'foo))
+
+    ;; insert
+    (let ()
+     (define-values 
+       (dict value)
+       (dict-search! (alist->dict '((a . b))) 'c
+              (lambda (insert ignore)
+                (insert 'd 'foo))
+              (lambda args
+                (error))))
+     (test-equal 'b (dict-ref dict 'a))
+     (test-equal 'd (dict-ref dict 'c))
+     (test-equal value 'foo))
+
+    ;; update
+    (let ()
+     (define-values 
+       (dict value)
+       (dict-search! (alist->dict '((a . b))) 'a
+              (lambda args
+                (error))
+              (lambda (key value update delete)
+                (update 'a2 'b2 'foo))))
+     (test-equal '((a2 . b2)) (dict->alist dict))
+     (test-equal value 'foo))
+
+    ;; delete
+    (let ()
+     (define-values 
+       (dict value)
+       (dict-search! (alist->dict '((a . b) (c . d))) 'a
+              (lambda args
+                (error))
+              (lambda (key value update delete)
+                (delete 'foo))))
+     (test-equal '((c . d)) (dict->alist dict))
+     (test-equal value 'foo)))
+
+  (test-group
+    "dict-size"
+    (test-equal 2 (dict-size  (alist->dict '((a . b) (c . d)))))
+    (test-equal 0 (dict-size (alist->dict '()))))
+
+  (test-group
+    "dict-for-each"
+    (define lst '())
+    (dict-for-each 
+           (lambda (key value)
+             (set! lst (append lst (list key value))))
+           (alist->dict '((a . b) (c . d))))
+    (test-assert
+      (or (equal? '(a b c d) lst)
+          (equal? '(c d a b) lst))))
+
+  (test-group
+    "dict-count"
+    (define count (dict-count 
+                         (lambda (key value)
+                           (equal? value 'b))
+                         (alist->dict '((a . b) (c . d)))))
+    (test-equal count 1))
+
+  (test-group
+    "dict-any"
+
+    (let ()
+     (define value 
+       (dict-any 
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value 'foo))
+
+    (let ()
+     (define value 
+       (dict-any 
+              (lambda (key value)
+                (if (equal? 'e value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value #f)))
+
+  (test-group
+    "dict-every"
+    (let ()
+     (define value
+       (dict-every 
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . b)))))
+     (test-equal value 'foo))
+
+    (let ()
+     (define value
+       (dict-every 
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '())))
+     (test-equal value #t))
+
+    (let ()
+     (define value
+       (dict-every 
+              (lambda (key value)
+                (if (equal? 'b value) 'foo #f))
+              (alist->dict '((a . b) (c . d)))))
+     (test-equal value #f)))
+
+  (test-group
+    "dict-keys"
+    (define keys
+      (dict-keys (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(a c) keys)
+          (equal? '(c a) keys))))
+
+  (test-group
+    "dict-values"
+    (define vals
+      (dict-values (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(b d) vals)
+          (equal? '(d b) vals))))
+
+  (test-group
+    "dict-entries"
+    (define-values
+      (keys vals)
+      (dict-entries (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (and (equal? '(a c) keys)
+               (equal? '(b d) vals))
+          (and (equal? '(c a) keys)
+               (equal? '(d b) vals)))))
+
+  (test-group
+    "dict-fold"
+    (define value
+      (dict-fold 
+             (lambda (key value acc)
+               (append acc (list key value)))
+             '()
+             (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '(a b c d) value)
+          (equal? '(c d a b) value))))
+
+  (test-group
+    "dict-map->list"
+    (define lst
+      (dict-map->list 
+             (lambda (key value)
+               (string-append (symbol->string key)
+                              value))
+             (alist->dict '((a . "b") (c . "d")))))
+    (test-assert
+      (or (equal? '("ab" "cd") lst)
+          (equal? '("cd" "ab") lst))))
+
+  (test-group
+    "dict->alist"
+    (define alist
+      (dict->alist  (alist->dict '((a . b) (c . d)))))
+    (test-assert
+      (or (equal? '((a . b) (c . d)) alist)
+          (equal? '((c . d) (a . b)) alist)))))
+
+(test-begin "Dictionaries")
+
+(test-group 
+  "alist"
+  (do-test (lambda (alist) alist)))
+
+(test-group
+  "plist"
+  (do-test 
+    (lambda (alist) 
+      (apply append 
+             (map (lambda (pair) 
+                    (list (car pair) (cdr pair))) 
+                  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))
+
+(test-end)
diff --git a/dictionaries.scm b/dictionaries.scm
new file mode 100644
index 0000000..1920f6f
--- /dev/null
+++ b/dictionaries.scm
@@ -0,0 +1,55 @@
+(define-library
+  (dictionaries)
+  (import (scheme base)
+          (scheme case-lambda)
+          (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))))
+  
+  (export 
+    
+    ;; predicates
+    dictionary?
+    dict-empty?
+    dict-contains?
+    
+    ;; lookup
+    dict-ref
+    dict-ref/default
+    
+    ;; mutation
+    dict-set!
+    dict-adjoin!
+    dict-delete!
+    dict-delete-all!
+    dict-replace!
+    dict-intern!
+    dict-update!
+    dict-update/default!
+    dict-pop!
+    dict-map!
+    dict-filter!
+    dict-remove!
+    dict-search!
+    
+    ;; whole dictionary
+    dict-size
+    dict-for-each
+    dict-count
+    dict-any
+    dict-every
+    dict-keys
+    dict-values
+    dict-entries
+    dict-fold
+    dict-map->list
+    dict->alist
+    
+    ;; registering dictionary types
+    register-dictionary!)
+  
+  (include "dictionaries-impl.scm"))
diff --git a/dictionaries.sld b/dictionaries.sld
new file mode 120000
index 0000000..3dfc689
--- /dev/null
+++ b/dictionaries.sld
@@ -0,0 +1 @@
+dictionaries.scm
\ No newline at end of file
diff --git a/externals.scm b/externals.scm
index 1a7f0e3..2edd261 100644
--- a/externals.scm
+++ b/externals.scm
@@ -1,38 +1,81 @@
-;;; External (exported) procedure definitions
+(define registry '())
+
+(define (lookup dictionary fail-on-notfound?)
+  (let loop ((r registry))
+   (cond
+     ((null? r) (if fail-on-notfound?
+                    (error "Not a recognized dictionary" dictionary)
+                    #f))
+     ((dcall d? (car r) dictionary) (car r))
+     (else (loop (cdr r))))))
+
+(define (make-internal-wrapper name proc)
+  (cond
+    ((or (equal? name 'dict-set!)
+         (equal? name 'dict-adjoin!)
+         (equal? name 'dict-delete!))
+     (lambda (vec dict objs)
+       (apply proc (cons dict objs))))
+    (else
+      (lambda (vec . args)
+        (apply proc args)))))
+
+(define (register-dictionary! . lst)
+  (define vec (vector-copy model-vec))
+  (do ((lst lst (cddr lst)))
+      ((null? lst))
+      (when (null? (cdr lst))
+        (error "Uneven amount of arguments" lst))
+      (let ((proc-name (car lst))
+            (proc (cadr lst)))
+        (define index
+          (cond 
+            ((assoc proc-name dname-map) => cdr)
+            (else (error "Unrecognized procedure name" proc-name))))
+        (unless (procedure? proc)
+          (error "Not a procedure" proc))
+        (vector-set! vec index (make-internal-wrapper proc-name proc))))
+  (let loop ((reg registry))
+   (define new-reg (reverse (cons vec (reverse reg))))
+   (if (eq? reg registry)
+       (set! registry new-reg)
+       (loop registry))))
+
 
+;;; External (exported) procedure definitions
 (define-syntax dispatch
   (syntax-rules ()
-    (dispatch index dictionary args ...)
-      (let ((vec (lookup dictionary #t))  ; error if not found
-        ((vector-ref vec index) vec dictionary args ...))))))
+    ((dispatch index dictionary args ...)
+     (let ((vec (lookup dictionary #t)))  ; error if not found
+        ((vector-ref vec index) vec dictionary args ...)))))
 
 (define-syntax proc-dispatch
   (syntax-rules ()
-    (dispatch index dictionary args ...)
-      (let ((vec (lookup dictionary #t))  ; error if not found
-        ((vector-ref vec index) vec args ...))))))
+    ((dispatch index dictionary args ...)
+      (let ((vec (lookup dictionary #t)))  ; error if not found
+        ((vector-ref vec index) vec args ...)))))
 
 (define (dictionary? obj)
   (if (lookup obj #f) #t #f))  ; #f if not found
 
 (define (dict-empty? dictionary)
-  (dispatch dempty dictionary))
+  (dispatch dempty? dictionary))
 
 (define (dict-contains? dictionary key)
   (dispatch dcontains? dictionary key))
 
 (define dict-ref
   (case-lambda
-    ((vec dictionary key)
-     (dict-ref vec dictionary key error values))
-    ((vec dictionary key failure)
-     (dict-ref vec dictionary key failure values))
-    ((vec dictionary key failure success))
-     (dict-ref* vec dictionary key failure success)))))
-
+    ((dictionary key)
+     (dict-ref dictionary key error values))
+    ((dictionary key failure)
+     (dict-ref dictionary key failure values))
+    ((dictionary key failure success)
+     (dict-ref* dictionary key failure success))))
 
 (define (dict-ref* dictionary key failure success)
   (dispatch dref dictionary key failure success))
+
 (define (dict-ref/default dictionary key default)
   (dispatch dref/default dictionary key default))
 
@@ -46,7 +89,7 @@
   (dispatch ddelete! dictionary keys))
 
 (define (dict-delete-all! dictionary keylist)
-  (dispatch ddelete-all dictionary keylist))
+  (dispatch ddelete-all! dictionary keylist))
 
 (define (dict-replace! dictionary key value)
   (dispatch dreplace! dictionary key value))
@@ -55,25 +98,25 @@
   (dispatch dintern! dictionary key failure))
 
 (define dict-update!
-  (case-lambda)
-    ((vec dictionary key updater))
-     (dict-update! vec dictionary key updater error values)))
-    ((vec dictionary key updater failure))
-     (dict-update! vec dictionary key updater failure values)))
-    ((vec dictionary key updater failure success))
-     (dispatch dupdate! dictionary key updater failure success))
+  (case-lambda
+    ((dictionary key updater)
+     (dict-update! dictionary key updater error values))
+    ((dictionary key updater failure)
+     (dict-update! dictionary key updater failure values))
+    ((dictionary key updater failure success)
+     (dispatch dupdate! dictionary key updater failure success))))
 
 (define (dict-update/default! dictionary key updater default)
-  (dispatch dupdate/default dictionary key updater default))
+  (dispatch dupdate/default! dictionary key updater default))
 
 (define dict-pop!
-  (case-lambda)
-    ((vec dictionary))
-     (dict-pop!* vec dictionary error)))
-    ((vec dictionary failure))
-     (dict-pop!* vec dictionary failure)))))
+  (case-lambda
+    ((dictionary)
+     (dict-pop!* dictionary error))
+    ((dictionary failure)
+     (dict-pop!* dictionary failure))))
 
-(define (dict-pop!* vec dictionary failure)
+(define (dict-pop!* dictionary failure)
   (dispatch dpop! dictionary failure))
 
 (define (dict-map! proc dictionary)
@@ -83,34 +126,34 @@
   (proc-dispatch dfilter! dictionary pred dictionary))
 
 (define (dict-remove! pred dictionary)
-  (dispatch dremove! dictionary yyy))
+  (proc-dispatch dremove! dictionary pred dictionary))
 
 (define (dict-search! dictionary key failure success)
-  (dispatch dsearch! dictionary yyy)
+  (dispatch dsearch! dictionary key failure success))
 
 (define (dict-size dictionary)
-  (dispatch dsize dictionary yyy)
+  (dispatch dsize dictionary))
 
 (define (dict-for-each proc dictionary)
-  (proc-dispatch dfor-each dictionary proc dictionary)
+  (proc-dispatch dfor-each dictionary proc dictionary))
 
 (define (dict-count pred dictionary)
-  (dispatch dcount dictionary yyy))
+  (proc-dispatch dcount dictionary pred dictionary))
 
 (define (dict-any pred dictionary)
-  (dispatch dany dictionary yyy))
+  (proc-dispatch dany dictionary pred dictionary))
 
 (define (dict-every pred dictionary)
-  (dispatch devery dictionary yyy))
+  (proc-dispatch devery dictionary pred dictionary))
 
 (define (dict-keys dictionary)
-  (dispatch dkeys dictionary yyy))
+  (dispatch dkeys dictionary))
 
 (define (dict-values dictionary)
-  (dispatch dvalues dictionary yyy))
+  (dispatch dvalues dictionary))
 
 (define (dict-entries dictionary)
-  (dispatch dentries dictionary yyy))
+  (dispatch dentries dictionary))
 
 (define (dict-fold proc knil dictionary)
   (proc-dispatch dfold dictionary proc knil dictionary))
@@ -119,4 +162,4 @@
   (proc-dispatch dmap->list dictionary proc dictionary))
 
 (define (dict->alist dictionary)
-  (dispatch d->alist dictionary yyy))
+  (dispatch d->alist dictionary))
diff --git a/internals-test.scm b/internals-test.scm
deleted file mode 100644
index dd760d9..0000000
--- a/internals-test.scm
+++ /dev/null
@@ -1,392 +0,0 @@
-(import (scheme base)
-        (srfi 1)
-        (srfi 64))
-
-(include "indexes.scm")
-(include "internals.scm")
-
-(define (alist? vec l)
-  (and (list? l) (every pair? l)))
-
-(define (alist-map! vec proc alist)
-  (map 
-    (lambda (e)
-      (define key (car e))
-      (define value (cdr e))
-      (cons key (proc key value))) 
-    alist))
-
-(define (alist-filter! vec pred alist)
-  (filter
-    (lambda (e)
-      (pred (car e) (cdr e))) 
-    alist))
-
-(define (alist-search! vec alist key failure success)
-  (define (handle-success pair)
-    (define old-key (car pair))
-    (define old-value (cdr pair))
-    (define (update new-key new-value obj)
-      (cond 
-        ((and (eq? old-key
-                   new-key)
-              (eq? old-value
-                   new-value))
-         (values alist obj))
-        (else
-          (let ((new-list 
-                  (alist-cons
-                    new-key new-value
-                    (alist-delete old-key alist))))
-            (values new-list obj)))))
-    (define (remove obj)
-      (values (alist-delete old-key alist) obj))
-    (success old-key old-value update remove))
-  
-  (define (handle-failure)
-    (define (insert value obj)
-      (values (alist-cons key value alist)
-              obj))
-    (define (ignore obj)
-      (values alist obj))
-    (failure insert ignore))
-  (cond
-    ((assoc key alist) => handle-success)
-    (else (handle-failure))))
-
-(define (alist-size vec alist)
-  (define keys (map car alist))
-  (define (fold-proc el set)
-    (lset-adjoin equal? set el))
-  (define key-set (fold fold-proc '() keys))
-  (length key-set))
-
-(define (alist-foreach vec proc alist)
-  (define (proc* e)
-    (proc (car e) (cdr e)))
-  (for-each proc* alist))
-
-
-(define vec (vector-copy model-vec))
-(vector-set! vec d? alist?)
-(vector-set! vec dmap! alist-map!)
-(vector-set! vec dfilter! alist-filter!)
-(vector-set! vec dsearch! alist-search!)
-(vector-set! vec dsize alist-size)
-(vector-set! vec dfor-each alist-foreach)
-
-(test-begin "Dictionary test")
-
-(test-group
-  "idictionary?"
-  (test-assert (dcall d? vec '()))
-  (test-assert (dcall d? vec '((a . b)))))
-
-(test-group
-  "idict-empty?"
-  (test-assert (dcall dempty? vec '()))
-  (test-assert (not (dcall dempty? vec '((a . b))))))
-
-(test-group
-  "idict-contains?"
-  (test-assert (not (dcall dcontains? vec '() 'a)))
-  (test-assert (not (dcall dcontains? vec '((b . c)) 'a)))
-  (test-assert (dcall dcontains? vec '((a . b)) 'a)))
-
-(test-group
-  "idict-ref"
-  (test-assert (dcall dref vec '((a . b)) 'a (lambda () #f) (lambda (x) #t)))
-  (test-assert (dcall dref vec '((a . b)) 'b (lambda () #t) (lambda (x) #f))))
-
-(test-group
-  "idict-ref/default"
-  (test-equal (dcall dref/default vec '((a . b)) 'a 'c) 'b)
-  (test-equal (dcall dref/default vec '((a* . b)) 'a 'c) 'c))
-
-(test-group
-  "idict-set!"
-  (define d (dcall dset! vec '((a . b)) 'a 'c 'a2 'b2))
-  (test-equal '(a . c) (assoc 'a d))
-  (test-equal '(a2 . b2) (assoc 'a2 d)))
-
-(test-group
-  "idict-adjoin!"
-  (define d (dcall dset! vec '((a . b)) 'a 'c 'a2 'b2))
-  (test-equal '(a . c) (assoc 'a d))
-  (test-equal '(a2 . b2) (assoc 'a2 d)))
-
-(test-group
-  "idict-delete!"
-  (define d (dcall ddelete! vec '((a . b) (c . d)) 'a 'b))
-  (test-equal d '((c . d))))
-
-(test-group
-  "idict-delete-all!"
-  (define d (dcall ddelete-all! vec '((a . b) (c . d)) '(a b)))
-  (test-equal d '((c . d))))
-
-(test-group
-  "idict-replace!"
-  (define d (dcall dreplace! vec '((a . b) (c . d)) 'a 'b2))
-  (test-equal '(a . b2) (assoc 'a d))
-  (test-equal '(c . d) (assoc 'c d)))
-
-(test-group
-  "idict-intern!"
-  
-  ;; intern existing
-  (let ()
-   (define-values 
-     (d value) 
-     (dcall dintern! vec '((a . b)) 'a (lambda () 'd))) 
-   (test-equal '(a . b) (assoc 'a d))
-   (test-equal 'b value))
-  
-  ;; intern missing
-  (let ()
-   (define-values
-     (d value)
-     (dcall dintern! vec '((a . b)) 'c (lambda () 'd)))
-   (test-equal '(a . b) (assoc 'a d))
-   (test-equal '(c . d) (assoc 'c d))
-   (test-equal 'd value)))
-
-(test-group
-  "idict-update!"
-  
-  ;; update existing
-  (let ()
-   (define d (dcall dupdate! vec '((a . "b")) 'a 
-                    (lambda (value) 
-                      (string-append value "2"))
-                    error
-                    (lambda (x) (string-append x "1")))) 
-   (test-equal '(a . "b12") (assoc 'a d)))
-  
-  ;; update missing
-  (let ()
-   (define d (dcall dupdate! vec '((a . "b")) 'c
-                    (lambda (value) 
-                      (string-append value "2"))
-                    (lambda () "d1")
-                    (lambda (x) (string-append x "1")))) 
-   (test-equal '(c . "d12") (assoc 'c d))))
-
-(test-group
-  "idict-update/default!"
-  ;; update existing
-  (let ()
-   (define d (dcall dupdate/default! vec '((a . "b")) 'a 
-                    (lambda (value) 
-                      (string-append value "2"))
-                    "d1")) 
-   (test-equal '(a . "b2") (assoc 'a d)))
-  
-  ;; update missing
-  (let ()
-   (define d (dcall dupdate/default! vec '((a . "b")) 'c
-                    (lambda (value) 
-                      (string-append value "2"))
-                    "d1")) 
-   (test-equal '(c . "d12") (assoc 'c d))))
-
-(test-group
-  "idict-pop!"
-  (define-values
-    (new-dict key value)
-    (dcall dpop! vec '((a . b) (c . d)) error))
-  (test-equal new-dict '((c . d)))
-  (test-equal key 'a)
-  (test-equal value 'b))
-
-(test-group
-  "idict-map!"
-  (define d (dcall dmap! vec 
-                   (lambda (key value)
-                     (string-append value "2"))
-                   '((a . "a") (b . "b"))))
-  (test-equal '(a . "a2") (assoc 'a d))
-  (test-equal '(b . "b2") (assoc 'b d)))
-
-(test-group
-  "idict-filter!"
-  (define d (dcall dfilter! vec
-                   (lambda (key value)
-                     (equal? value 'b))
-                   '((a . b) (c . d))))
-  (test-equal '((a . b)) d))
-
-(test-group
-  "idict-remove!"
-  (define d (dcall dremove! vec
-                   (lambda (key value)
-                     (equal? value 'b))
-                   '((a . b) (c . d))))
-  (test-equal '((c . d)) d))
-
-(test-group
-  "idict-search!"
-  
-  ;; ignore 
-  (let ()
-   (define-values 
-     (dict value)
-     (dcall dsearch! vec '((a . b)) 'c
-            (lambda (insert ignore)
-              (ignore 'foo))
-            (lambda args
-              (error))))
-   (test-equal '((a . b)) dict)
-   (test-equal value 'foo))
-  
-  ;; insert
-  (let ()
-   (define-values 
-     (dict value)
-     (dcall dsearch! vec '((a . b)) 'c
-            (lambda (insert ignore)
-              (insert 'd 'foo))
-            (lambda args
-              (error))))
-   (test-equal '(a . b) (assoc 'a dict))
-   (test-equal '(c . d) (assoc 'c dict))
-   (test-equal value 'foo))
-  
-  ;; update
-  (let ()
-   (define-values 
-     (dict value)
-     (dcall dsearch! vec '((a . b)) 'a
-            (lambda args
-              (error))
-            (lambda (key value update delete)
-              (update 'a2 'b2 'foo))))
-   (test-equal '((a2 . b2)) dict)
-   (test-equal value 'foo))
-  
-  ;; delete
-  (let ()
-   (define-values 
-     (dict value)
-     (dcall dsearch! vec '((a . b) (c . d)) 'a
-            (lambda args
-              (error))
-            (lambda (key value update delete)
-              (delete 'foo))))
-   (test-equal '((c . d)) dict)
-   (test-equal value 'foo)))
-
-(test-group
-  "idict-size"
-  (test-equal 2 (dcall dsize vec '((a . b) (c . d))))
-  (test-equal 0 (dcall dsize vec '())))
-
-(test-group
-  "idict-for-each"
-  (define lst '())
-  (dcall dfor-each vec
-         (lambda (key value)
-           (set! lst (append lst (list key value))))
-         '((a . b) (c . d)))
-  (test-equal '(a b c d) lst))
-
-(test-group
-  "idict-count"
-  (define count (dcall dcount vec
-                       (lambda (key value)
-                         (equal? value 'b))
-                       '((a . b) (c . d))))
-  (test-equal count 1))
-
-(test-group
-  "idict-any"
-  
-  (let ()
-   (define value 
-     (dcall dany vec
-            (lambda (key value)
-              (if (equal? 'b value) 'foo #f))
-            '((a . b) (c . d))))
-   (test-equal value 'foo))
-
-  (let ()
-   (define value 
-     (dcall dany vec
-            (lambda (key value)
-              (if (equal? 'e value) 'foo #f))
-            '((a . b) (c . d))))
-   (test-equal value #f)))
-
-(test-group
-  "idict-every"
-  (let ()
-   (define value
-     (dcall devery vec
-            (lambda (key value)
-              (if (equal? 'b value) 'foo #f))
-            '((a . b) (c . b))))
-   (test-equal value 'foo))
-  
-  (let ()
-   (define value
-     (dcall devery vec
-            (lambda (key value)
-              (if (equal? 'b value) 'foo #f))
-            '()))
-   (test-equal value #t))
-  
-  (let ()
-   (define value
-     (dcall devery vec
-            (lambda (key value)
-              (if (equal? 'b value) 'foo #f))
-            '((a . b) (c . d))))
-   (test-equal value #f)))
-
-(test-group
-  "idict-keys"
-  (define keys
-    (dcall dkeys vec '((a . b) (c . d))))
-  (test-equal '(a c) keys))
-
-(test-group
-  "idict-values"
-  (define vals
-    (dcall dvalues vec '((a . b) (c . d))))
-  (test-equal '(b d) vals))
-
-(test-group
-  "idict-entries"
-  (define-values
-    (keys vals)
-    (dcall dentries vec '((a . b) (c . d))))
-  (test-equal '(a c) keys)
-  (test-equal '(b d) vals))
-
-(test-group
-  "idict-fold"
-  (define value
-    (dcall dfold vec
-           (lambda (key value acc)
-             (append acc (list key value)))
-           '()
-           '((a . b) (c . d))))
-  (test-equal value '(a b c d)))
-
-(test-group
-  "idict-map->list"
-  (define lst
-    (dcall dmap->list vec
-           (lambda (key value)
-             (string-append (symbol->string key)
-                            value))
-           '((a . "b") (c . "d"))))
-  (test-equal '("ab" "cd") lst))
-
-(test-group
-  "idict->alist"
-  (define alist
-    (dcall d->alist vec '((a . b) (c . d))))
-  (test-equal alist '((a . b) (c . d))))
-
-(test-end)
diff --git a/internals.scm b/internals.scm
index c732684..9652aaa 100644
--- a/internals.scm
+++ b/internals.scm
@@ -46,7 +46,7 @@
       ((null? objs) 
        dictionary)
       ((null? (cdr objs))
-       (error "mismatch of key / values argument list"))
+       (error "mismatch of key / values argument list" objs))
       (else (let*-values
               (((key) (car objs))
                ((value) (cadr objs))
@@ -58,13 +58,13 @@
               (loop (cddr objs)
                     new-d))))))
 
-(define (idict-set! vec dictionary . objs)
+(define (idict-set! vec dictionary objs)
   (idict-set!* vec dictionary #f objs))
 
-(define (idict-adjoin! vec dictionary . objs)
+(define (idict-adjoin! vec dictionary objs)
   (idict-set!* vec dictionary #t objs))
 
-(define (idict-delete! vec dictionary . keys)
+(define (idict-delete! vec dictionary keys)
   (dcall ddelete-all! vec dictionary keys))
 
 (define (idict-delete-all! vec dictionary keylist)
@@ -122,7 +122,7 @@
         (dcall dfor-each vec
                (lambda (key value)
                  (define new-dict
-                   (dcall ddelete! vec dictionary key))
+                   (dcall ddelete! vec dictionary (list key)))
                  (cont new-dict key value)) 
                dictionary))))
   (define empty? (dcall dempty? vec dictionary))
@@ -198,8 +198,15 @@
          dictionary)))
 
 (define (idict-entries vec dictionary)
-  (values (dcall dkeys vec dictionary)
-          (dcall dvalues vec dictionary)))
+  (define pair 
+    (dcall dfold vec
+           (lambda (key value acc)
+             (cons (cons key (car acc))
+                   (cons value (cdr acc))))
+           (cons '() '())
+           dictionary))
+  (values (reverse (car pair)) 
+          (reverse (cdr pair))))
 
 (define (idict-fold vec proc knil dictionary)
   (define acc knil)
@@ -210,13 +217,13 @@
   acc)
 
 (define (idict-map->list vec proc dictionary)
-  (call-with-values
-    (lambda ()
-      (dcall dentries vec dictionary))
-    (lambda (keys vals)
-      (map proc
-           keys
-           vals))))
+  (define reverse-lst
+    (dcall dfold vec
+         (lambda (key value lst)
+           (cons (proc key value) lst)) 
+         '()
+         dictionary))
+  (reverse reverse-lst))
 
 (define (idict->alist vec dictionary)
   (dcall dmap->list vec
diff --git a/plist-impl.scm b/plist-impl.scm
new file mode 100644
index 0000000..4baa337
--- /dev/null
+++ b/plist-impl.scm
@@ -0,0 +1,93 @@
+(define (register-plist!)
+  
+  (define (plist?  l)
+    (and (list? l)
+         (not (null? l))
+         (symbol? (car l))))
+
+  (define (plist-map!  proc plist)
+    (let loop ((pl plist))
+     (cond
+       ((null? pl) plist)
+       ((null? (cdr pl)) (error "Malformed plist" plist))
+       (else 
+         (let ((key (car pl))
+               (value (cadr pl))
+               (rest (cddr pl)))
+           (set-car! (cdr pl)
+                     (proc key value))
+           (loop rest))))))
+
+  (define (plist-filter!  pred plist)
+    (define head (cons #f plist))
+    (let loop ((pl plist)
+               (parent-cell head))
+     (cond
+       ((null? pl) (cdr head))
+       ((null? (cdr pl)) (error "Malformed plist" plist))
+       (else 
+         (let ((key (car pl))
+               (value (cadr pl))
+               (rest (cddr pl)))
+           (if (pred key value)
+               (loop rest
+                     (cdr pl))
+               (loop (begin
+                       (set-cdr! parent-cell rest)
+                       rest)
+                     parent-cell)))))))
+
+  ;; head is a pair, whose cdr is the plist
+  ;; if found, returns a pair, whose cdr is rest of plist, and cadr is key that was searched for
+  ;; if not found, returns #f
+  ;;
+  ;; the pair indirection is used so that calling set-cdr! on the result allows the plist to be mutated
+  (define (find-plist-entry key head)
+    (define plist (cdr head))
+    (cond
+      ((null? plist) #f)
+      ((equal? key (car plist)) head)
+      (else (find-plist-entry key (cdr plist)))))
+  
+  (define (plist-search!  plist key failure success)
+    (define plist-head (cons #t plist))
+    (define (handle-success head)
+      (define key-cell (cdr head))
+      (define val-cell (cddr head))
+      (define (update new-key new-value obj)
+        (set-car! key-cell new-key)
+        (set-car! val-cell new-value)
+        (values plist obj))
+      (define (remove obj)
+        (set-cdr! head (cddr (cdr head)))
+        (values (cdr plist-head) obj))
+      (success (car key-cell) (car val-cell) update remove))
+
+    (define (handle-failure)
+      (define (insert value obj)
+        (values (cons key (cons value plist))
+                obj))
+      (define (ignore obj)
+        (values plist obj))
+      (failure insert ignore))
+    (cond
+      ((find-plist-entry key plist-head) => handle-success)
+      (else (handle-failure))))
+
+  (define (plist-size  plist)
+    (/ (length plist) 2))
+
+  (define (plist-foreach  proc plist)
+    (let loop ((pl plist))
+     (if (null? pl) #t
+         (begin
+           (proc (car pl) (cadr pl))
+           (loop (cddr pl))))))
+  
+  (register-dictionary! 
+    'dictionary? plist?
+    'dict-map! plist-map!
+    'dict-filter! plist-filter!
+    'dict-search! plist-search!
+    'dict-size plist-size
+    'dict-for-each plist-foreach))
diff --git a/readme.md b/readme.md
new file mode 100644
index 0000000..26850d3
--- /dev/null
+++ b/readme.md
@@ -0,0 +1,10 @@
+Running tests:
+
+Kawa
+`kawa dictionaries-test.scm`
+
+Chibi
+`chibi-scheme -I . dictionaries-test.scm`
+
+Gauche
+`gosh -I . dictionaries-test.scm`
diff --git a/srfi-69-impl.scm b/srfi-69-impl.scm
new file mode 100644
index 0000000..3f8a602
--- /dev/null
+++ b/srfi-69-impl.scm
@@ -0,0 +1,88 @@
+(define (register-srfi-69!)
+  
+  (define (hash-table-ref* table key fail success)
+    (define default (cons #f #f))
+    (define found (hash-table-ref/default table key default))
+    (if (eq? found default)
+        (fail)
+        (success found)))
+  
+  (define (hash-table-set!* table . obj)
+    (let loop ((obj obj))
+     (if (null? obj)
+         table
+         (begin
+           (hash-table-set! table (car obj) (cadr obj))
+           (loop (cddr obj))))))
+  
+  (define (hash-table-update!/default* table key proc default)
+    (hash-table-update!/default table key proc default)
+    table)
+  
+  (define (hash-table-delete-all!* table keys)
+    (for-each
+      (lambda (key)
+        (hash-table-delete! table key))
+      keys)
+    table)
+  
+  (define (hash-table-foreach* proc table)
+    (hash-table-walk table proc))
+  
+  (define (hash-table-map* proc table)
+    (hash-table-walk table (lambda (key value)
+                             (hash-table-set! table key (proc key value))))
+    table)
+  
+  (define (hash-table-filter* proc table)
+    (hash-table-walk table 
+                     (lambda (key value)
+                       (unless (proc key value)
+                         (hash-table-delete! table key))))
+    table)
+  
+  (define (hash-table-fold* proc knil table)
+    (hash-table-fold table proc knil))
+  
+  (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))
+    (define found (hash-table-ref/default table key default))
+    (if (eq? default found)
+        (handle-fail)
+        (handle-success found)))
+  
+  (register-dictionary!
+    'dictionary? hash-table?
+    '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-contains? hash-table-exists?
+    'dict-update/default! hash-table-update!/default*
+    'dict-size hash-table-size
+    'dict-keys hash-table-keys
+    'dict-values hash-table-values
+    'dict-map! hash-table-map*
+    'dict-filter! hash-table-filter*
+    'dict-for-each hash-table-foreach*
+    'dict-fold hash-table-fold*
+    'dict->alist hash-table->alist
+    'dict-search! hash-table-search*))