Work on new ldict implementation.

src/util-dict.scm

@@ -28,7 +28,10 @@
 (module
  util-dict-list
  (
+  TAG-LDICT
+  
   make-ldict
+  
   ldict-has-key?
   ldict-ref
   ldict-remove
@@ -43,14 +46,30 @@
 
  (import scheme
 	 (chicken base)
-	 testing)
+	 testing
+	 util-tag)
 
- ;; Returns an empty dictionary represented as empty list or a list of
- ;; pre-initialized cons pairs.
- (define (make-dict . pairs)
-   (if (null? pairs)
-       '()
-       (car pairs)))
+ ;; Tag used for identifying list dictionaries from this module
+ (define TAG-LDICT (make-tag LDICT))
+
+ ;; Creates an empty dictionary and optionally populates it with
+ ;; provided pairs. Default equality is eq?, default are '().
+ (define (make-ldict . equality?/pairs)
+   (let ((equality? (if (or (null? equality?/pairs)
+			    (not (procedure? (car equality?/pairs))))
+			eq?
+			(car equality?/pairs)))
+	 (pairs (if (or (null? equality?/pairs)
+			(procedure? (car equality?/pairs)))
+		    '()
+		    (car equality?/pairs))))
+     (let loop ((ld (list TAG-LDICT
+			  (list equality?)))
+		(pairs pairs))
+       (if (null? pairs)
+	   ld
+	   (loop (ldict-set ld (caar pairs) (cdar pairs))
+		 (cdr pairs))))))
 
  ;; Checks whether given dictionary d contains the key k.
  (define (dict-has-key? d k)