[functional-tests/btree] btree-walk-and-count + stop using a spine.
This commit is contained in:
parent
80d8a5b684
commit
29e92772a9
@ -7,6 +7,7 @@
|
|||||||
btree-open
|
btree-open
|
||||||
btree-lookup
|
btree-lookup
|
||||||
btree-each
|
btree-each
|
||||||
|
btree-each-and-count
|
||||||
le64-vt
|
le64-vt
|
||||||
|
|
||||||
define-value-type
|
define-value-type
|
||||||
@ -149,35 +150,46 @@
|
|||||||
default)))))))
|
default)))))))
|
||||||
|
|
||||||
;;;;----------------------------------------------
|
;;;;----------------------------------------------
|
||||||
;;;; Walking the btree
|
;;; Walk btree, counting metadata references
|
||||||
|
;;; (inc-fn <block>)
|
||||||
|
;;; (fn key value)
|
||||||
;;;;----------------------------------------------
|
;;;;----------------------------------------------
|
||||||
|
(define (btree-each-and-count tree cache fn inc-fn)
|
||||||
;;; Calls (fn key value) on every entry of the btree.
|
|
||||||
(define (btree-each tree sp fn)
|
|
||||||
(let ((vt (btree-value-type tree)))
|
(let ((vt (btree-value-type tree)))
|
||||||
|
|
||||||
(define (visit-leaf nr-entries keys vals)
|
(define (visit-leaf nr-entries keys vals)
|
||||||
(let loop ((index 0))
|
(let loop ((index 0))
|
||||||
(when (< index nr-entries)
|
(when (< index nr-entries)
|
||||||
(fn (key-at keys index) (vt 'ref vals index))
|
(fn (key-at keys index) (vt 'ref vals index))
|
||||||
(loop (+ 1 index)))))
|
(loop (+ 1 index)))))
|
||||||
|
|
||||||
(define (visit-internal nr-entries keys vals)
|
(define (visit-internal nr-entries keys vals)
|
||||||
(let loop ((index 0))
|
(let loop ((index 0))
|
||||||
(when (< index nr-entries)
|
(when (< index nr-entries)
|
||||||
(visit-node (le64-vt 'ref vals index))
|
(visit-node (le64-vt 'ref vals index))
|
||||||
(loop (+ 1 index)))))
|
(loop (+ 1 index)))))
|
||||||
|
|
||||||
(define (visit-node root)
|
(define (select-visitor header)
|
||||||
(spine-step sp (b root (get-flags))
|
(if (internal-node? header)
|
||||||
(let* ((header (block->header b))
|
visit-internal
|
||||||
(nr-entries (ftype-ref BTreeNodeHeader (nr-entries) header))
|
visit-leaf))
|
||||||
(keys (block->keys b))
|
|
||||||
(vals (block->values b vt)))
|
(define (visit-node bi)
|
||||||
((if (internal-node? header)
|
(with-block (b cache bi (get-flags))
|
||||||
visit-internal
|
(let* ((header (block->header b))
|
||||||
visit-leaf) nr-entries keys vals))))
|
(nr-entries (ftype-ref BTreeNodeHeader (nr-entries) header))
|
||||||
|
(keys (block->keys b))
|
||||||
|
(vals (block->values b vt)))
|
||||||
|
(inc-fn bi)
|
||||||
|
((select-visitor header) nr-entries keys vals))))
|
||||||
|
|
||||||
(visit-node (btree-root tree))))
|
(visit-node (btree-root tree))))
|
||||||
|
|
||||||
|
;;; Calls (fn key value) on every entry of the btree.
|
||||||
|
(define (btree-each tree cache fn)
|
||||||
|
(define (noop bi) 'nil)
|
||||||
|
|
||||||
|
(btree-each-and-count tree cache fn noop))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user