Use the new BST dictionary for indexing members.

src/Makefile

@@ -125,7 +125,8 @@ MBASE-SOURCES=mbase.scm testing.import.scm util-dict-list.import.scm	\
 	 cal-period.import.scm cal-month.import.scm			\
 	 configuration.import.scm progress.import.scm			\
 	 table.import.scm mbase-dir.import.scm util-list.import.scm	\
-	 util-tag.import.scm util-kwargs.import.scm
+	 util-tag.import.scm util-kwargs.import.scm			\
+	 util-dict-bst.import.scm
 
 mbase.o: mbase.import.scm
 mbase.import.scm: $(MBASE-SOURCES)

src/mbase.scm

@@ -49,6 +49,7 @@
   mbase-free-ids
   mbase-gen-id
 
+  mbase-update-by-id
   mbase-update
 
   mbase-info
@@ -79,7 +80,8 @@
 	 progress
 	 mbase-dir
 	 util-tag
-	 util-kwargs)
+	 util-kwargs
+	 util-dict-bst)
 
  ;; Constant unique tag
  (define TAG-MBASE (make-tag mbase))
@@ -111,35 +113,31 @@
 				     mb0))
 		  (mb (ldict-reduce '()
 				    (lambda (acc id mr)
-				      (cons mr acc))
+				      (cons (cons id mr) acc))
 				    mb1)))
-	     mb)))))))
+	     (list->bdict (sort mb (lambda (a b) (< (car a) (car b))))))))))))
 
  ;; Predicate
  (define (mbase? v)
    (and (ldict? v)
 	(eq? (ldict-ref v 'TAG #f) TAG-MBASE)))
 
- ;; Returns the internal members list
+ ;; Returns the internal members BST
  (define (mbase-members mb)
    (ldict-ref mb 'members))
 
  ;; Gets member based by generic predicate
- (define (find-member-by-predicate mb pred)
-   (let loop ((mdb (mbase-members mb)))
-     (if (null? mdb)
-	 #f
-	 (let ((mr (car mdb)))
-	   (if (pred mr)
-	       mr
-	       (loop (cdr mdb)))))))
+ (define (find-member-by-predicate mb pred?)
+   (bdict-find-value
+    (mbase-members mb)
+    (lambda (k v)
+      (pred? v))))
 
- ;; Returns member record found by id
+ ;; Returns member record found by id, accepts numeric id or #f
  (define (find-member-by-id mb id)
-   (find-member-by-predicate
-    mb
-    (lambda (mr)
-      (eq? (ldict-ref mr 'id) id))))
+   (if id
+       (bdict-ref (mbase-members mb) id #f)
+       #f))
 
  ;; Returns member record found by id
  (define (find-member-by-nick mb nick)
@@ -153,16 +151,11 @@
        nick))))
 
  ;; Returns a list of members which match given predicate.
- (define (find-members-by-predicate mb pred)
-   (let loop ((mb (mbase-members mb))
-	      (res '()))
-     (if (null? mb)
-	 res
-	 (let ((mr (car mb)))
-	   (loop (cdr mb)
-		 (if (pred mr)
-		     (cons mr res)
-		     res))))))
+ (define (find-members-by-predicate mb pred?)
+   (bdict-filter-values
+    (mbase-members mb)
+    (lambda (k v)
+      (pred? v))))
 
  ;; Returns a list of members whose nick contains pat
  (define (find-members-by-nick mb pat)
@@ -173,13 +166,13 @@
 
  ;; Returns all ids found in the database
  (define (list-mbase-ids mb)
-   (map (lambda (mr) (ldict-ref mr 'id))
-	(mbase-members mb)))
+   (bdict-keys (mbase-members mb)))
 
  ;; Returns all nicks found in the database
  (define (list-mbase-nicks mb)
-   (map brmember-nick
-	(mbase-members mb)))
+   (bdict-map-list (mbase-members mb)
+		   (lambda (id mr)
+		     (brmember-nick mr))))
 
  ;; Returns all free ids
  (define (mbase-free-ids mb)
@@ -195,16 +188,23 @@
 	  (vfids (list->vector fids)))
      (vector-ref vfids (pseudo-random-integer (vector-length vfids)))))
 
+ ;; Returns new members base with member specified by id processed by
+ ;; proc.
+ (define (mbase-update-by-id mb id proc)
+   (ldict-set mb
+	      'members
+	      (bdict-update (mbase-members mb) id proc)))
+
  ;; Returns new members base with member records matching the
  ;; predicate processed by proc.
  (define (mbase-update mb pred? proc)
    (ldict-set mb
 	      'members
-	      (map (lambda (mr)
-		     (if (pred? mr)
-			 (proc mr)
-			 mr))
-		   (mbase-members mb))))
+	      (bdict-map-dict (mbase-members mb)
+			      (lambda (id mr)
+				(if (pred? mr)
+				    (proc mr)
+				    mr)))))
 
  ;; Returns dictionary with statistics about the members base.
  (define (mbase-info mb-arg)

src/members-payments.scm

@@ -98,10 +98,9 @@
 		(varsym-id (transaction-extract-member-id transaction))
 		(bmember (find-member-by-id mb varsym-id)))
 	   (loop (if bmember
-		     (mbase-update
+		     (mbase-update-by-id
 		      mb
-		      (lambda (mr)
-			(compare-member-id (brmember-id mr) varsym-id))
+		      varsym-id
 		      (lambda (mr)
 			(brmember-add-payment mr transaction)))
 		     (if (and (or (not last-checked)

src/util-dict-bst.scm

@@ -55,6 +55,11 @@
   bdict-filter-pairs
   bdict-filter-keys
   bdict-filter-values
+
+  list->bdict
+
+  bdict-map-list
+  bdict-map-dict
   
   bdict-tests!
   )
@@ -307,6 +312,32 @@
 	    a)))
     d))
 
+ ;; Converts list of pairs into BST dictionary
+ (define (list->bdict l)
+   (vector->bdict
+    (apply vector l)))
+
+ ;; Returns arbitrary list created by mapping all elements
+ (define (bdict-map-list d p)
+   (reverse
+    (bdict-reduce
+     '()
+     (lambda (a k v)
+       (cons (p k v) a))
+     d)))
+
+ ;; Returns new dictionary with all values processed (keys are left
+ ;; intact)
+ (define (bdict-map-dict d p)
+   (set-bdict-root
+    d
+    (let loop ((n (bdict-root d)))
+      (if n
+	  (cons (cons (caar n) (p (caar n) (cdar n)))
+		(cons (loop (cadr n))
+		      (loop (cddr n))))
+	  #f))))
+
  ;; Performs module self-tests
  (define (bdict-tests!)
    (run-tests