add depends; custom alist-delete; fix srfi-126 based impl

5 files changed, 84 insertions, 40 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 f97cf0e..29da4c4 100644
--- a/dictionaries-impl.scm
+++ b/dictionaries-impl.scm
@@ -19,17 +19,15 @@
   (else))
 
 (cond-expand
-  ((and (library (srfi 125))
-        (not (library (srfi 69))))
+  ((library (srfi 125))
    (let ()
     (include "srfi-125-impl.scm")
     (register-srfi-125!)))
   (else))
 
 (cond-expand
-  ((or kawa
-       (and (library (srfi 69))
-            (not (library (srfi 125)))))
+  ((and (library (srfi 69))
+        (not (library (srfi 125))))
    (let ()
     (include "srfi-69-impl.scm")
     (register-srfi-69!)))
diff --git a/dictionaries-test.scm b/dictionaries-test.scm
index 309c97e..099229b 100644
--- a/dictionaries-test.scm
+++ b/dictionaries-test.scm
@@ -3,16 +3,32 @@
         (srfi 1))
 
 (cond-expand
+  (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
+  (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")
@@ -22,19 +38,6 @@
 (define (clear-registry!)
   (set! registry '()))
 
-(cond-expand
-  (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))
-
 (define (do-test alist->dict)
 
   (test-group
@@ -397,8 +400,7 @@
                   alist)))))
 
 (cond-expand
-  ((or kawa
-       (library (srfi 69))
+  ((or (library (srfi 69))
        (library (srfi 125)))
    (test-group
      "srfi-69"
diff --git a/spec.md b/spec.md
index e2a52ed..bd6a06c 100644
--- a/spec.md
+++ b/spec.md
@@ -361,17 +361,28 @@ 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-126-impl.scm b/srfi-126-impl.scm
index ab27603..6ac67da 100644
--- a/srfi-126-impl.scm
+++ b/srfi-126-impl.scm
@@ -28,15 +28,8 @@
     (define val (hashtable-intern! table key default))
     (values table val))
   
-  (define (hashtable-update!* table key updater fail success)
-    (define d (cons #f #f))
-    (define val (hashtable-update! table key proc d))
-    (if (eq? d val)
-        (fail)
-        (success d)))
-  
   (define (hashtable-update/default!* table key updater default)
-    (hashtable-update! table key proc default)
+    (hashtable-update! table key updater default)
     table)
 
   (define (hashtable-pop!* table fail)
@@ -92,6 +85,20 @@
   (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?
@@ -101,7 +108,6 @@
     'dict-set! hashtable-set!*
     'dict-delete-all! hashtable-delete-all!*
     'dict-intern! hashtable-intern!*
-    'dict-update! hashtable-update!*
     'dict-update/default! hashtable-update/default!*
     'dict-pop! hashtable-pop!*
     'dict-map! hashtable-update-all!*
@@ -110,7 +116,7 @@
     '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-entry-lists
+    'dict-keys hashtable-keys*
+    'dict-values hashtable-values*
+    'dict-entries hashtable-entries*
     'dict-map->list hashtable-map->lset*))