lmdb

Check-in [85c0637f63]
Login

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

Overview
Comment:Initial binding of cursor operations
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 85c0637f632414077def5435101f191c5ccad54a4c1fb5e99522c7bf77cfcb7d
User & Date: murphy 2018-08-20 16:35:43
Context
2018-08-20
18:09
Set current-database-environment to #f when it is closed check-in: 9f4cd15298 user: murphy tags: trunk
16:35
Initial binding of cursor operations check-in: 85c0637f63 user: murphy tags: trunk
13:53
Database environment copy check-in: bf6e2af64e user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to lmdb.scm.

1
2
3
4
5
6
7
8
9
...
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
...
372
373
374
375
376
377
378
379
380
381
382
383
384

385
386

387
388
389
390
391
392
393
394
...
415
416
417
418
419
420
421

422
423
424
425
426
427
428
429
430
...
451
452
453
454
455
456
457

458



459



















































































460
(module lmdb
  * #;
  (database-environment?
   current-database-environment
   open-database-environment close-database-environment
   copy-database-environment
   with-transaction
   database?
   open-database close-database drop-database
................................................................................
  [#:no-sync "MDB_NOSYNC"]
  [#:map-async "MDB_MAPASYNC"]
  [#:no-lock "MDB_NOLOCK"]
  [#:no-read-ahead "MDB_NORDAHEAD"])

(define-values (no-tls no-subdirectory)
  (values
    (foreign-value "MDB_NOTLS" unsigned-int)
    (foreign-value "MDB_NOSUBDIR" unsigned-int)))

(define (open-database-environment path . args)
  (let-keys+flags open-database-environment args
                  ([#:mode mode #o666]
                   [#:max-databases maxdbs #f]
                   [#:max-readers maxreaders #f]
                   [#:max-size mapsize #f])
................................................................................
  [#:reverse-duplicate "MDB_REVERSEDUP"]
  [#:create "MDB_CREATE"])

(define (open-database . args)
  (let-keys+flags open-database args
                  ([0 name #f])
                  ([database-flags flags])
    (let-location ([dbi database])
      (check-error
       'open-database
       ((foreign-lambda
         int "mdb_dbi_open"
         nonnull-transaction c-string unsigned-int
         (nonnull-c-pointer database))
        (current-transaction) name flags (location dbi)))
................................................................................
  [#:no-overwrite "MDB_NOOVERWRITE"]
  [#:append "MDB_APPEND"]
  [#:append/duplicate "MDB_APPENDDUP"])

(define-values (database-ref database-set!)
  (letrec ([database-ref
            (lambda (dbi key #!optional [default (cut check-error 'database-ref not-found)])
              (let-location ([vlen size_t] [vptr c-pointer])
                (let ([status
                       ((foreign-lambda*
                         int ([nonnull-transaction txn] [database dbi]
                              [size_t klen] [scheme-pointer kptr]
                              [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr])

                         "MDB_val key, val;"
                         "key.mv_size = klen; key.mv_data = kptr;"

                         "int status = mdb_get(txn, dbi, &key, &val);"
                         "*vlen = val.mv_size; *vptr = val.mv_data;"
                         "C_return(status);")
                        (current-transaction) dbi
                        (blob/string-size key) key
                        (location vlen) (location vptr))])
                  (cond
                    [(zero? status)
................................................................................
                   "key.mv_size = klen; key.mv_data = kptr;"
                   "val.mv_size = vlen; val.mv_data = vptr;"
                   "C_return(mdb_put(txn, dbi, &key, &val, flags));")
                  (current-transaction) dbi
                  (blob/string-size key) key
                  (blob/string-size val) val
                  flags))))])

    (values (getter-with-setter database-ref database-set!)
            database-set!)))

(define (database-exists? dbi key)
  (let ([status
         ((foreign-lambda*
           int ([nonnull-transaction txn] [database dbi]
                [size_t klen] [scheme-pointer kptr])
           "MDB_val key, val;"
................................................................................
     "key.mv_size = klen; key.mv_data = kptr;"
     "val.mv_size = vlen; val.mv_data = vptr;"
     "C_return(mdb_del(txn, dbi, &key, &val));")
    (current-transaction) dbi
    (blob/string-size key) key
    (blob/string-size val) val)))


)























































































;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;

<







 







|
|







 







|







 







|





>


>
|







 







>
|
|







 







>
|
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1

2
3
4
5
6
7
8
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
...
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
...
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
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
(module lmdb

  (database-environment?
   current-database-environment
   open-database-environment close-database-environment
   copy-database-environment
   with-transaction
   database?
   open-database close-database drop-database
................................................................................
  [#:no-sync "MDB_NOSYNC"]
  [#:map-async "MDB_MAPASYNC"]
  [#:no-lock "MDB_NOLOCK"]
  [#:no-read-ahead "MDB_NORDAHEAD"])

(define-values (no-tls no-subdirectory)
  (values
   (foreign-value "MDB_NOTLS" unsigned-int)
   (foreign-value "MDB_NOSUBDIR" unsigned-int)))

(define (open-database-environment path . args)
  (let-keys+flags open-database-environment args
                  ([#:mode mode #o666]
                   [#:max-databases maxdbs #f]
                   [#:max-readers maxreaders #f]
                   [#:max-size mapsize #f])
................................................................................
  [#:reverse-duplicate "MDB_REVERSEDUP"]
  [#:create "MDB_CREATE"])

(define (open-database . args)
  (let-keys+flags open-database args
                  ([0 name #f])
                  ([database-flags flags])
    (let-location ([dbi database (wrap-database 0)])
      (check-error
       'open-database
       ((foreign-lambda
         int "mdb_dbi_open"
         nonnull-transaction c-string unsigned-int
         (nonnull-c-pointer database))
        (current-transaction) name flags (location dbi)))
................................................................................
  [#:no-overwrite "MDB_NOOVERWRITE"]
  [#:append "MDB_APPEND"]
  [#:append/duplicate "MDB_APPENDDUP"])

(define-values (database-ref database-set!)
  (letrec ([database-ref
            (lambda (dbi key #!optional [default (cut check-error 'database-ref not-found)])
              (let-location ([vlen size_t 0] [vptr c-pointer #f])
                (let ([status
                       ((foreign-lambda*
                         int ([nonnull-transaction txn] [database dbi]
                              [size_t klen] [scheme-pointer kptr]
                              [(c-pointer size_t) vlen] [(c-pointer c-pointer) vptr])
                         "int status;"
                         "MDB_val key, val;"
                         "key.mv_size = klen; key.mv_data = kptr;"
                         "val.mv_size = 0; val.mv_data = NULL;"
                         "status = mdb_get(txn, dbi, &key, &val);"
                         "*vlen = val.mv_size; *vptr = val.mv_data;"
                         "C_return(status);")
                        (current-transaction) dbi
                        (blob/string-size key) key
                        (location vlen) (location vptr))])
                  (cond
                    [(zero? status)
................................................................................
                   "key.mv_size = klen; key.mv_data = kptr;"
                   "val.mv_size = vlen; val.mv_data = vptr;"
                   "C_return(mdb_put(txn, dbi, &key, &val, flags));")
                  (current-transaction) dbi
                  (blob/string-size key) key
                  (blob/string-size val) val
                  flags))))])
    (values
     (getter-with-setter database-ref database-set!)
     database-set!)))

(define (database-exists? dbi key)
  (let ([status
         ((foreign-lambda*
           int ([nonnull-transaction txn] [database dbi]
                [size_t klen] [scheme-pointer kptr])
           "MDB_val key, val;"
................................................................................
     "key.mv_size = klen; key.mv_data = kptr;"
     "val.mv_size = vlen; val.mv_data = vptr;"
     "C_return(mdb_del(txn, dbi, &key, &val));")
    (current-transaction) dbi
    (blob/string-size key) key
    (blob/string-size val) val)))

;; Cursors

(define-foreign-tagged-type (cursor nonnull-cursor "MDB_cursor")
  cursor?
  tag:cursor)

(define close-cursor
  (foreign-lambda
   void "mdb_cursor_close"
   nonnull-cursor))

(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))

)

;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;