(pre-define (dg-index-errors-relation-log message left right label)
  (dg-error-log
    "(groups index relation) (description \"%s\") (left %lu) (right %lu) (label %lu)"
    message left right label))

(pre-define (dg-index-errors-data-log message type id)
  (dg-error-log "(groups index %s) (description %s) (id %lu)" type message id))

(define (dg-index-recreate-relation) status-t
  status-init
  dg-mdb-introduce-val-relation-key
  dg-mdb-introduce-val-relation-data
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-id-2
  (dg-define-relation-data relation-data)
  (dg-define-relation-key relation-key)
  (dg-mdb-declare-cursor-3 left->right right->left label->left)
  dg-txn-introduce
  dg-txn-write-begin
  (dg-mdb-status-require! (mdb-drop dg-txn dbi-right->left 0))
  (dg-mdb-status-require! (mdb-drop dg-txn dbi-label->left 0))
  dg-txn-commit
  dg-txn-write-begin
  (dg-mdb-initialise-cursor-3 dg-txn left->right right->left label->left)
  (define
    id-left dg-id-t
    id-right dg-id-t
    id-label dg-id-t)
  (dg-mdb-cursor-each-key
    left->right
    val-relation-key
    val-relation-data
    (compound-statement
      (set
        id-left (dg-mdb-val->id-at val-relation-key 0)
        id-label (dg-mdb-val->id-at val-relation-key 1))
      (do-while dg-mdb-status-success?
        (set id-right (dg-mdb-val-relation-data->id val-relation-data))
        ;create right->left
        (array-set-index relation-key 0 id-right 1 id-label)
        (struct-set val-relation-key mv-data relation-key)
        (struct-set val-id mv-data (address-of id-left))
        (dg-mdb-status-require!
          (mdb-cursor-put right->left (address-of val-relation-key) (address-of val-id) 0))
        ;create label->left
        (struct-set val-id-2 mv-data (address-of id-label))
        (dg-mdb-status-require!
          (mdb-cursor-put label->left (address-of val-id-2) (address-of val-id) 0))
        (dg-mdb-cursor-next-dup! left->right val-relation-key val-relation-data))))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (dg-index-recreate-intern) status-t
  status-init
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-data
  (dg-mdb-declare-cursor-2 id->data data-intern->id)
  dg-txn-introduce
  dg-txn-write-begin
  (mdb-drop dg-txn dbi-data-intern->id 0)
  dg-txn-commit
  dg-txn-write-begin
  (dg-mdb-initialise-cursor-2 dg-txn id->data data-intern->id)
  (dg-mdb-cursor-each-key
    id->data
    val-id
    val-data
    (compound-statement
      (if (and (struct-get val-data mv-size) (dg-intern? (dg-mdb-val->id val-id)))
        (dg-mdb-status-require!
          (mdb-cursor-put data-intern->id (address-of val-data) (address-of val-id) 0)))))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (dg-index-recreate-extern) status-t
  status-init
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-data
  (dg-mdb-declare-cursor id->data)
  (dg-mdb-declare-cursor data-intern->id)
  dg-txn-introduce
  dg-txn-write-begin
  (mdb-drop dg-txn dbi-data-intern->id 0)
  dg-txn-commit
  dg-txn-write-begin
  (dg-mdb-initialise-cursor dg-txn id->data)
  (dg-mdb-initialise-cursor dg-txn data-intern->id)
  (dg-mdb-cursor-each-key
    id->data
    val-id
    val-data
    (compound-statement
      (if (and (struct-get val-data mv-size) (dg-intern? (dg-mdb-val->id val-id)))
        (dg-mdb-status-require!
          (mdb-cursor-put data-intern->id (address-of val-data) (address-of val-id) 0)))))
  dg-txn-commit
  (label exit
    (if dg-txn dg-txn-abort)
    (return status)))

