f1f91468aa
Some checks are pending
CI / test (push) Waiting to run
CI / native-build (macos-latest) (push) Waiting to run
CI / native-build (ubuntu-latest) (push) Waiting to run
CI / native-build (windows-latest) (push) Waiting to run
CI / native-msrv (macos-latest) (push) Waiting to run
CI / native-msrv (ubuntu-latest) (push) Waiting to run
CI / native-msrv (windows-latest) (push) Waiting to run
527 lines
24 KiB
EmacsLisp
527 lines
24 KiB
EmacsLisp
;;; ebox-child-range.el --- Persistent child sequence core -*- lexical-binding: t; -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; Immutable weighted segment and key tries for future child Range integration.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'subr-x)
|
|
|
|
(cl-defstruct (ebox-child-range--metrics
|
|
(:constructor ebox-child-range--make-metrics))
|
|
(segment-visits 0) (segment-copies 0) (ref-index-visits 0)
|
|
(ref-index-copies 0) (key-visits 0) (key-copies 0)
|
|
(collision-visits 0) (collision-copies 0)
|
|
(old-affected-payload-visits 0) (new-payload-validations 0)
|
|
(new-payload-copies 0) (new-payload-visits 0)
|
|
(unaffected-payload-visits 0) (unaffected-payload-validations 0)
|
|
(unaffected-payload-copies 0))
|
|
|
|
(cl-defstruct (ebox-child-range--segment
|
|
(:constructor ebox-child-range--make-segment))
|
|
ref payload keys)
|
|
|
|
(cl-defstruct (ebox-child-range--segment-node
|
|
(:constructor ebox-child-range--make-segment-node))
|
|
children value weight segment-count)
|
|
|
|
(cl-defstruct (ebox-child-range--hash-node
|
|
(:constructor ebox-child-range--make-hash-node))
|
|
children bucket)
|
|
|
|
(cl-defstruct (ebox-child-range--sequence
|
|
(:constructor ebox-child-range--make-sequence))
|
|
root height count ref-index key-root hash-function)
|
|
|
|
(cl-defstruct (ebox-child-range--descriptor
|
|
(:constructor ebox-child-range--make-descriptor))
|
|
ref items)
|
|
|
|
(defun ebox-child-range--metric-add (metrics slot &optional amount)
|
|
"Increment METRICS SLOT by AMOUNT, defaulting to one."
|
|
(setf (cl-struct-slot-value 'ebox-child-range--metrics slot metrics)
|
|
(+ (or (cl-struct-slot-value 'ebox-child-range--metrics slot metrics) 0)
|
|
(or amount 1))))
|
|
|
|
(defun ebox-child-range--height (count)
|
|
"Return the base-32 trie height needed for COUNT segments."
|
|
(let ((height 0) (capacity 1))
|
|
(while (> count capacity)
|
|
(setq height (1+ height) capacity (* capacity 32)))
|
|
height))
|
|
|
|
(defun ebox-child-range--digit (index level)
|
|
"Return INDEX's five-bit digit at LEVEL."
|
|
(logand 31 (ash index (* -5 level))))
|
|
|
|
(defun ebox-child-range--segment-insert (node height index value)
|
|
"Persistently insert VALUE at INDEX below NODE of HEIGHT."
|
|
(if (= height 0)
|
|
(ebox-child-range--make-segment-node
|
|
:value value :weight (length (ebox-child-range--segment-payload value))
|
|
:segment-count 1)
|
|
(let* ((slot (ebox-child-range--digit index (1- height)))
|
|
(children (copy-sequence
|
|
(or (and node (ebox-child-range--segment-node-children node))
|
|
(make-vector 32 nil))))
|
|
(old (aref children slot))
|
|
(new (if (= height 1)
|
|
(ebox-child-range--make-segment-node
|
|
:value value :weight (length (ebox-child-range--segment-payload value))
|
|
:segment-count 1)
|
|
(ebox-child-range--segment-insert old (1- height) index value))))
|
|
(aset children slot new)
|
|
(ebox-child-range--make-segment-node
|
|
:children children
|
|
:weight (cl-loop for child across children when child
|
|
sum (ebox-child-range--segment-node-weight child))
|
|
:segment-count (cl-loop for child across children when child
|
|
sum (ebox-child-range--segment-node-segment-count child))))))
|
|
|
|
(defun ebox-child-range--segment-at (sequence index)
|
|
"Return SEQUENCE segment at INDEX."
|
|
(unless (and (integerp index) (<= 0 index)
|
|
(< index (ebox-child-range--sequence-count sequence)))
|
|
(signal 'args-out-of-range (list index)))
|
|
(let ((node (ebox-child-range--sequence-root sequence))
|
|
(height (ebox-child-range--sequence-height sequence)))
|
|
(while (> height 0)
|
|
(setq node (aref (ebox-child-range--segment-node-children node)
|
|
(ebox-child-range--digit index (1- height)))
|
|
height (1- height)))
|
|
(ebox-child-range--segment-node-value node)))
|
|
|
|
(defun ebox-child-range--segment-replace (node height index value metrics)
|
|
"Return `(NEW-NODE . OLD-SEGMENT)' below NODE of HEIGHT at INDEX.
|
|
VALUE is the replacement segment and METRICS records all path work."
|
|
(ebox-child-range--metric-add metrics 'segment-visits)
|
|
(ebox-child-range--metric-add metrics 'segment-copies)
|
|
(if (= height 0)
|
|
(cons (ebox-child-range--make-segment-node
|
|
:value value
|
|
:weight (length (ebox-child-range--segment-payload value))
|
|
:segment-count 1)
|
|
(ebox-child-range--segment-node-value node))
|
|
(let* ((slot (ebox-child-range--digit index (1- height)))
|
|
(children (copy-sequence
|
|
(ebox-child-range--segment-node-children node)))
|
|
(old (aref children slot))
|
|
result new old-segment)
|
|
(if (= height 1)
|
|
(progn
|
|
(ebox-child-range--metric-add metrics 'segment-visits)
|
|
(ebox-child-range--metric-add metrics 'segment-copies)
|
|
(setq old-segment (ebox-child-range--segment-node-value old)
|
|
new (ebox-child-range--make-segment-node
|
|
:value value
|
|
:weight (length (ebox-child-range--segment-payload value))
|
|
:segment-count 1)))
|
|
(setq result (ebox-child-range--segment-replace
|
|
old (1- height) index value metrics)
|
|
new (car result)
|
|
old-segment (cdr result)))
|
|
(aset children slot new)
|
|
(cons
|
|
(ebox-child-range--make-segment-node
|
|
:children children
|
|
:weight (cl-loop for child across children when child
|
|
sum (ebox-child-range--segment-node-weight child))
|
|
:segment-count (ebox-child-range--segment-node-segment-count node))
|
|
old-segment))))
|
|
|
|
(defun ebox-child-range--stable-hash (key)
|
|
"Return KEY's stable unsigned 32-bit hash."
|
|
(logand #xffffffff (sxhash-equal key)))
|
|
|
|
(defun ebox-child-range--bucket-find (bucket key metrics)
|
|
"Return KEY entry in collision BUCKET and count METRICS comparisons."
|
|
(let (found)
|
|
(while bucket
|
|
(ebox-child-range--metric-add metrics 'collision-visits)
|
|
(when (equal key (caar bucket)) (setq found (car bucket)))
|
|
(setq bucket (cdr bucket)))
|
|
found))
|
|
|
|
(defun ebox-child-range--hash-change
|
|
(node key value hash depth remove-p metrics)
|
|
"Persistently change KEY in sparse hash NODE using HASH at DEPTH."
|
|
(if (= depth 7)
|
|
(let* ((source (and node (ebox-child-range--hash-node-bucket node)))
|
|
(found (ebox-child-range--bucket-find source key metrics))
|
|
(bucket (copy-sequence source)))
|
|
(ebox-child-range--metric-add metrics 'collision-copies
|
|
(length source))
|
|
(cond
|
|
(remove-p
|
|
(ebox-child-range--make-hash-node
|
|
:bucket (cl-delete key bucket :key #'car :test #'equal)))
|
|
(found (error "Ebox child key is not unique: %S" key))
|
|
(t (ebox-child-range--make-hash-node
|
|
:bucket (cons (cons key value) bucket)))))
|
|
(ebox-child-range--metric-add metrics 'key-visits)
|
|
(ebox-child-range--metric-add metrics 'key-copies)
|
|
(let* ((slot (logand 31 (ash hash (* -5 depth))))
|
|
(children (copy-sequence (and node
|
|
(ebox-child-range--hash-node-children
|
|
node))))
|
|
(old (cdr (assq slot children)))
|
|
(new (ebox-child-range--hash-change
|
|
old key value hash (1+ depth) remove-p metrics)))
|
|
(setq children (cons (cons slot new) (assq-delete-all slot children)))
|
|
(ebox-child-range--make-hash-node :children children))))
|
|
|
|
(defun ebox-child-range--hash-lookup (root key hash)
|
|
"Look up KEY with HASH in ROOT."
|
|
(let ((node root) (depth 0))
|
|
(while (< depth 7)
|
|
(setq node (and node
|
|
(cdr (assq (logand 31 (ash hash (* -5 depth)))
|
|
(ebox-child-range--hash-node-children node))))
|
|
depth (1+ depth)))
|
|
(cdr (assoc key (and node (ebox-child-range--hash-node-bucket node))
|
|
#'equal))))
|
|
|
|
(defun ebox-child-range--item-copy (item metrics &optional retain-identity-p)
|
|
"Validate declarative ITEM while recording METRICS.
|
|
Return ITEM itself when RETAIN-IDENTITY-P is non-nil; otherwise return a
|
|
shallow copy owned by the persistent sequence."
|
|
(when (ebox-child-range--descriptor-p item)
|
|
(error "Nested child Range descriptors are reserved"))
|
|
(unless (and (listp item) (not (stringp item)))
|
|
(error "Ebox child Range item must be one declarative node"))
|
|
(ebox-child-range--metric-add metrics 'new-payload-validations)
|
|
(ebox-child-range--metric-add metrics 'new-payload-visits)
|
|
(if retain-identity-p
|
|
item
|
|
(ebox-child-range--metric-add metrics 'new-payload-copies)
|
|
(copy-sequence item)))
|
|
|
|
(defun ebox-child-range--descriptor-create (ref items)
|
|
"Return a reserved Range descriptor for non-nil REF and list ITEMS."
|
|
(unless ref (error "Ebox child Range ref must be non-nil"))
|
|
(unless (proper-list-p items)
|
|
(signal 'wrong-type-argument (list 'proper-list-p items)))
|
|
(ebox-child-range--make-descriptor :ref ref :items items))
|
|
|
|
(defun ebox-child-range--build
|
|
(segments key-function &optional hash-function retain-item-identities-p
|
|
segment-key-vectors)
|
|
"Build an immutable child sequence from SEGMENTS.
|
|
Each entry is `(REF . ITEMS)'; nil REF denotes one static child item.
|
|
KEY-FUNCTION returns each item's source-owned author key, or nil when this
|
|
sequence is deliberately unkeyed. HASH-FUNCTION optionally supplies the
|
|
stable key hash. When
|
|
RETAIN-ITEM-IDENTITIES-P is non-nil, ITEMS are already-owned canonical nodes
|
|
and the sequence retains those exact objects instead of copying them.
|
|
SEGMENT-KEY-VECTORS, when non-nil, supplies the already-derived key vector for
|
|
each segment so structural copies never recover keys from source metadata."
|
|
(unless (proper-list-p segments)
|
|
(signal 'wrong-type-argument (list 'proper-list-p segments)))
|
|
(let* ((count (length segments))
|
|
(height (ebox-child-range--height count))
|
|
(hash-function (or hash-function #'ebox-child-range--stable-hash))
|
|
(metrics (ebox-child-range--make-metrics))
|
|
root key-root (refs (make-hash-table :test #'equal)) (index 0))
|
|
(when (zerop count) (error "Ebox child sequence requires a segment"))
|
|
(when (and segment-key-vectors
|
|
(/= (length segment-key-vectors) (length segments)))
|
|
(error "Ebox child sequence key vectors are misaligned"))
|
|
(cl-loop for entry in segments
|
|
for explicit-keys in (or segment-key-vectors
|
|
(make-list (length segments) nil))
|
|
do
|
|
(let* ((ref (car entry))
|
|
(items (cdr entry)))
|
|
(unless (proper-list-p items)
|
|
(signal 'wrong-type-argument (list 'proper-list-p items)))
|
|
(when (and (null ref) (/= (length items) 1))
|
|
(error "Ebox static child segment requires exactly one item"))
|
|
(when (and ref (gethash ref refs))
|
|
(error "Ebox child Range ref is not unique: %S" ref))
|
|
(when ref (puthash ref index refs))
|
|
(let* ((payload (vconcat
|
|
(mapcar (lambda (item)
|
|
(ebox-child-range--item-copy
|
|
item metrics retain-item-identities-p))
|
|
items)))
|
|
(keys
|
|
(if explicit-keys
|
|
(copy-sequence explicit-keys)
|
|
(vconcat
|
|
(mapcar (lambda (item)
|
|
(and key-function
|
|
(funcall key-function item)))
|
|
items)))))
|
|
(unless (= (length keys) (length payload))
|
|
(error "Ebox child sequence keys do not match payload"))
|
|
(setq root (ebox-child-range--segment-insert
|
|
root height index
|
|
(ebox-child-range--make-segment
|
|
:ref ref :payload payload :keys keys)))
|
|
(dotimes (offset (length payload))
|
|
(let ((key (aref keys offset)))
|
|
(when key
|
|
(setq key-root
|
|
(ebox-child-range--hash-change
|
|
key-root key (cons index offset)
|
|
(funcall hash-function key) 0 nil metrics)))))))
|
|
(setq index (1+ index)))
|
|
(ebox-child-range--make-sequence
|
|
:root root :height height :count count :ref-index refs
|
|
:key-root key-root :hash-function hash-function)))
|
|
|
|
(defun ebox-child-range--replace (sequence ref items key-function)
|
|
"Return `(NEW-SEQUENCE . METRICS)' for SEQUENCE after replacing REF ITEMS."
|
|
(ebox-child-range--replace-many
|
|
sequence (list (cons ref items)) key-function))
|
|
|
|
(defun ebox-child-range--replace-many
|
|
(sequence replacements key-function &optional reuse-maps
|
|
retain-item-identities-p)
|
|
"Replace RANGE REPLACEMENTS in SEQUENCE with one two-phase transaction.
|
|
REUSE-MAPS is an alist from Range ref to proven `(NEW . OLD)' item indexes;
|
|
those NEW items already name canonical published objects and are not copied.
|
|
KEY-FUNCTION returns the source-owned key for every replacement item.
|
|
When RETAIN-ITEM-IDENTITIES-P is non-nil, non-reused items are already owned by
|
|
the candidate transaction and are retained without another node copy."
|
|
(let ((metrics (ebox-child-range--make-metrics))
|
|
(missing (make-symbol "missing-range-ref"))
|
|
(seen (make-hash-table :test #'equal)) records)
|
|
(unless (proper-list-p replacements)
|
|
(signal 'wrong-type-argument (list 'proper-list-p replacements)))
|
|
(dolist (entry replacements)
|
|
(unless (proper-list-p (cdr entry))
|
|
(signal 'wrong-type-argument (list 'proper-list-p (cdr entry))))
|
|
(when (gethash (car entry) seen)
|
|
(error "Ebox child Range replacement ref repeats: %S" (car entry)))
|
|
(puthash (car entry) t seen)
|
|
(ebox-child-range--metric-add metrics 'ref-index-visits)
|
|
(let ((index (gethash (car entry)
|
|
(ebox-child-range--sequence-ref-index sequence)
|
|
missing)))
|
|
(when (eq index missing)
|
|
(error "Ebox child Range ref does not exist: %S" (car entry)))
|
|
(let ((reuse-map (cdr (assoc (car entry) reuse-maps #'equal))))
|
|
(push (list
|
|
(car entry) index
|
|
(vconcat
|
|
(cl-loop for item in (cdr entry) for offset from 0
|
|
collect
|
|
(if (assq offset reuse-map)
|
|
item
|
|
(ebox-child-range--item-copy
|
|
item metrics retain-item-identities-p))))
|
|
(vconcat
|
|
(mapcar (lambda (item)
|
|
(and key-function (funcall key-function item)))
|
|
(cdr entry))))
|
|
records))))
|
|
(setq records (nreverse records))
|
|
(let ((key-root (ebox-child-range--sequence-key-root sequence))
|
|
(hash-function (ebox-child-range--sequence-hash-function sequence))
|
|
(root (ebox-child-range--sequence-root sequence)))
|
|
;; Each affected ref performs exactly one measured segment path copy;
|
|
;; the returned old leaf supplies phase-one key removal.
|
|
(setq records
|
|
(mapcar
|
|
(lambda (record)
|
|
(let* ((result
|
|
(ebox-child-range--segment-replace
|
|
root (ebox-child-range--sequence-height sequence)
|
|
(nth 1 record)
|
|
(ebox-child-range--make-segment
|
|
:ref (car record) :payload (nth 2 record)
|
|
:keys (nth 3 record))
|
|
metrics)))
|
|
(setq root (car result))
|
|
(list (car record) (nth 1 record) (cdr result)
|
|
(nth 2 record) (nth 3 record))))
|
|
records))
|
|
(dolist (record records)
|
|
(let* ((segment (nth 2 record))
|
|
(payload (ebox-child-range--segment-payload segment))
|
|
(keys (ebox-child-range--segment-keys segment)))
|
|
(dotimes (offset (length payload))
|
|
(ebox-child-range--metric-add metrics 'old-affected-payload-visits)
|
|
(when-let* ((key (aref keys offset)))
|
|
(setq key-root
|
|
(ebox-child-range--hash-change
|
|
key-root key nil (funcall hash-function key) 0 t metrics))))))
|
|
(dolist (record records)
|
|
(let ((index (nth 1 record))
|
|
(payload (nth 3 record))
|
|
(keys (nth 4 record)))
|
|
(dotimes (offset (length payload))
|
|
(when-let* ((key (aref keys offset)))
|
|
(setq key-root
|
|
(ebox-child-range--hash-change
|
|
key-root key (cons index offset)
|
|
(funcall hash-function key) 0 nil metrics))))))
|
|
(cons (ebox-child-range--make-sequence
|
|
:root root :height (ebox-child-range--sequence-height sequence)
|
|
:count (ebox-child-range--sequence-count sequence)
|
|
:ref-index (ebox-child-range--sequence-ref-index sequence)
|
|
:key-root key-root :hash-function hash-function)
|
|
metrics))))
|
|
|
|
(defun ebox-child-range--replace-item-at
|
|
(sequence segment-index offset old-item new-item new-key)
|
|
"Persistently replace OLD-ITEM by NEW-ITEM in SEQUENCE.
|
|
SEGMENT-INDEX and OFFSET identify its exact material-child location. NEW-KEY
|
|
is the replacement's source-owned author key."
|
|
(let* ((segment (ebox-child-range--segment-at sequence segment-index))
|
|
(payload (copy-sequence (ebox-child-range--segment-payload segment)))
|
|
(keys (copy-sequence (ebox-child-range--segment-keys segment)))
|
|
(key-root (ebox-child-range--sequence-key-root sequence))
|
|
(hash-function (ebox-child-range--sequence-hash-function sequence))
|
|
(metrics (ebox-child-range--make-metrics))
|
|
(old-key (aref keys offset)))
|
|
(unless (eq (aref payload offset) old-item)
|
|
(error "Ebox child sequence location is stale"))
|
|
(when old-key
|
|
(setq key-root (ebox-child-range--hash-change
|
|
key-root old-key nil (funcall hash-function old-key)
|
|
0 t metrics)))
|
|
(when new-key
|
|
(setq key-root (ebox-child-range--hash-change
|
|
key-root new-key (cons segment-index offset)
|
|
(funcall hash-function new-key) 0 nil metrics)))
|
|
(aset payload offset new-item)
|
|
(aset keys offset new-key)
|
|
(let ((result
|
|
(ebox-child-range--segment-replace
|
|
(ebox-child-range--sequence-root sequence)
|
|
(ebox-child-range--sequence-height sequence) segment-index
|
|
(ebox-child-range--make-segment
|
|
:ref (ebox-child-range--segment-ref segment)
|
|
:payload payload :keys keys)
|
|
metrics)))
|
|
(ebox-child-range--make-sequence
|
|
:root (car result) :height (ebox-child-range--sequence-height sequence)
|
|
:count (ebox-child-range--sequence-count sequence)
|
|
:ref-index (ebox-child-range--sequence-ref-index sequence)
|
|
:key-root key-root :hash-function hash-function))))
|
|
|
|
(defun ebox-child-range--prefix-weight (sequence index)
|
|
"Return flattened item weight before segment INDEX in SEQUENCE."
|
|
(let ((node (ebox-child-range--sequence-root sequence))
|
|
(height (ebox-child-range--sequence-height sequence))
|
|
(weight 0))
|
|
(while (> height 0)
|
|
(let* ((children (ebox-child-range--segment-node-children node))
|
|
(slot (ebox-child-range--digit index (1- height))))
|
|
(dotimes (cursor slot)
|
|
(when-let* ((child (aref children cursor)))
|
|
(setq weight (+ weight
|
|
(ebox-child-range--segment-node-weight child)))))
|
|
(setq node (aref children slot)
|
|
height (1- height))))
|
|
weight))
|
|
|
|
(defun ebox-child-range--rank (sequence index)
|
|
"Return the flattened child rank of segment INDEX in SEQUENCE."
|
|
(ebox-child-range--prefix-weight sequence index))
|
|
|
|
(defun ebox-child-range--lookup-ref (sequence ref)
|
|
"Return SEQUENCE's segment addressed by non-nil REF."
|
|
(let ((missing (make-symbol "missing-range-ref")))
|
|
(let ((index (gethash ref (ebox-child-range--sequence-ref-index sequence)
|
|
missing)))
|
|
(unless (eq index missing)
|
|
(ebox-child-range--segment-at sequence index)))))
|
|
|
|
(defun ebox-child-range--range-records (sequence)
|
|
"Return stable `(REF INDEX)' records for SEQUENCE ranges."
|
|
(let (records)
|
|
(dotimes (index (ebox-child-range--sequence-count sequence))
|
|
(let ((segment (ebox-child-range--segment-at sequence index)))
|
|
(when-let* ((ref (ebox-child-range--segment-ref segment)))
|
|
(push (list ref index) records))))
|
|
(nreverse records)))
|
|
|
|
(defun ebox-child-range--segment-memory (sequence)
|
|
"Return `(NODES . EDGES)' used by SEQUENCE's fixed-vector segment trie."
|
|
(let ((nodes 0) (edges 0))
|
|
(cl-labels ((walk (node)
|
|
(setq nodes (1+ nodes))
|
|
(when-let* ((children
|
|
(ebox-child-range--segment-node-children node)))
|
|
(dotimes (slot 32)
|
|
(when-let* ((child (aref children slot)))
|
|
(setq edges (1+ edges))
|
|
(walk child))))))
|
|
(walk (ebox-child-range--sequence-root sequence)))
|
|
(cons nodes edges)))
|
|
|
|
(defun ebox-child-range--segment-vector-memory (sequence)
|
|
"Return `(VECTORS . SLOTS)' allocated by SEQUENCE's segment trie."
|
|
(let ((vectors 0))
|
|
(cl-labels ((walk (node)
|
|
(when-let* ((children
|
|
(ebox-child-range--segment-node-children node)))
|
|
(setq vectors (1+ vectors))
|
|
(dotimes (slot 32)
|
|
(when-let* ((child (aref children slot))) (walk child))))))
|
|
(walk (ebox-child-range--sequence-root sequence)))
|
|
(cons vectors (* 32 vectors))))
|
|
|
|
(defun ebox-child-range--hash-memory (root)
|
|
"Return `(NODES . EDGES)' for sparse persistent hash ROOT."
|
|
(let ((nodes 0) (edges 0))
|
|
(cl-labels ((walk (node)
|
|
(when node
|
|
(setq nodes (1+ nodes))
|
|
(dolist (entry (ebox-child-range--hash-node-children node))
|
|
(setq edges (1+ edges))
|
|
(walk (cdr entry))))))
|
|
(walk root))
|
|
(cons nodes edges)))
|
|
|
|
(defun ebox-child-range--metrics-plist (metrics)
|
|
"Return a read-only plist snapshot of METRICS."
|
|
(list :segment-visits (ebox-child-range--metrics-segment-visits metrics)
|
|
:segment-copies (ebox-child-range--metrics-segment-copies metrics)
|
|
:ref-index-visits (ebox-child-range--metrics-ref-index-visits metrics)
|
|
:ref-index-copies (ebox-child-range--metrics-ref-index-copies metrics)
|
|
:key-visits (ebox-child-range--metrics-key-visits metrics)
|
|
:key-copies (ebox-child-range--metrics-key-copies metrics)
|
|
:collision-visits (ebox-child-range--metrics-collision-visits metrics)
|
|
:collision-copies (ebox-child-range--metrics-collision-copies metrics)
|
|
:old-affected-payload-visits
|
|
(ebox-child-range--metrics-old-affected-payload-visits metrics)
|
|
:new-payload-validations
|
|
(ebox-child-range--metrics-new-payload-validations metrics)
|
|
:new-payload-copies (ebox-child-range--metrics-new-payload-copies metrics)
|
|
:new-payload-visits (ebox-child-range--metrics-new-payload-visits metrics)
|
|
:unaffected-payload-visits
|
|
(ebox-child-range--metrics-unaffected-payload-visits metrics)
|
|
:unaffected-payload-validations
|
|
(ebox-child-range--metrics-unaffected-payload-validations metrics)
|
|
:unaffected-payload-copies
|
|
(ebox-child-range--metrics-unaffected-payload-copies metrics)))
|
|
|
|
(defun ebox-child-range--fold (sequence function initial)
|
|
"Fold SEQUENCE payloads in stable order with FUNCTION and INITIAL."
|
|
(let ((value initial)
|
|
(index 0))
|
|
(while (< index (ebox-child-range--sequence-count sequence))
|
|
(let ((payload (ebox-child-range--segment-payload
|
|
(ebox-child-range--segment-at sequence index))))
|
|
(dotimes (offset (length payload))
|
|
(setq value (funcall function value (aref payload offset)))))
|
|
(setq index (1+ index)))
|
|
value))
|
|
|
|
(defun ebox-child-range--flatten (sequence)
|
|
"Return SEQUENCE's explicit debug-only flat item list."
|
|
(nreverse
|
|
(ebox-child-range--fold
|
|
sequence (lambda (items item) (cons item items)) nil)))
|
|
|
|
(provide 'ebox-child-range)
|
|
;;; ebox-child-range.el ends here
|