[funds-cvs] r123 - trunk/funds/src

[abaine at common-lisp.net]

Author: abaine
Date: Tue Aug  7 22:34:25 2007
New Revision: 123

Modified:
   trunk/funds/src/dictionary.lisp
Log:
Implimented dictionary functionality.

Modified: trunk/funds/src/dictionary.lisp
==============================================================================
--- trunk/funds/src/dictionary.lisp	(original)
+++ trunk/funds/src/dictionary.lisp	Tue Aug  7 22:34:25 2007
@@ -2,14 +2,38 @@
 (in-package :funds)
 
 (defstruct dict 
-  hash-function
-  test-function
+  hash
+  test
   tree)
 
-(defun make-dictionary (&key hash-function test))
+(defun make-dictionary (&key (hash #'sxhash) (test #'eql))
+  (make-dict :hash hash :test test :tree (make-avl-tree)))
 
-(defun dictionary-add (dictionary key value))
+(defun dictionary-add (d k v)
+  (let* ((h (funcall (dict-hash d) k))
+	 (old-alist (tree-find (dict-tree d) h))
+	 (new-alist (acons k v (remove (assoc k old-alist :test (dict-test d))
+				       old-alist))))
+    (make-dict :hash (dict-hash d)
+	       :test (dict-test d)
+	       :tree (tree-insert (dict-tree d) h new-alist))))
 
-(defun dictionary-remove (dictionary key))
+(defun dictionary-remove (d k)
+  (let* ((h (funcall (dict-hash d) k))
+	 (old-alist (tree-find (dict-tree d) h))
+	 (new-alist (remove (assoc k old-alist :test (dict-test d))
+			    old-alist)))
+    (make-dict :hash (dict-hash d)
+	       :test (dict-test d)
+	       :tree (if (null new-alist)
+			 (tree-remove (dict-tree d) h)
+			 (tree-insert (dict-tree d) h new-alist)))))
+
+(defun dictionary-lookup (d k)
+  (let ((pair (assoc k 
+		     (tree-find (dict-tree d) (funcall (dict-hash d) k))
+		     :test (dict-test d))))
+    (if (null pair)
+	(values nil nil)
+	(values (cdr pair) t))))
 
-(defun dictionary-lookup (dictionary key))