From: Javier Sancho Date: Fri, 27 Jan 2017 16:08:08 +0000 (+0100) Subject: Replace VHashes with Hash Tables X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=refs%2Fheads%2Fmaster;p=bongodb.git Replace VHashes with Hash Tables --- diff --git a/src/bongodb.scm b/src/bongodb.scm index 3e5dc68..24ced36 100644 --- a/src/bongodb.scm +++ b/src/bongodb.scm @@ -16,10 +16,9 @@ (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-69) #:export (make-collection collection? count @@ -41,10 +40,10 @@ (table get-table)) (define (make-collection) - (make-collection-record vlist-null)) + (make-collection-record (make-hash-table))) (define (count col) - (vlist-length (get-table col))) + (hash-table-size (get-table col))) (set-record-type-printer! collection (lambda (record port) @@ -56,46 +55,39 @@ ;;; 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 - (cond ((vhash? document) - document) + (cond ((hash-table? document) + (hash-table->alist document)) (else - (alist->vhash document))))) + document)))) (define (document-with-id document) "Return always a document with an id" - (or (and (vhash-assoc '_id document) + (or (and (assoc '_id document) document) - (vhash-cons '_id (gensym) document))) + (assoc-set! document '_id (gensym)))) (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) - (values col '())) + '()) (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" - (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" @@ -106,7 +98,7 @@ (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) @@ -121,13 +113,13 @@ (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 (vhash-assoc field document) + (and (assoc field document) #t))) (define ($not expr) @@ -146,13 +138,4 @@ (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 bd2cc6e..aeccc60 100644 --- a/tests/sample.scm +++ b/tests/sample.scm @@ -25,10 +25,10 @@ (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 @@ -41,7 +41,7 @@ (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")