lmdb

Check-in [d4ff8cd366]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:#:limit support for database-fold and friends
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: d4ff8cd3660c72e0e6574dea939725523c39eec03f1f951d6df5967be24310a1
User & Date: murphy 2018-09-01 16:02:10
Context
2018-09-01
16:30
Formatting tweaks check-in: ecd5bf87c6 user: murphy tags: trunk, v1.0.0
16:02
#:limit support for database-fold and friends check-in: d4ff8cd366 user: murphy tags: trunk
2018-08-25
12:58
Stale transaction cleanup check-in: b91e1e29c7 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to lmdb.scm.

492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
...
507
508
509
510
511
512
513
514

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593

(define-values (cursor-set-range cursor-first cursor-next)
  (values
   (foreign-value "MDB_SET_RANGE" int)
   (foreign-value "MDB_FIRST" int)
   (foreign-value "MDB_NEXT" int)))

(define (database-fold proc seed dbi #!key from to< to<=)
  (let-location ([cursor cursor #f])
    (check-error
     'database-fold
     ((foreign-lambda
       int "mdb_cursor_open"
       nonnull-transaction database (c-pointer cursor))
      (current-transaction) dbi (location cursor)))
................................................................................
    (let ([complete? #f])
      (dynamic-wind
        (lambda ()
          (when complete?
            (error 'database-fold "cannot re-enter cursor walk")))
        (lambda ()
          (let loop ([op (if from cursor-set-range cursor-first)]
                     [key from] [seed seed])

            (let-location ([klen size_t 0] [kptr c-pointer #f]
                           [vlen size_t 0] [vptr c-pointer #f])
              (let ([status
                     ((foreign-lambda*
                       int ([nonnull-cursor cursor] [int op]
                            [size_t k0len] [scheme-pointer k0ptr]
                            [size_t k1len] [scheme-pointer k1ptr]
                            [int inclusive]
                            [(c-pointer size_t) klen] [(c-pointer c-pointer) kptr]
                            [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr])
                       "int status;"
                       "MDB_val key0, key1, val;"
                       "key0.mv_size = k0len; key0.mv_data = k0ptr;"
                       "key1.mv_size = k1len; key1.mv_data = k1ptr;"
                       "val.mv_size = 0; val.mv_data = NULL;"
                       "status = mdb_cursor_get(cursor, &key0, &val, op);"
                       "if (status == 0 && key1.mv_data != NULL) {"
                       "  if (mdb_cmp(mdb_cursor_txn(cursor), mdb_cursor_dbi(cursor), &key0, &key1) >= inclusive) status = MDB_NOTFOUND;"
                       "}"
                       "if (status == 0) {"
                       "  *klen = key0.mv_size; *kptr = key0.mv_data;"
                       "  *vlen = val.mv_size; *vptr = val.mv_data;"
                       "}"
                       "C_return(status);")
                      cursor op
                      (blob/string-size key) key
                      (blob/string-size (or to< to<=)) (or to< to<=)
                      (if to< 0 1)
                      (location klen) (location kptr)
                      (location vlen) (location vptr))])
                (cond
                  [(zero? status)
                   (let ([key (make-string klen)]
                         [val (make-string vlen)])
                     (move-memory! kptr key klen)
                     (move-memory! vptr val vlen)
                     (loop cursor-next key (proc key val seed)))]
                  [(eqv? status not-found)
                   seed]
                  [else
                   (check-error 'database-ref status)])))))

        (lambda ()
          ((foreign-lambda
            void "mdb_cursor_close"
            nonnull-cursor)
           cursor)
          (set! complete? #t))))))

(define (database-walk proc dbi . args)
  (apply
   database-fold
   (lambda (key val seed) (proc key val) seed) (void)
   dbi args))

(define (database->alist dbi #!rest args #!key from to< to<=)
  (fold
   (lambda (key+val rest)
     (let ([val (cdr key+val)])
       (when (pair? val) (set-cdr! key+val (reverse! val))))
     (cons key+val rest))
   '()
   (database-fold
................................................................................
          (if (and (pair? rest) (equal? key (caar rest)))
              (begin
                (set-cdr! (car rest) (cons val (cdar rest)))
                rest)
              (cons (cons key (list val)) rest)))
        (lambda (key val rest)
          (cons (cons key val) rest)))
    '() dbi #:from from #:to< to< #:to<= to<=)))

(define (alist->database alist . args)
  (let-keys+flags open-database args
                  ([0 name #f])
                  ([database-flags dbi-flags]
                   [database-set!-flags set-flags])
    (let ([dbi (%open-database name dbi-flags)])







|







 







|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>













|







 







|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
...
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
...
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595

(define-values (cursor-set-range cursor-first cursor-next)
  (values
   (foreign-value "MDB_SET_RANGE" int)
   (foreign-value "MDB_FIRST" int)
   (foreign-value "MDB_NEXT" int)))

(define (database-fold proc seed dbi #!key from to< to<= limit)
  (let-location ([cursor cursor #f])
    (check-error
     'database-fold
     ((foreign-lambda
       int "mdb_cursor_open"
       nonnull-transaction database (c-pointer cursor))
      (current-transaction) dbi (location cursor)))
................................................................................
    (let ([complete? #f])
      (dynamic-wind
        (lambda ()
          (when complete?
            (error 'database-fold "cannot re-enter cursor walk")))
        (lambda ()
          (let loop ([op (if from cursor-set-range cursor-first)]
                     [key from] [seed seed] [fuel (or limit +inf.0)])
            (if (positive? fuel)
              (let-location ([klen size_t 0] [kptr c-pointer #f]
                             [vlen size_t 0] [vptr c-pointer #f])
                (let ([status
                       ((foreign-lambda*
                         int ([nonnull-cursor cursor] [int op]
                              [size_t k0len] [scheme-pointer k0ptr]
                              [size_t k1len] [scheme-pointer k1ptr]
                              [int inclusive]
                              [(c-pointer size_t) klen] [(c-pointer c-pointer) kptr]
                              [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr])
                         "int status;"
                         "MDB_val key0, key1, val;"
                         "key0.mv_size = k0len; key0.mv_data = k0ptr;"
                         "key1.mv_size = k1len; key1.mv_data = k1ptr;"
                         "val.mv_size = 0; val.mv_data = NULL;"
                         "status = mdb_cursor_get(cursor, &key0, &val, op);"
                         "if (status == 0 && key1.mv_data != NULL) {"
                         "  if (mdb_cmp(mdb_cursor_txn(cursor), mdb_cursor_dbi(cursor), &key0, &key1) >= inclusive) status = MDB_NOTFOUND;"
                         "}"
                         "if (status == 0) {"
                         "  *klen = key0.mv_size; *kptr = key0.mv_data;"
                         "  *vlen = val.mv_size; *vptr = val.mv_data;"
                         "}"
                         "C_return(status);")
                        cursor op
                        (blob/string-size key) key
                        (blob/string-size (or to< to<=)) (or to< to<=)
                        (if to< 0 1)
                        (location klen) (location kptr)
                        (location vlen) (location vptr))])
                  (cond
                    [(zero? status)
                     (let ([key (make-string klen)]
                           [val (make-string vlen)])
                       (move-memory! kptr key klen)
                       (move-memory! vptr val vlen)
                       (loop cursor-next key (proc key val seed) (sub1 fuel)))]
                    [(eqv? status not-found)
                     seed]
                    [else
                     (check-error 'database-ref status)])))
              seed)))
        (lambda ()
          ((foreign-lambda
            void "mdb_cursor_close"
            nonnull-cursor)
           cursor)
          (set! complete? #t))))))

(define (database-walk proc dbi . args)
  (apply
   database-fold
   (lambda (key val seed) (proc key val) seed) (void)
   dbi args))

(define (database->alist dbi #!rest args #!key from to< to<= limit)
  (fold
   (lambda (key+val rest)
     (let ([val (cdr key+val)])
       (when (pair? val) (set-cdr! key+val (reverse! val))))
     (cons key+val rest))
   '()
   (database-fold
................................................................................
          (if (and (pair? rest) (equal? key (caar rest)))
              (begin
                (set-cdr! (car rest) (cons val (cdar rest)))
                rest)
              (cons (cons key (list val)) rest)))
        (lambda (key val rest)
          (cons (cons key val) rest)))
    '() dbi #:from from #:to< to< #:to<= to<= #:limit limit)))

(define (alist->database alist . args)
  (let-keys+flags open-database args
                  ([0 name #f])
                  ([database-flags dbi-flags]
                   [database-set!-flags set-flags])
    (let ([dbi (%open-database name dbi-flags)])

Changes to lmdb.wiki.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205

206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228


229
230
231
232
233
234
235

The transaction is committed upon normal return from <tt>(THUNK)</tt>
and aborted if <tt>(THUNK)</tt> throws an exception.

<verbatim>
  (clear-stale-transactions [ENVIRONMENT]) => INTEGER
</verbatim>
 
Removes stale read-only transactions from the database lockfile (stale
read-write transactions are usually removed automatically). If no
<tt>ENVIRONMENT</tt> is specified explicitly, the current environment is used.

The procedure returns the number of stale lock file entries that were removed.

<h2>Databases</h2>
................................................................................
with one value per key, <tt>VALUE</tt> is ignored.

Database keys and values can be strings or blobs.

<verbatim>
  (database-fold
   PROC SEED DATABASE
   [#:from START] [#:to< | #:to<= LIMIT])
  =>
  (PROC KEY VALUE (... (PROC KEY VALUE SEED)))
</verbatim>

Folds over the records in the database. If <tt>START</tt> is given,
only fold over the records with keys greater or equal to
<tt>START</tt>. If <tt>LIMIT</tt> is given, only fold over the records
with keys less than (or equal) to <tt>LIMIT</tt>.


<verbatim>
  (database-walk
   PROC DATABASE
   [#:from START] [#:to< | #:to<= LIMIT])
  =>
  VOID
</verbatim>

Like <tt>database-fold</tt>, but discarding the result.

<verbatim>
  (database->alist
   DATABASE
   [#:from START] [#:to< | #:to<= LIMIT] [#:duplicate-list])
  =>
  ALIST
</verbatim>

Convert the records in the database to an association list. If
<tt>START</tt> is given, only list the records with keys greater or
equal to <tt>START</tt>. If <tt>LIMIT</tt> is given, only list the
records with keys less than (or equal) to <tt>LIMIT</tt>.



Optionally, multiple values for the same key may be folded into lists
rather than producing multiple pairs with the same key in the
association list.

<verbatim>
  (alist->database







|







 







|




|
|
|
|
>




|









|





|
|
|
>
>







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

The transaction is committed upon normal return from <tt>(THUNK)</tt>
and aborted if <tt>(THUNK)</tt> throws an exception.

<verbatim>
  (clear-stale-transactions [ENVIRONMENT]) => INTEGER
</verbatim>

Removes stale read-only transactions from the database lockfile (stale
read-write transactions are usually removed automatically). If no
<tt>ENVIRONMENT</tt> is specified explicitly, the current environment is used.

The procedure returns the number of stale lock file entries that were removed.

<h2>Databases</h2>
................................................................................
with one value per key, <tt>VALUE</tt> is ignored.

Database keys and values can be strings or blobs.

<verbatim>
  (database-fold
   PROC SEED DATABASE
   [#:from START] [#:to< | #:to<= STOP] [#:limit LIMIT])
  =>
  (PROC KEY VALUE (... (PROC KEY VALUE SEED)))
</verbatim>

Folds over the records in the database. If <tt>START</tt> is given, only
fold over the records with keys greater than or equal to <tt>START</tt>.
If <tt>STOP</tt> is given, only fold over the records with keys less
than (or equal) to <tt>STOP</tt>. If <tt>LIMIT</tt> is given, process at
most <tt>LIMIT</tt> records before stopping early.

<verbatim>
  (database-walk
   PROC DATABASE
   [#:from START] [#:to< | #:to<= STOP] [#:limit LIMIT])
  =>
  VOID
</verbatim>

Like <tt>database-fold</tt>, but discarding the result.

<verbatim>
  (database->alist
   DATABASE
   [#:from START] [#:to< | #:to<= STOP] [#:limit LIMIT] [#:duplicate-list])
  =>
  ALIST
</verbatim>

Convert the records in the database to an association list. If
<tt>START</tt> is given, only list the records with keys greater than or
equal to <tt>START</tt>. If <tt>STOP</tt> is given, only list the
records with keys less than (or equal) to <tt>STOP</tt>. If
<tt>LIMIT</tt> is given, process at most <tt>LIMIT</tt> records before
stopping early.

Optionally, multiple values for the same key may be folded into lists
rather than producing multiple pairs with the same key in the
association list.

<verbatim>
  (alist->database

Changes to tests/run.scm.

1
2
3
4
5
6
7
8
..
47
48
49
50
51
52
53



54
55
56



57
58



59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(import 
  lmdb test)

(test-assert "environment creation"
  (database-environment?
   (open-database-environment
    "test-env" #:max-databases 4)))

................................................................................
        "quirks" #:create #:duplicate-sort #:append/duplicate)))

(test-assert (database? quirks))

(with-transaction
 (lambda ()
   (test



     '(("bar" . "foo") ("baz" . "badumm") ("baz" . "kawumm"))
     (database->alist quirks #:from "b" #:to< "x"))
   (test



     '(("bar" "foo") ("baz" "badumm" "kawumm"))
     (database->alist quirks #:from "b" #:to< "x" #:duplicate-list))



   
   (database-delete! quirks "baz" "badumm")
   
   (test
     '(("baz" . "kawumm"))
     (database->alist quirks #:from "baz" #:to<= "baz"))
   
   (drop-database quirks)
   
   (test
     '()
     (database->alist quirks))))

(close-database-environment)

(test-exit)
|







 







>
>
>



>
>
>


>
>
>
|

|



|

|







1
2
3
4
5
6
7
8
..
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
(import
  lmdb test)

(test-assert "environment creation"
  (database-environment?
   (open-database-environment
    "test-env" #:max-databases 4)))

................................................................................
        "quirks" #:create #:duplicate-sort #:append/duplicate)))

(test-assert (database? quirks))

(with-transaction
 (lambda ()
   (test
     '()
     (database->alist quirks #:limit 0))
   (test
     '(("bar" . "foo") ("baz" . "badumm") ("baz" . "kawumm"))
     (database->alist quirks #:from "b" #:to< "x"))
   (test
     '(("bar" . "foo"))
     (database->alist quirks #:from "b" #:to< "x" #:limit 1))
   (test
     '(("bar" "foo") ("baz" "badumm" "kawumm"))
     (database->alist quirks #:from "b" #:to< "x" #:duplicate-list))
   (test
     '(("bar" "foo") ("baz" "badumm"))
     (database->alist quirks #:from "b" #:to< "x" #:limit 2 #:duplicate-list))

   (database-delete! quirks "baz" "badumm")

   (test
     '(("baz" . "kawumm"))
     (database->alist quirks #:from "baz" #:to<= "baz"))

   (drop-database quirks)

   (test
     '()
     (database->alist quirks))))

(close-database-environment)

(test-exit)