Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Conversions between databases and association lists |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
6ef9d5e1d47dfd905a308eca9fec4da9 |
| User & Date: | murphy 2018-08-20 21:13:29 |
Context
|
2018-08-20
| ||
| 21:13 | Initial documentation check-in: 79aad68b11 user: murphy tags: trunk | |
| 21:13 | Conversions between databases and association lists check-in: 6ef9d5e1d4 user: murphy tags: trunk | |
| 18:09 | Set current-database-environment to #f when it is closed check-in: 9f4cd15298 user: murphy tags: trunk | |
Changes
Changes to lmdb.scm.
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ... 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 ... 370 371 372 373 374 375 376 377 378 379 380 381 382 383 ... 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 ... 542 543 544 545 546 547 548 549 550 551 552 |
current-database-environment open-database-environment close-database-environment copy-database-environment with-transaction database? open-database close-database drop-database database-ref database-set! database-exists? database-delete! database-fold database-walk) (import scheme (chicken base) (chicken blob) (chicken fixnum) (chicken keyword) ................................................................................ [#:reverse-key "MDB_REVERSEKEY"] [#:duplicate-sort "MDB_DUPSORT"] [#:integer-key "MDB_INTEGERKEY"] [#:duplicate-fixed "MDB_DUPFIXED"] [#:integer-duplicate "MDB_INTEGERDUP"] [#: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))) dbi))) (define (close-database dbi #!optional [env (current-database-environment)]) ((foreign-lambda void "mdb_dbi_close" nonnull-database-environment database) env dbi)) ................................................................................ [else 0])) (define-foreign-enum-argconvert (database-set!-flags unsigned-int) [#:no-duplicate "MDB_NODUPDATA"] [#: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* ................................................................................ [else (check-error 'database-ref status)]))))] [database-set! (lambda (dbi key val . args) (let-keys+flags database-set! args () ([database-set!-flags flags]) (check-error 'database-set! ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr] [size_t vlen] [scheme-pointer vptr] [unsigned-int flags]) "MDB_val key, val;" "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* ................................................................................ (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: ;; |
| > > > > > > > > > > > > < < | < < < < < < > > > > > > > > > > > > > > > > > < | < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > |
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 ... 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 ... 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 ... 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 ... 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 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 |
current-database-environment open-database-environment close-database-environment copy-database-environment with-transaction database? open-database close-database drop-database database-ref database-set! database-exists? database-delete! database-fold database-walk database->alist alist->database) (import scheme (chicken base) (chicken blob) (chicken fixnum) (chicken keyword) ................................................................................ [#:reverse-key "MDB_REVERSEKEY"] [#:duplicate-sort "MDB_DUPSORT"] [#:integer-key "MDB_INTEGERKEY"] [#:duplicate-fixed "MDB_DUPFIXED"] [#:integer-duplicate "MDB_INTEGERDUP"] [#:reverse-duplicate "MDB_REVERSEDUP"] [#:create "MDB_CREATE"]) (define (%open-database name 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))) dbi)) (define (open-database . args) (let-keys+flags open-database args ([0 name #f]) ([database-flags flags]) (%open-database name flags))) (define (close-database dbi #!optional [env (current-database-environment)]) ((foreign-lambda void "mdb_dbi_close" nonnull-database-environment database) env dbi)) ................................................................................ [else 0])) (define-foreign-enum-argconvert (database-set!-flags unsigned-int) [#:no-duplicate "MDB_NODUPDATA"] [#:no-overwrite "MDB_NOOVERWRITE"] [#:append "MDB_APPEND"] [#:append/duplicate "MDB_APPENDDUP"]) (define (%database-set! dbi key val flags) (check-error 'database-set! ((foreign-lambda* int ([nonnull-transaction txn] [database dbi] [size_t klen] [scheme-pointer kptr] [size_t vlen] [scheme-pointer vptr] [unsigned-int flags]) "MDB_val key, val;" "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))) (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* ................................................................................ [else (check-error 'database-ref status)]))))] [database-set! (lambda (dbi key val . args) (let-keys+flags database-set! args () ([database-set!-flags flags]) (%database-set! dbi key val flags)))]) (values (getter-with-setter database-ref database-set!) database-set!))) (define (database-exists? dbi key) (let ([status ((foreign-lambda* ................................................................................ (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<=) (reverse! (database-fold (if (memq #:duplicate-list args) (lambda (key val rest) (if (pair? rest) (if (equal? key (caar rest)) (begin (set-cdr! (car rest) (cons val (cdar rest))) rest) (begin (set-cdr! (car rest) (reverse! (cdar rest))) (cons (cons key (list val)) 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)]) (handle-exceptions exn (begin (close-database dbi) (abort exn)) (for-each (lambda (key+val) (let ([key (car key+val)] [val (cdr key+val)]) (if (list? val) (for-each (cut %database-set! dbi key <> set-flags) val) (%database-set! dbi key val set-flags)))) alist)) dbi))) ) ;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;; |