(pre-include-once
  string-h "string.h")

(pre-define (dg-mdb-declare-cursor name) (define name MDB-cursor* 0))
(pre-define (dg-mdb-compare-get-mv-data mdb-val) (struct-pointer-get mdb-val mv-data))

(pre-define (dg-mdb-cursor-close-2 a b)
  (mdb-cursor-close a)
  (mdb-cursor-close b))

(pre-define (dg-mdb-cursor-close-3 a b c)
  (dg-mdb-cursor-close-2 a b)
  (mdb-cursor-close c))

(define val-null MDB-val)

(pre-define (dg-mdb-cursor-get! cursor val-1 val-2 cursor-operation)
  ;only updates status, no goto on error
  (status-set-id (mdb-cursor-get cursor (address-of val-1) (address-of val-2) cursor-operation)))

(pre-define (dg-mdb-cursor-next-dup! cursor val-1 val-2)
  (dg-mdb-cursor-get! cursor val-1 val-2 MDB-NEXT-DUP))

(pre-define (dg-mdb-cursor-next-nodup! cursor val-1 val-2)
  (dg-mdb-cursor-get! cursor val-1 val-2 MDB-NEXT-NODUP))

(pre-define (dg-mdb-cursor-del! cursor flags) (status-set-id (mdb-cursor-del cursor flags)))

(pre-define (dg-mdb-declare-cursor-2 name-1 name-2)
  (dg-mdb-declare-cursor name-1)
  (dg-mdb-declare-cursor name-2))

(pre-define (dg-mdb-declare-cursor-3 name-1 name-2 name-3)
  (dg-mdb-declare-cursor-2 name-1 name-2)
  (dg-mdb-declare-cursor name-3))

(pre-define (dg-mdb-initialise-cursor txn name)
  (dg-mdb-status-require! (mdb-cursor-open txn (pre-concat dbi- name) (address-of name))))

(pre-define (dg-mdb-initialise-cursor-2 txn name-1 name-2)
  (dg-mdb-initialise-cursor txn name-1)
  (dg-mdb-initialise-cursor txn name-2))

(pre-define (dg-mdb-initialise-cursor-3 txn name-1 name-2 name-3)
  (dg-mdb-initialise-cursor-2 txn name-1 name-2)
  (dg-mdb-initialise-cursor txn name-3))

(pre-define (dg-mdb-introduce-cursor txn name)
  (dg-mdb-declare-cursor name)
  (dg-mdb-initialise-cursor txn name))

(pre-define (dg-mdb-introduce-cursor-2 txn name-1 name-2)
  (dg-mdb-declare-cursor-2 name-1 name-2)
  (dg-mdb-initialise-cursor-2 txn name-1 name-2))

(pre-define (dg-mdb-introduce-cursor-3 txn name-1 name-2 name-3)
  (dg-mdb-declare-cursor-3 name-1 name-2 name-3)
  (dg-mdb-initialise-cursor-3 txn name-1 name-2 name-3))

(pre-define (dg-mdb-val->id-at a index) (dg-pointer->id (struct-get a mv-data) index))
(pre-define (dg-mdb-val->id a) (dg-pointer->id (struct-get a mv-data) 0))

(pre-define (dg-mdb-introduce-val name size)
  (define name MDB-val)
  (struct-set name mv-size size))

(pre-define dg-mdb-introduce-val-id (dg-mdb-introduce-val val-id dg-size-octets-id))
(pre-define dg-mdb-introduce-val-id-2 (dg-mdb-introduce-val val-id-2 dg-size-octets-id))
(pre-define dg-mdb-introduce-val-id-3 (dg-mdb-introduce-val val-id-3 dg-size-octets-id))
(pre-define dg-mdb-introduce-val-data (define val-data MDB-val))
(pre-define dg-mdb-introduce-val-data-2 (define val-data-2 MDB-val))
(pre-define dg-mdb-reset-val-null (struct-set val-null mv-size 0))

(pre-define
  dg-mdb-introduce-val-relation-data (define val-relation-data MDB-val)
  (struct-set val-relation-data mv-size dg-size-octets-relation-data))

(pre-define
  dg-mdb-introduce-val-relation-key (define val-relation-key MDB-val)
  (struct-set val-relation-key mv-size dg-size-octets-relation-key))

(pre-define (dg-mdb-val-relation-data->id a) (dg-relation-data->id (struct-get a mv-data)))

(pre-define (dg-mdb-val-relation-data->ordinal a)
  (dg-relation-data->ordinal (struct-get a mv-data)))

(define (dg-mdb-compare-id a b) ((static int) (const MDB-val*) (const MDB-val*))
  ;"mdb comparison routines are used by lmdb for search, insert and delete"
  (return
    (dg-id-compare
      (dg-pointer->id (dg-mdb-compare-get-mv-data a) 0)
      (dg-pointer->id (dg-mdb-compare-get-mv-data b) 0))))

(define (dg-mdb-compare-relation-key a b) ((static int) (const MDB-val*) (const MDB-val*))
  (return
    (if* (< (dg-mdb-val->id-at (deref a) 0) (dg-mdb-val->id-at (deref b) 0))
      -1
      (if* (> (dg-mdb-val->id-at (deref a) 0) (dg-mdb-val->id-at (deref b) 0))
        1
        (if* (< (dg-mdb-val->id-at (deref a) 1) (dg-mdb-val->id-at (deref b) 1))
          -1 (> (dg-mdb-val->id-at (deref a) 1) (dg-mdb-val->id-at (deref b) 1)))))))

(define (dg-mdb-compare-relation-data a b) ((static int) (const MDB-val*) (const MDB-val*))
  ;memcmp does not work here, gives -1 for 256 vs 1.
  (return
    (if*
      (<
        (dg-mdb-val-relation-data->ordinal (deref a)) (dg-mdb-val-relation-data->ordinal (deref b)))
      -1
      (if*
        (>
          (dg-mdb-val-relation-data->ordinal (deref a)) (dg-mdb-val-relation-data->ordinal (deref b)))
        1
        (if* (< (dg-mdb-val-relation-data->id (deref a)) (dg-mdb-val-relation-data->id (deref b)))
          -1 (> (dg-mdb-val-relation-data->id (deref a)) (dg-mdb-val-relation-data->id (deref b))))))))

(define (dg-mdb-compare-data a b) ((static int) (const MDB-val*) (const MDB-val*))
  (define length-difference ssize-t
    (-
      (convert-type (struct-pointer-get a mv-size) ssize-t)
      (convert-type (struct-pointer-get b mv-size) ssize-t)))
  (return
    (if* length-difference
      (if* (< length-difference 0) -1 1)
      (memcmp
        (struct-pointer-get a mv-data) (struct-pointer-get b mv-data) (struct-pointer-get a mv-size)))))

(pre-define (dg-mdb-cursor-each-key cursor val-key val-value body)
  (dg-mdb-cursor-get! cursor val-key val-value MDB-FIRST)
  (while dg-mdb-status-success?
    body
    (dg-mdb-cursor-next-nodup! cursor val-key val-value))
  dg-mdb-status-require-notfound)

(pre-define (dg-mdb-cursor-set-first! cursor)
  (dg-mdb-status-require!
    (mdb-cursor-get cursor (address-of val-null) (address-of val-null) MDB-FIRST)))

(pre-define (dg-mdb-val->relation-key a) (convert-type (struct-get a mv-data) dg-id-t*))