Replace VHashes with Hash Tables

diff --git a/src/bongodb.scm b/src/bongodb.scm
index 3e5dc680c115c49e5fa79f00eca1661e9952da90..24ced3684c04aba6302c46a7818b7893f1bbd3e5 100644 (file)
--- a/src/bongodb.scm
+++ b/src/bongodb.scm
@@ -16,10 +16,9 @@
 
 
 (define-module (bongodb)
 
 
 (define-module (bongodb)

-  #:use-module (ice-9 receive)
-  #:use-module (ice-9 vlist)

   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)

+  #:use-module (srfi srfi-69)

   #:export (make-collection
            collection?
            count
   #:export (make-collection
            collection?
            count


@@ -41,10 +40,10 @@
   (table get-table))
 
 (define (make-collection)
   (table get-table))
 
 (define (make-collection)

-  (make-collection-record vlist-null))
+  (make-collection-record (make-hash-table)))

 
 (define (count col)
 
 (define (count col)

-  (vlist-length (get-table col)))
+  (hash-table-size (get-table col)))

 
 (set-record-type-printer! collection
   (lambda (record port)
 
 (set-record-type-printer! collection
   (lambda (record port)


@@ -56,46 +55,39 @@
 ;;; Working with documents
 
 (define (format-document document)
 ;;; Working with documents
 
 (define (format-document document)

-  "Return a vhash document ready to store in a collection"
+  "Return an alist document ready to store in a collection"

   (document-with-id
   (document-with-id

-   (cond ((vhash? document)
-         document)
+   (cond ((hash-table? document)
+         (hash-table->alist document))

         (else
         (else

-         (alist->vhash document)))))
+         document))))

 
 (define (document-with-id document)
   "Return always a document with an id"
 
 (define (document-with-id document)
   "Return always a document with an id"

-  (or (and (vhash-assoc '_id document)
+  (or (and (assoc '_id document)

           document)
           document)

-      (vhash-cons '_id (gensym) document)))
+      (assoc-set! document '_id (gensym))))

 
 (define (insert col . documents)
 
 (define (insert col . documents)

-  "Insert documents into the collection and return the new collection"
+  "Insert documents into the collection and return document ids"

   (cond ((null? documents)
   (cond ((null? documents)

-        (values col '()))
+        '())

        (else
         (let* ((document (format-document (car documents)))
        (else
         (let* ((document (format-document (car documents)))

-               (docid (cdr (vhash-assoc '_id document)))
-               (newcol (make-collection-record (vhash-cons docid document (get-table col)))))
-          (receive (rescol docids)
-              (apply insert (cons newcol (cdr documents)))
-            (values rescol (cons docid docids)))))))
+               (docid (assoc-ref document '_id)))
+          (hash-table-set! (get-table col) docid document)
+          (cons docid (apply insert (cons col (cdr documents))))))))

 
 (define (find col filter)
   "Query the collection and return the documents that match with filter"
 
 (define (find col filter)
   "Query the collection and return the documents that match with filter"

-  (map vhash->alist (inner-find col filter)))
-
-(define (inner-find col filter)
-  "Query the collection and return the documents that match with filter"
-  (let ((table (get-table col)))
-    (vhash-fold
-     (lambda (key document result)
-       (cond ((match-document? document filter)
-             (cons document result))
-            (else
-             result)))
-     '()
-     table)))
+  (hash-table-fold
+   (get-table col)
+   (lambda (key document result)
+     (cond ((match-document? document filter)
+           (cons document result))
+          (else
+           result)))
+   '()))

 
 (define (match-document? document filter)
   "Try to match the given document with a given filter"
 
 (define (match-document? document filter)
   "Try to match the given document with a given filter"


@@ -106,7 +98,7 @@
 
 (define (update col filter . changes)
   "Update selected documents using the given filter"
 
 (define (update col filter . changes)
   "Update selected documents using the given filter"

-  (let ((documents (inner-find col filter)))
+  (let ((documents (find col filter)))

     (apply insert (cons col (map (lambda (doc) (update-document doc changes)) documents)))))
 
 (define (update-document document changes)
     (apply insert (cons col (map (lambda (doc) (update-document doc changes)) documents)))))
 
 (define (update-document document changes)


@@ -121,13 +113,13 @@
 
 (define ($eq field value)
   (lambda (document)
 
 (define ($eq field value)
   (lambda (document)

-    (let ((stored (vhash-assoc field document)))
+    (let ((stored (assoc field document)))

       (and stored
           (equal? (cdr stored) value)))))
 
 (define ($exists field)
   (lambda (document)
       (and stored
           (equal? (cdr stored) value)))))
 
 (define ($exists field)
   (lambda (document)

-    (and (vhash-assoc field document)
+    (and (assoc field document)

         #t)))
 
 (define ($not expr)
         #t)))
 
 (define ($not expr)


@@ -146,13 +138,4 @@
 
 (define ($set field value)
   (lambda (document)
 
 (define ($set field value)
   (lambda (document)

-    (vhash-cons field value document)))
-
-            
-;;; Tools
-
-(define (vhash->alist vhash)
-  (vhash-fold-right
-   (lambda (key value result) (assoc-set! result key value))
-   '()
-   vhash))
+    (assoc-set! document field value)))

diff --git a/tests/sample.scm b/tests/sample.scm
index bd2cc6ef407a1de2acae76b126a25b661aff0edb..aeccc600e751a7684fc369767c6504c0184aa4cc 100644 (file)
--- a/tests/sample.scm
+++ b/tests/sample.scm
@@ -25,10 +25,10 @@
 (test-assert (collection? col))
 
 ; Insert
 (test-assert (collection? col))
 
 ; Insert

-(set! col (insert col
-                 '((a . 1) (b . 2))
-                 '((a . 10) (b . 20))
-                 '((a . 1) (c . "hello world"))))
+(insert col
+       '((a . 1) (b . 2))
+       '((a . 10) (b . 20))
+       '((a . 1) (c . "hello world")))

 (test-eqv 3 (count col))
 
 ; Search
 (test-eqv 3 (count col))
 
 ; Search


@@ -41,7 +41,7 @@
 (test-eqv 2 (length (find col ($not ($exists 'c)))))
 
 ; Update
 (test-eqv 2 (length (find col ($not ($exists 'c)))))
 
 ; Update

-(set! col (update col ($exists 'c) ($set 'c "test")))
+(update col ($exists 'c) ($set 'c "test"))

 (test-eqv 1 (length (find col ($eq 'c "test"))))
 
 (test-end "bongodb")
 (test-eqv 1 (length (find col ($eq 'c "test"))))
 
 (test-end "bongodb")