diff --git a/class.rkt b/class.rkt index 4f38dce..1df5502 100644 --- a/class.rkt +++ b/class.rkt @@ -56,5 +56,8 @@ (define/public (key-values) (ks-key-values ksh)) + + (define/public (with-lock proc) + (ks-with-lock ksh proc)) ) ) diff --git a/keystore.rkt b/keystore.rkt index 6d64c54..e0af688 100644 --- a/keystore.rkt +++ b/keystore.rkt @@ -27,8 +27,10 @@ ks-abort-transaction ) +(define (any? a) #t) + (define-struct keystore - (file path dbh) + (file path dbh lock-sem (in-lock #:mutable) (entered #:mutable)) #:transparent ) @@ -46,7 +48,7 @@ (let ((dbh (sqlite3-connect #:database path #:mode 'create))) (query-exec dbh "CREATE TABLE IF NOT EXISTS keystore(key varchar primary key, value varchar, str_key varchar);") (query-exec dbh "CREATE INDEX IF NOT EXISTS keystore_idx on keystore(str_key);") - (make-keystore file path dbh)))) + (make-keystore file path dbh (make-semaphore 1) #f 0)))) (define/contract (ks-close ksh) (-> keystore? boolean?) @@ -54,6 +56,27 @@ (disconnect dbh) #t)) +(define/contract (ks-with-lock ksh proc) + (-> keystore? procedure? any?) + (dynamic-wind + (λ () + (cond + ((eq? (keystore-in-lock ksh) (current-thread)) + (set-keystore-entered! ksh (+ keystore-entered ksh) 1)) + (else + (semaphore-wait (keystore-lock-sem ksh)) + (set-keystore-entered! ksh 1) + )) + (set-keystore-in-lock! ksh (current-thread))) + proc + (λ () + (set-keystore-entered! (- (keystore-entered ksh) 1)) + (when (= (keystore-entered ksh) 0) + (set-keystore-in-lock! ksh #f) + (semaphore-post (keystore-lock-sem ksh)))) + ) + ) + (define/contract (ks-set! ksh key value) (-> keystore? any/c any/c boolean?) (ks-set!* (keystore-dbh ksh) (key->string key) (format "~a" key) (value->string value))) diff --git a/scrbl/class.scrbl b/scrbl/class.scrbl index 517c9f4..124a663 100644 --- a/scrbl/class.scrbl +++ b/scrbl/class.scrbl @@ -83,6 +83,18 @@ Returns all keys. Returns all key-value pairs. } + +@defmethod[(with-lock [proc (-> any/c)]) any/c]{ + +Calls @racket[proc] while holding the lock belonging to this keystore +object and returns the value produced by @racket[proc]. Other threads +using @method[keystore% with-lock] on the same object wait until the lock is +released. + +The lock is reentrant for nested calls on the same thread and is +released when control leaves @racket[proc], including when an exception +is raised. Keystore methods do not acquire this lock automatically. +} } @section{Examples} @@ -115,4 +127,13 @@ Returns all key-value pairs. @racketblock[ (send ks glob "*b*") (send ks glob-kv "*b*") -] \ No newline at end of file +] + +@subsection{Locking} + +@racketblock[ +(send ks with-lock + (λ () + (send ks set! 'counter + (add1 (send ks get 'counter 0))))) +] diff --git a/scrbl/keystore.scrbl b/scrbl/keystore.scrbl index 6ae20e6..58a9ef5 100644 --- a/scrbl/keystore.scrbl +++ b/scrbl/keystore.scrbl @@ -19,11 +19,18 @@ stringified lowercase form, which allows glob-style queries. @defstruct*[keystore ([file any/c] [path path?] - [dbh any/c])]{ + [dbh any/c] + [lock-sem semaphore?] + [in-lock (or/c thread? #f)] + [entered exact-nonnegative-integer?])]{ Represents an open keystore. The @racket[file] field contains the original argument, @racket[path] is the resolved database path, and -@racket[dbh] is the SQLite connection. +@racket[dbh] is the SQLite connection. The remaining fields implement +the reentrant lock used by @racket[ks-with-lock]: @racket[lock-sem] +serializes access, @racket[in-lock] records the thread that holds the +lock, and @racket[entered] records that thread's nesting depth. The +@racket[in-lock] and @racket[entered] fields are mutable internal state. The @tt{keystore?} predicate is altered to also check if the database connection is (still) valid. @@ -149,7 +156,25 @@ Commits a transaction with "COMMIT". @defproc[(ks-abort-transaction [ks keystore?]) boolean?]{ Aborts a transaction with "ROLLBACK". -} +} + +@section{Locking} + +@defproc[(ks-with-lock [ks keystore?] [proc (-> any/c)]) any/c]{ + +Calls @racket[proc] while holding the lock belonging to @racket[ks] and +returns the value produced by @racket[proc]. Other threads using +@racket[ks-with-lock] with the same keystore handle wait until the lock +is released. + +The lock is reentrant: @racket[proc] may call @racket[ks-with-lock] +again on the same handle and thread. The lock is released when control +leaves @racket[proc], including when an exception is raised. + +The lock coordinates only code that uses the same keystore handle and +explicitly calls @racket[ks-with-lock]. Individual keystore operations +do not acquire it automatically. +} @section{Examples} @@ -180,4 +205,14 @@ Aborts a transaction with "ROLLBACK". @racketblock[ (ks-keys-glob ks "*b*") -] \ No newline at end of file +] + +@subsection{Locking Example} + +@racketblock[ +(ks-with-lock + ks + (λ () + (ks-set! ks 'counter + (add1 (ks-get ks 'counter 0))))) +]