(define (dg-index-errors-relation dg-txn result) (status-t dg-txn-t* dg-index-errors-relation-t*)
  status-init
  (set (deref result) dg-index-errors-relation-null)
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-id-2
  dg-mdb-introduce-val-relation-key
  dg-mdb-introduce-val-relation-data
  (define
    id-right dg-id-t
    id-left dg-id-t
    id-label dg-id-t
    records-temp dg-relation-records-t*
    record dg-relation-record-t)
  (dg-define-relation-key relation-key)
  (dg-define-relation-data relation-data)
  (dg-mdb-introduce-cursor-3 dg-txn left->right right->left label->left)
  ;left->right
  (dg-mdb-cursor-each-key
    left->right
    val-relation-key
    val-relation-data
    (compound-statement
      (set
        id-left (dg-mdb-val->id-at val-relation-key 0)
        id-label (dg-mdb-val->id-at val-relation-key 1))
      (do-while dg-mdb-status-success?
        (set id-right (dg-mdb-val-relation-data->id val-relation-data))
        ;-> right->left
        (array-set-index relation-key 0 id-right 1 id-label)
        (struct-set val-relation-key mv-data relation-key)
        (struct-set val-id mv-data (address-of id-left))
        (dg-mdb-cursor-get! right->left val-relation-key val-id MDB-SET-KEY)
        (dg-mdb-cursor-get! right->left val-relation-key val-id MDB-GET-BOTH)
        (if dg-mdb-status-failure?
          (if (= MDB-NOTFOUND status.id)
            (begin
              (dg-index-errors-relation-log
                "entry from left->right not in right->left" id-left id-right id-label)
              (struct-pointer-set result errors? #t)
              (struct-set record left id-left right id-right label id-label)
              (dg-relation-records-add!
                (struct-pointer-get result missing-right-left) record records-temp))
            status-goto))
        ;-> label->left
        (struct-set val-id-2 mv-data (address-of id-label))
        (dg-mdb-cursor-get! label->left val-id-2 val-id MDB-GET-BOTH)
        (if (not dg-mdb-status-success?)
          (if (= MDB-NOTFOUND status.id)
            (begin
              (dg-index-errors-relation-log
                "entry from left->right not in label->left" id-left id-right id-label)
              (struct-pointer-set result errors? #t)
              (struct-set record left id-left right id-right label id-label)
              (dg-relation-records-add!
                (struct-pointer-get result missing-label-left) record records-temp))
            status-goto))
        (dg-mdb-cursor-next-dup! left->right val-relation-key val-relation-data))))
  ;right->left -> left->right
  (dg-mdb-cursor-each-key
    right->left
    val-relation-key
    val-id
    (compound-statement
      (set
        id-right (dg-mdb-val->id-at val-relation-key 0)
        id-label (dg-mdb-val->id-at val-relation-key 1))
      (do-while dg-mdb-status-success?
        (set id-left (dg-mdb-val->id val-id))
        (array-set-index relation-key 0 id-left 1 id-label)
        (struct-set val-relation-key mv-data relation-key)
        (dg-mdb-cursor-get! left->right val-relation-key val-relation-data MDB-SET-KEY)
        (if dg-mdb-status-success?
          (set status (dg-mdb-left->right-seek-right left->right id-right)))
        (if (not dg-mdb-status-success?)
          (if (= MDB-NOTFOUND status.id)
            (begin
              (dg-index-errors-relation-log
                "entry from right->left not in left->right" id-left id-right id-label)
              (struct-pointer-set result errors? #t)
              (struct-set record left id-left right id-right label id-label)
              (dg-relation-records-add!
                (struct-pointer-get result excess-right-left) record records-temp))
            status-goto))
        (dg-mdb-cursor-next-dup! right->left val-relation-key val-id))))
  ;label->left -> left->right
  (dg-mdb-cursor-each-key
    label->left
    val-id
    val-id-2
    (compound-statement
      (set id-label (dg-mdb-val->id val-id))
      (do-while dg-mdb-status-success?
        (set id-left (dg-mdb-val->id val-id-2))
        (array-set-index relation-key 0 id-left 1 id-label)
        (struct-set val-relation-key mv-data relation-key)
        (dg-mdb-cursor-get! left->right val-relation-key val-relation-data MDB-SET)
        (if (not dg-mdb-status-success?)
          (if (= MDB-NOTFOUND status.id)
            (begin
              (dg-index-errors-relation-log
                "entry from label->left not in left->right" id-left id-right id-label)
              (struct-pointer-set result errors? #t)
              (struct-set record left id-left right 0 label id-label)
              (dg-relation-records-add!
                (struct-pointer-get result excess-label-left) record records-temp))
            status-goto))
        (dg-mdb-cursor-next-dup! label->left val-id val-id-2))))
  dg-status-success-if-mdb-notfound
  (label exit
    (dg-mdb-cursor-close-3 left->right right->left label->left)
    (return status)))

(define (dg-index-errors-intern txn result) (status-t dg-txn-t* dg-index-errors-intern-t*)
  status-init
  (set (deref result) dg-index-errors-intern-null)
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-data
  dg-mdb-introduce-val-data-2
  (dg-mdb-introduce-cursor-2 txn data-intern->id id->data)
  (define ids-temp dg-ids-t*)
  ;index->main-tree comparison
  (dg-mdb-cursor-each-key
    data-intern->id
    val-data
    val-id
    (compound-statement
      (dg-mdb-cursor-get! id->data val-id val-data-2 MDB-SET-KEY)
      (if dg-mdb-status-success?
        (begin
          ;compare data
          (if (dg-mdb-compare-data (address-of val-data) (address-of val-data-2))
            (begin
              (dg-index-errors-data-log
                "intern" "data from data-intern->id differs in id->data" (dg-mdb-val->id val-id))
              (struct-pointer-set result errors? #t)
              (dg-ids-add!
                (struct-pointer-get result different-data-id) (dg-mdb-val->id val-id) ids-temp))))
        (if (= MDB-NOTFOUND status.id)
          (begin
            (dg-index-errors-data-log
              "intern" "data from data-intern->id not in id->data" (dg-mdb-val->id val-id))
            (struct-pointer-set result errors? #t)
            (dg-ids-add!
              (struct-pointer-get result excess-data-id) (dg-mdb-val->id val-id) ids-temp))
          status-goto))))
  ;main-tree->index comparison
  dg-mdb-introduce-val-id-2
  (dg-mdb-cursor-each-key
    id->data
    val-id
    val-data
    (compound-statement
      (if (dg-intern? (dg-mdb-val->id val-id))
        (begin
          (dg-mdb-cursor-get! data-intern->id val-data val-id-2 MDB-SET-KEY)
          (if dg-mdb-status-success?
            (if (not (dg-id-equal? (dg-mdb-val->id val-id) (dg-mdb-val->id val-id-2)))
              (begin
                (dg-index-errors-data-log
                  "intern" "data from id->data differs in data-intern->id" (dg-mdb-val->id val-id))
                (struct-pointer-set result errors? #t)
                (dg-ids-add!
                  (struct-pointer-get result different-id-data) (dg-mdb-val->id val-id) ids-temp)))
            (if (= MDB-NOTFOUND status.id)
              (begin
                (dg-index-errors-data-log
                  "intern" "data from id->data not in data-intern->id" (dg-mdb-val->id val-id-2))
                (struct-pointer-set result errors? #t)
                (dg-ids-add!
                  (struct-pointer-get result missing-id-data) (dg-mdb-val->id val-id-2) ids-temp))
              status-goto))))))
  dg-status-success-if-mdb-notfound
  (label exit
    (dg-mdb-cursor-close-2 id->data data-intern->id)
    (return status)))

(define (dg-index-errors-extern txn result) (status-t dg-txn-t* dg-index-errors-extern-t*)
  status-init
  (set (deref result) dg-index-errors-extern-null)
  dg-mdb-introduce-val-id
  dg-mdb-introduce-val-data
  dg-mdb-introduce-val-data-2
  (define ids-temp dg-ids-t*)
  (dg-mdb-declare-cursor-2 id->data data-extern->extern)
  (dg-mdb-initialise-cursor-2 txn id->data data-extern->extern)
  ;index->main-tree comparison
  (dg-mdb-cursor-each-key
    data-extern->extern
    val-data
    val-id
    (compound-statement
      (if (struct-get val-data mv-size)
        (begin
          (dg-mdb-cursor-get! id->data val-id val-data-2 MDB-SET-KEY)
          (if dg-mdb-status-success?
            (begin
              ;different data
              (if (dg-mdb-compare-data (address-of val-data) (address-of val-data-2))
                (begin
                  (dg-index-errors-data-log
                    "extern"
                    "data from data-extern->extern differs in id->data" (dg-mdb-val->id val-id))
                  (struct-pointer-set result errors? #t)
                  (dg-ids-add!
                    (struct-pointer-get result different-data-extern)
                    (dg-mdb-val->id val-id) ids-temp))))
            (if (= MDB-NOTFOUND status.id)
              (begin
                (dg-index-errors-data-log
                  "extern" "data from data-extern->extern not in id->data" (dg-mdb-val->id val-id))
                (struct-pointer-set result errors? #t)
                (dg-ids-add!
                  (struct-pointer-get result excess-data-extern) (dg-mdb-val->id val-id) ids-temp))
              status-goto))))))
  ;main-tree->index comparison
  (dg-mdb-cursor-each-key
    id->data
    val-id
    val-data
    (compound-statement
      (if (and (dg-extern? (dg-mdb-val->id val-id)) (struct-get val-data mv-size))
        (begin
          (dg-mdb-cursor-get! data-extern->extern val-data val-id MDB-GET-BOTH)
          (if (= MDB-NOTFOUND status.id)
            (begin
              (dg-index-errors-data-log
                "extern" "data from id->data not in data-extern->extern" (dg-mdb-val->id val-id))
              (struct-pointer-set result errors? #t)
              (dg-ids-add!
                (struct-pointer-get result missing-id-data) (dg-mdb-val->id val-id) ids-temp))
            status-goto)))))
  dg-status-success-if-mdb-notfound
  (label exit
    (dg-mdb-cursor-close-2 id->data data-extern->extern)
    (return status)))