Use compressed persistent runtime indexes and retained node-id postorder

This commit is contained in:
Kinneyzhang 2026-09-05 11:31:49 +08:00
parent dac004cd65
commit 826f195236
21 changed files with 1292 additions and 390 deletions

51
.runtime-index-plan.md Normal file
View File

@ -0,0 +1,51 @@
# Runtime persistent index cleanup plan
1. Lock the persistent index contract: exact `equal` keys, nil values,
collision buckets, immutable put/delete, count/map/keys, and legacy hash
adapters.
2. Add one fixed-depth radix index module and load it before tree, patch-plan,
incremental, surface, and native commit consumers.
3. Bootstrap node, parent, and region-owner indexes directly into immutable
indexes; store native postorder as node IDs. Bind the generated ID format
to the exact read-only vector; convert unmarked legacy entries with complete
candidate membership validation before retaining that format.
4. Change local candidate preparation to path-copy only removed/touched node and
affected-region keys. Keep all other state tables on their current path.
5. Migrate readers and compatibility entry points to the common adapters.
Preserve hash-table inputs at package boundaries.
6. Keep the complete topology comparison, including untouched surface objects
and source keys. Key-set identity tokens prove only persistent index
membership: value updates retain the token, membership changes replace it,
and unrelated index lineages use the exact key comparison.
7. Verify focused index and candidate regressions, then compile/checkdoc/full
ERT serially after coordinating CPU use with the root agent.
Stop when all production consumers of the three runtime indexes use adapters,
local candidates perform no whole-table copy/remap, and the focused plus full
validation gates pass. Report remaining full work in region-box/count/source
and other state tables.
## Compressed radix follow-up
The compiled fixed-depth version passed behavior checks but regressed measured
row/theme/filter/pagination latency. It is not accepted for integration.
1. Preserve the measured fixed-depth module, compiled bytecode, tests, and
reviewed patch outside the checkout before editing.
2. Add regressions for compressed branching depth and exact key semantics:
prefix divergence above an existing branch; colliding 64-bit integer codes;
colliding noninteger keys; nil values; deletion collapse and fork isolation;
and deletion of the key that supplied a branch's representative code.
3. Replace mandatory-depth roots with nil, exact collision leaves, and
16-way branch vectors carrying their actual nibble shift and representative
code. Branches have at least two children and increasing child shifts.
Put returns its membership-change flag without a separate lookup. Delete
replaces unary branches with their surviving child.
4. Keep key-set tokens, hash-table adapters, native postorder representation,
full topology validation, and all publication/rollback paths unchanged.
5. After the CPU owner releases its slot, run focused regressions, compiled
old/new index cost comparisons, then required package checks serially.
Report actual costs to the root agent for full workload measurement.
Accept this follow-up only after semantic checks pass and measured costs
improve; compressed structure alone does not establish end-to-end latency.

View File

@ -10,7 +10,7 @@ NATIVE_MANIFEST = native/Cargo.toml
NATIVE_TARGET ?= $(shell $(EMACS_BATCH) -l ebox-native-reflow.el --eval '(princ (ebox-native-reflow--rust-target))') NATIVE_TARGET ?= $(shell $(EMACS_BATCH) -l ebox-native-reflow.el --eval '(princ (ebox-native-reflow--rust-target))')
NATIVE_RELEASE_DIR = native/target/$(NATIVE_TARGET)/release NATIVE_RELEASE_DIR = native/target/$(NATIVE_TARGET)/release
.PHONY: all check ci load compile test checkdoc source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests m0a-tests state-contract-tests layout-boundary-tests layout-boundary-performance patch-plan-tests patch-plan-performance style-schema-tests style-schema-performance spi-tests spi-performance c1b-contract-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install .PHONY: all check ci load compile test checkdoc runtime-index-tests source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests m0a-tests state-contract-tests layout-boundary-tests layout-boundary-performance patch-plan-tests patch-plan-performance style-schema-tests style-schema-performance spi-tests spi-performance c1b-contract-tests docs-contract-tests ci-contract-tests performance-evaluator visual-check native-rust-tests native-build diff-check clean package-lint package-lint-install
all: check all: check
@ -25,7 +25,10 @@ compile:
rm -f *.elc tests/*.elc scripts/*.elc rm -f *.elc tests/*.elc scripts/*.elc
$(EMACS_BATCH) --eval '(setq byte-compile-error-on-warn t byte-compile-warnings (quote (not obsolete)))' -l ebox.el --eval '(ebox-byte-compile)' $(EMACS_BATCH) --eval '(setq byte-compile-error-on-warn t byte-compile-warnings (quote (not obsolete)))' -l ebox.el --eval '(ebox-byte-compile)'
test: source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests m0a-tests state-contract-tests layout-boundary-tests patch-plan-tests style-schema-tests spi-tests docs-contract-tests ci-contract-tests test: runtime-index-tests source-tests font-tests core-tests child-range-tests grid-tests ebox-commit-tests surface-tests visual-check-tests package-tests selector-tests dsl-tests flex-tests m0a-tests state-contract-tests layout-boundary-tests patch-plan-tests style-schema-tests spi-tests docs-contract-tests ci-contract-tests
runtime-index-tests:
$(EMACS_BATCH) -l tests/ebox-runtime-index-tests.el -f ert-run-tests-batch-and-exit
source-tests: source-tests:
$(EMACS_BATCH) -l tests/ebox-source-tests.el -f ert-run-tests-batch-and-exit $(EMACS_BATCH) -l tests/ebox-source-tests.el -f ert-run-tests-batch-and-exit

View File

@ -19,6 +19,7 @@ This is the maintainer entry point for the standalone Ebox repository. It descri
| `ebox.el` | Public facade, construction helpers, rendering, TP-backed buffer entry points, scrolling, commit, and byte compilation. | | `ebox.el` | Public facade, construction helpers, rendering, TP-backed buffer entry points, scrolling, commit, and byte compilation. |
| `ebox-cache.el` | Measurement/render cache records, invalidation, and cache reports. | | `ebox-cache.el` | Measurement/render cache records, invalidation, and cache reports. |
| `ebox-source.el` | Opaque source handles, immutable author source records, and candidate source indexes. | | `ebox-source.el` | Opaque source handles, immutable author source records, and candidate source indexes. |
| `ebox-runtime-index.el` | Compressed persistent radix maps and legacy hash-table adapters. |
| `ebox-state-contract.el` | Closed retained-state ownership inventory and read-only compatibility-mirror rebuild probes. | | `ebox-state-contract.el` | Closed retained-state ownership inventory and read-only compatibility-mirror rebuild probes. |
| `ebox-style.el` | ECSS property schemas, declarations and cascade, shorthand expansion, computed style, colors, borders, and dirty effects. | | `ebox-style.el` | ECSS property schemas, declarations and cascade, shorthand expansion, computed style, colors, borders, and dirty effects. |
| `ebox-tree.el` | Node traversal, logical child access, ECSS subject adaptation, identity, parent paths, keys, and tree snapshots. | | `ebox-tree.el` | Node traversal, logical child access, ECSS subject adaptation, identity, parent paths, keys, and tree snapshots. |
@ -42,6 +43,8 @@ The package intentionally does not include application Components, UI controls,
The active contract also covers `Makefile`, `.github/workflows/ci.yml`, `tests/ebox-core-render-tests.el`, `tests/ebox-state-contract-tests.el`, `tests/ebox-layout-boundary-tests.el`, `tests/ebox-patch-plan-tests.el`, `tests/ebox-style-schema-tests.el`, `tests/ebox-spi-tests.el`, `tests/ebox-child-range-tests.el`, `tests/ebox-grid-tests.el`, `tests/ebox-commit-tests.el`, `tests/ebox-surface-tests.el`, `tests/ebox-dsl-tests.el`, `tests/ebox-flex-tests.el`, `tests/ebox-selector-tests.el`, `tests/ebox-package-tests.el`, `tests/ebox-visual-check-tests.el`, `tests/ebox-docs-contract-tests.el`, `tests/ebox-ci-contract-tests.el`, `native/Cargo.toml`, `native/Cargo.lock`, `native/build.rs`, `native/vendor/emacs-30/emacs-module.h`, `native/src/lib.rs`, `native/src/layout.rs`, `native/c/ebox_module.c`, `scripts/ebox-package-lint.el`, `scripts/ebox-visual-check.el`, and `scripts/ebox-performance-evaluator.el`. The active contract also covers `Makefile`, `.github/workflows/ci.yml`, `tests/ebox-core-render-tests.el`, `tests/ebox-state-contract-tests.el`, `tests/ebox-layout-boundary-tests.el`, `tests/ebox-patch-plan-tests.el`, `tests/ebox-style-schema-tests.el`, `tests/ebox-spi-tests.el`, `tests/ebox-child-range-tests.el`, `tests/ebox-grid-tests.el`, `tests/ebox-commit-tests.el`, `tests/ebox-surface-tests.el`, `tests/ebox-dsl-tests.el`, `tests/ebox-flex-tests.el`, `tests/ebox-selector-tests.el`, `tests/ebox-package-tests.el`, `tests/ebox-visual-check-tests.el`, `tests/ebox-docs-contract-tests.el`, `tests/ebox-ci-contract-tests.el`, `native/Cargo.toml`, `native/Cargo.lock`, `native/build.rs`, `native/vendor/emacs-30/emacs-module.h`, `native/src/lib.rs`, `native/src/layout.rs`, `native/c/ebox_module.c`, `scripts/ebox-package-lint.el`, `scripts/ebox-visual-check.el`, and `scripts/ebox-performance-evaluator.el`.
Runtime index behavior is covered by `tests/ebox-runtime-index-tests.el`.
## Runtime model ## Runtime model
The normal data flow is: The normal data flow is:
@ -137,6 +140,7 @@ make load
make compile make compile
make check make check
make core-tests make core-tests
make runtime-index-tests
make child-range-tests make child-range-tests
make grid-tests make grid-tests
make ebox-commit-tests make ebox-commit-tests

View File

@ -19,6 +19,7 @@
| `ebox.el` | 公共门面、构造辅助函数、渲染、基于 TP 的 buffer 入口、滚动、commit 与 byte compile。 | | `ebox.el` | 公共门面、构造辅助函数、渲染、基于 TP 的 buffer 入口、滚动、commit 与 byte compile。 |
| `ebox-cache.el` | 测量/渲染缓存记录、失效和缓存报告。 | | `ebox-cache.el` | 测量/渲染缓存记录、失效和缓存报告。 |
| `ebox-source.el` | opaque source handle、不可变 author source record 与 candidate source index。 | | `ebox-source.el` | opaque source handle、不可变 author source record 与 candidate source index。 |
| `ebox-runtime-index.el` | 压缩持久 radix map 与旧 hash-table adapter。 |
| `ebox-state-contract.el` | 封闭的 retained-state 所有权清单与只读 compatibility-mirror 重建探针。 | | `ebox-state-contract.el` | 封闭的 retained-state 所有权清单与只读 compatibility-mirror 重建探针。 |
| `ebox-style.el` | ECSS property schema、declaration 与 cascade、shorthand 展开、computed style、颜色、border 和 dirty effect。 | | `ebox-style.el` | ECSS property schema、declaration 与 cascade、shorthand 展开、computed style、颜色、border 和 dirty effect。 |
| `ebox-tree.el` | 节点遍历、逻辑子节点访问、ECSS subject 适配、identity、父路径、key 和树 snapshot。 | | `ebox-tree.el` | 节点遍历、逻辑子节点访问、ECSS subject 适配、identity、父路径、key 和树 snapshot。 |
@ -42,6 +43,8 @@
active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-core-render-tests.el`、`tests/ebox-state-contract-tests.el`、`tests/ebox-layout-boundary-tests.el`、`tests/ebox-patch-plan-tests.el`、`tests/ebox-style-schema-tests.el`、`tests/ebox-spi-tests.el`、`tests/ebox-child-range-tests.el`、`tests/ebox-grid-tests.el`、`tests/ebox-commit-tests.el`、`tests/ebox-surface-tests.el`、`tests/ebox-dsl-tests.el`、`tests/ebox-flex-tests.el`、`tests/ebox-selector-tests.el`、`tests/ebox-package-tests.el`、`tests/ebox-visual-check-tests.el`、`tests/ebox-docs-contract-tests.el`、`tests/ebox-ci-contract-tests.el`、`native/Cargo.toml`、`native/Cargo.lock`、`native/build.rs`、`native/vendor/emacs-30/emacs-module.h`、`native/src/lib.rs`、`native/src/layout.rs`、`native/c/ebox_module.c`、`scripts/ebox-package-lint.el`、`scripts/ebox-visual-check.el` 和 `scripts/ebox-performance-evaluator.el` active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-core-render-tests.el`、`tests/ebox-state-contract-tests.el`、`tests/ebox-layout-boundary-tests.el`、`tests/ebox-patch-plan-tests.el`、`tests/ebox-style-schema-tests.el`、`tests/ebox-spi-tests.el`、`tests/ebox-child-range-tests.el`、`tests/ebox-grid-tests.el`、`tests/ebox-commit-tests.el`、`tests/ebox-surface-tests.el`、`tests/ebox-dsl-tests.el`、`tests/ebox-flex-tests.el`、`tests/ebox-selector-tests.el`、`tests/ebox-package-tests.el`、`tests/ebox-visual-check-tests.el`、`tests/ebox-docs-contract-tests.el`、`tests/ebox-ci-contract-tests.el`、`native/Cargo.toml`、`native/Cargo.lock`、`native/build.rs`、`native/vendor/emacs-30/emacs-module.h`、`native/src/lib.rs`、`native/src/layout.rs`、`native/c/ebox_module.c`、`scripts/ebox-package-lint.el`、`scripts/ebox-visual-check.el` 和 `scripts/ebox-performance-evaluator.el`
Runtime index 行为由 `tests/ebox-runtime-index-tests.el` 覆盖。
## 运行时模型 ## 运行时模型
正常数据流是: 正常数据流是:
@ -130,6 +133,7 @@ active 合同还覆盖 `Makefile`、`.github/workflows/ci.yml`、`tests/ebox-cor
```sh ```sh
make check make check
make core-tests make core-tests
make runtime-index-tests
make child-range-tests make child-range-tests
make grid-tests make grid-tests
make ebox-commit-tests make ebox-commit-tests

File diff suppressed because it is too large Load Diff

View File

@ -15,6 +15,7 @@
(require 'ebox-fragment) (require 'ebox-fragment)
(require 'ebox-render-context) (require 'ebox-render-context)
(require 'ebox-buffer-backend) (require 'ebox-buffer-backend)
(require 'ebox-runtime-index)
(declare-function ebox--render-grid "ebox-grid" (node)) (declare-function ebox--render-grid "ebox-grid" (node))
(declare-function ebox--render-grid-box-children (declare-function ebox--render-grid-box-children
@ -1982,8 +1983,9 @@ also pass a pre-rendered string while an active surface owns runtime facts."
(cl-loop (cl-loop
for state in ebox--render-source-states for state in ebox--render-source-states
for table = (plist-get state :node-table) for table = (plist-get state :node-table)
when (and (hash-table-p table) when (and (ebox-runtime-index-like-p table)
(eq node (gethash node-id table))) (eq node
(ebox-runtime-index-get node-id table)))
return (plist-get state :source-index))) return (plist-get state :source-index)))
(and handle (and handle
(cl-find-if (cl-find-if

View File

@ -11,6 +11,7 @@
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
(require 'ebox-runtime-index)
(declare-function ebox-native-reflow-layout-ready-p "ebox-native-reflow" ()) (declare-function ebox-native-reflow-layout-ready-p "ebox-native-reflow" ())
(declare-function ebox-native-reflow-execute-sync (declare-function ebox-native-reflow-execute-sync
@ -45,7 +46,7 @@
"ebox-incremental" (node)) "ebox-incremental" (node))
(defun ebox-native-commit-topology-stable-p (defun ebox-native-commit-topology-stable-p
(old-state candidate-state prepared) (old-state candidate-state prepared)
"Return non-nil when PREPARED preserves OLD-STATE's object topology." "Return non-nil when PREPARED preserves OLD-STATE's object topology."
(let ((old-nodes (plist-get old-state :node-table)) (let ((old-nodes (plist-get old-state :node-table))
(new-nodes (plist-get candidate-state :node-table)) (new-nodes (plist-get candidate-state :node-table))
@ -62,22 +63,22 @@
(lambda (entry) (lambda (entry)
(eq (plist-get entry :dirty-kind) 'structure)) (eq (plist-get entry :dirty-kind) 'structure))
(plist-get prepared :dirty-set))) (plist-get prepared :dirty-set)))
(hash-table-p old-nodes) (hash-table-p new-nodes) (ebox-runtime-index-like-p old-nodes) (ebox-runtime-index-like-p new-nodes)
(hash-table-p old-parents) (hash-table-p new-parents) (ebox-runtime-index-like-p old-parents) (ebox-runtime-index-like-p new-parents)
(hash-table-p old-regions) (hash-table-p new-regions) (ebox-runtime-index-like-p old-regions) (ebox-runtime-index-like-p new-regions)
(hash-table-p old-objects) (hash-table-p old-objects)
(= (hash-table-count old-nodes) (= (ebox-runtime-index-size old-nodes)
(hash-table-count new-nodes)) (ebox-runtime-index-size new-nodes))
(= (hash-table-count old-regions) (= (ebox-runtime-index-size old-regions)
(hash-table-count new-regions)))) (ebox-runtime-index-size new-regions))))
(when stable (when stable
(maphash (ebox-runtime-index-map
(lambda (node-id node) (lambda (node-id node)
(let ((old-node (gethash node-id old-nodes missing))) (let ((old-node (ebox-runtime-index-get node-id old-nodes missing)))
(unless (and (not (eq old-node missing)) (unless (and (not (eq old-node missing))
(gethash node-id old-objects) (gethash node-id old-objects)
(equal (gethash node-id old-parents missing) (equal (ebox-runtime-index-get node-id old-parents missing)
(gethash node-id new-parents missing)) (ebox-runtime-index-get node-id new-parents missing))
(eq (plist-get old-node :ebox-type) (eq (plist-get old-node :ebox-type)
(plist-get node :ebox-type)) (plist-get node :ebox-type))
(equal (equal
@ -88,9 +89,9 @@
(setq stable nil)))) (setq stable nil))))
new-nodes)) new-nodes))
(when stable (when stable
(maphash (ebox-runtime-index-map
(lambda (region-id node-id) (lambda (region-id node-id)
(unless (equal (gethash region-id old-regions missing) node-id) (unless (equal (ebox-runtime-index-get region-id old-regions missing) node-id)
(setq stable nil))) (setq stable nil)))
new-regions)) new-regions))
stable)) stable))
@ -105,7 +106,7 @@
(while (and node-id (not (gethash node-id seen))) (while (and node-id (not (gethash node-id seen)))
(puthash node-id t seen) (puthash node-id t seen)
(push node-id result) (push node-id result)
(setq node-id (and parents (gethash node-id parents)))))) (setq node-id (and parents (ebox-runtime-index-get node-id parents))))))
(nreverse result))) (nreverse result)))
(defun ebox-native-commit-inherited-dirty-node-ids (prepared) (defun ebox-native-commit-inherited-dirty-node-ids (prepared)
@ -123,8 +124,8 @@
"Return NODE-ID to `(PARENT-ID . POSITION)' table for STATE." "Return NODE-ID to `(PARENT-ID . POSITION)' table for STATE."
(let ((nodes (plist-get state :node-table)) (let ((nodes (plist-get state :node-table))
(table (make-hash-table :test 'equal))) (table (make-hash-table :test 'equal)))
(when (hash-table-p nodes) (when (ebox-runtime-index-like-p nodes)
(maphash (ebox-runtime-index-map
(lambda (parent-id node) (lambda (parent-id node)
(cl-loop for child in (ebox-tree--children-raw node) (cl-loop for child in (ebox-tree--children-raw node)
for position from 0 for position from 0
@ -166,22 +167,22 @@ type, key, parent, and sibling position are identical."
(plist-get old-state :source-index) old-root) (plist-get old-state :source-index) old-root)
(ebox-tree-node-key (ebox-tree-node-key
(plist-get candidate-state :source-index) new-root)) (plist-get candidate-state :source-index) new-root))
(hash-table-p old-nodes) (hash-table-p new-nodes) (ebox-runtime-index-like-p old-nodes) (ebox-runtime-index-like-p new-nodes)
(hash-table-p old-objects))) (hash-table-p old-objects)))
result) result)
(dolist (node-id (plist-get prepared :touched-node-ids)) (dolist (node-id (plist-get prepared :touched-node-ids))
(if (gethash node-id new-nodes) (if (ebox-runtime-index-get node-id new-nodes)
(puthash node-id t requested) (puthash node-id t requested)
(setq valid nil))) (setq valid nil)))
(dolist (node-id (plist-get prepared :removed-node-ids)) (dolist (node-id (plist-get prepared :removed-node-ids))
(if (and (gethash node-id old-nodes) (if (and (ebox-runtime-index-get node-id old-nodes)
(not (gethash node-id new-nodes))) (not (ebox-runtime-index-get node-id new-nodes)))
(puthash node-id t removed) (puthash node-id t removed)
(setq valid nil))) (setq valid nil)))
(when valid (when valid
(maphash (ebox-runtime-index-map
(lambda (node-id _node) (lambda (node-id _node)
(when (and (not (gethash node-id new-nodes)) (when (and (not (ebox-runtime-index-get node-id new-nodes))
(not (gethash node-id removed))) (not (gethash node-id removed)))
(setq valid nil))) (setq valid nil)))
old-nodes)) old-nodes))
@ -189,7 +190,7 @@ type, key, parent, and sibling position are identical."
(cl-labels (cl-labels
((visit (node) ((visit (node)
(let* ((node-id (plist-get node :node-id)) (let* ((node-id (plist-get node :node-id))
(old-node (gethash node-id old-nodes missing)) (old-node (ebox-runtime-index-get node-id old-nodes missing))
(old-object (gethash node-id old-objects)) (old-object (gethash node-id old-objects))
(position (gethash node-id new-positions)) (position (gethash node-id new-positions))
(parent-id (car-safe position)) (parent-id (car-safe position))
@ -229,12 +230,12 @@ type, key, parent, and sibling position are identical."
(setq stable (setq stable
(and (plist-get old-state :viewport-dependent-node-ids-ready) (and (plist-get old-state :viewport-dependent-node-ids-ready)
(plist-member old-state :viewport-dependent-node-id-axes) (plist-member old-state :viewport-dependent-node-id-axes)
(hash-table-p old-nodes) (ebox-runtime-index-like-p old-nodes)
(hash-table-p new-nodes))) (ebox-runtime-index-like-p new-nodes)))
(dolist (entry (plist-get prepared :dirty-set) stable) (dolist (entry (plist-get prepared :dirty-set) stable)
(let* ((node-id (plist-get entry :node-id)) (let* ((node-id (plist-get entry :node-id))
(old (and stable (gethash node-id old-nodes))) (old (and stable (ebox-runtime-index-get node-id old-nodes)))
(new (and stable (gethash node-id new-nodes)))) (new (and stable (ebox-runtime-index-get node-id new-nodes))))
(unless (and old new (unless (and old new
(eq (ebox--node-direct-viewport-width-dependent-p old) (eq (ebox--node-direct-viewport-width-dependent-p old)
(ebox--node-direct-viewport-width-dependent-p new)) (ebox--node-direct-viewport-width-dependent-p new))
@ -398,9 +399,9 @@ new session with the same bounded configuration used by retained frames."
(defun ebox-native-commit--region-box (state region-id) (defun ebox-native-commit--region-box (state region-id)
"Resolve REGION-ID's candidate box directly from STATE indexes." "Resolve REGION-ID's candidate box directly from STATE indexes."
(when-let* ((node-id (gethash region-id (when-let* ((node-id (ebox-runtime-index-get region-id
(plist-get state :region-node-table))) (plist-get state :region-node-table)))
(node (gethash node-id (plist-get state :node-table)))) (node (ebox-runtime-index-get node-id (plist-get state :node-table))))
(pcase (plist-get node :ebox-type) (pcase (plist-get node :ebox-type)
('box node) ('box node)
('flex (plist-get node :box))))) ('flex (plist-get node :box)))))
@ -429,8 +430,8 @@ new session with the same bounded configuration used by retained frames."
"Return non-nil when STATE contains only executable native node types." "Return non-nil when STATE contains only executable native node types."
(let ((nodes (plist-get state :node-table)) (let ((nodes (plist-get state :node-table))
(supported t)) (supported t))
(when (hash-table-p nodes) (when (ebox-runtime-index-like-p nodes)
(maphash (ebox-runtime-index-map
(lambda (_node-id node) (lambda (_node-id node)
(unless (memq (plist-get node :ebox-type) (unless (memq (plist-get node :ebox-type)
'(box concat stack flex)) '(box concat stack flex))

View File

@ -15,6 +15,7 @@
(require 'subr-x) (require 'subr-x)
(require 'ebox-measure) (require 'ebox-measure)
(require 'ebox-render-context) (require 'ebox-render-context)
(require 'ebox-runtime-index)
(declare-function ebox-native--module-version "ebox_native_reflow" ()) (declare-function ebox-native--module-version "ebox_native_reflow" ())
(declare-function ebox-native--module-layout-ready-p "ebox_native_reflow" ()) (declare-function ebox-native--module-layout-ready-p "ebox_native_reflow" ())
@ -2411,7 +2412,13 @@ Otherwise return CANDIDATE with the next document revision."
(root (and state (plist-get state :root-node))) (root (and state (plist-get state :root-node)))
(postorder (and state (plist-get state :native-node-postorder)))) (postorder (and state (plist-get state :native-node-postorder))))
(unless (and root (vectorp postorder) (> (length postorder) 0) (unless (and root (vectorp postorder) (> (length postorder) 0)
(eq root (aref postorder (1- (length postorder))))) (equal (plist-get root :node-id)
(let ((entry (aref postorder
(1- (length postorder)))))
(if (and (listp entry)
(plist-member entry :node-id))
(plist-get entry :node-id)
entry))))
(error "Native layout scene is absent from the render transaction")) (error "Native layout scene is absent from the render transaction"))
(with-current-buffer buffer (with-current-buffer buffer
(ebox-native-reflow--make-layout-scene (ebox-native-reflow--make-layout-scene
@ -2496,7 +2503,12 @@ per call, and no call recursively visits the captured Ebox tree."
(< (- (float-time) started) budget-seconds))) (< (- (float-time) started) budget-seconds)))
(let* ((index (let* ((index
(ebox-native-reflow-layout-builder-index builder)) (ebox-native-reflow-layout-builder-index builder))
(node (aref nodes index)) (node
(ebox-native-reflow--postorder-node
(aref nodes index)
(plist-get
(ebox-native-reflow-layout-scene-render-state scene)
:node-table)))
(fragment (fragment
(ebox-native-reflow--compile-scene-node (ebox-native-reflow--compile-scene-node
node fragments node fragments
@ -2645,10 +2657,21 @@ per call, and no call recursively visits the captured Ebox tree."
(plist-get node :content-min-width))) (plist-get node :content-min-width)))
local))) local)))
(defun ebox-native-reflow--retained-edge-index (postorder cache) (defun ebox-native-reflow--postorder-node (entry node-table)
"Build exact child-edge facts from full POSTORDER fragments in CACHE." "Resolve POSTORDER ENTRY through NODE-TABLE when it is a node id."
(if (and (listp entry) (plist-member entry :ebox-type))
entry
(or (ebox-runtime-index-get entry node-table)
(error "Native postorder references an absent node: %S" entry))))
(defun ebox-native-reflow--retained-edge-index
(postorder cache &optional node-table)
"Build exact child-edge facts from full POSTORDER fragments in CACHE.
Resolve node-ID entries through NODE-TABLE; legacy node plists need no index."
(let (index) (let (index)
(cl-loop for parent across postorder (cl-loop for entry across postorder
for parent = (ebox-native-reflow--postorder-node
entry node-table)
for parent-id = (plist-get parent :node-id) for parent-id = (plist-get parent :node-id)
for rule = (ebox-native-reflow--retained-edge-rule parent) for rule = (ebox-native-reflow--retained-edge-rule parent)
when rule do when rule do
@ -2685,7 +2708,8 @@ per call, and no call recursively visits the captured Ebox tree."
(defun ebox-native-reflow--compile-retained-layout-package-full (defun ebox-native-reflow--compile-retained-layout-package-full
(session state node) (session state node)
"Compile a complete retained package for NODE in SESSION from STATE." "Compile a complete retained package for NODE in SESSION from STATE."
(let ((postorder (plist-get state :native-node-postorder))) (let ((postorder (plist-get state :native-node-postorder))
(node-table (plist-get state :node-table)))
(unless (and (vectorp postorder) (> (length postorder) 0)) (unless (and (vectorp postorder) (> (length postorder) 0))
(setq postorder (setq postorder
(ebox-native-reflow--retained-layout-postorder node))) (ebox-native-reflow--retained-layout-postorder node)))
@ -2728,7 +2752,11 @@ per call, and no call recursively visits the captured Ebox tree."
(postorder-id-set (postorder-id-set
(let ((set (make-hash-table :test 'equal))) (let ((set (make-hash-table :test 'equal)))
(dotimes (index (length postorder)) (dotimes (index (length postorder))
(puthash (plist-get (aref postorder index) :node-id) (puthash
(plist-get
(ebox-native-reflow--postorder-node
(aref postorder index) node-table)
:node-id)
t set)) t set))
set)) set))
(ebox-native-reflow--compile-styles (ebox-native-reflow--compile-styles
@ -2832,7 +2860,9 @@ per call, and no call recursively visits the captured Ebox tree."
(puthash current fragment fragments) (puthash current fragment fragments)
(puthash node-id entry new-cache)))) (puthash node-id entry new-cache))))
(dotimes (index (length postorder)) (dotimes (index (length postorder))
(let* ((current (aref postorder index)) (let* ((current
(ebox-native-reflow--postorder-node
(aref postorder index) node-table))
(node-id (plist-get current :node-id))) (node-id (plist-get current :node-id)))
(if (and retained-fast-p (if (and retained-fast-p
(not (gethash node-id touched-set))) (not (gethash node-id touched-set)))
@ -2871,7 +2901,7 @@ per call, and no call recursively visits the captured Ebox tree."
(plist-get package :property-templates)) (plist-get package :property-templates))
(ebox-native-reflow-session-layout-edge-index session) (ebox-native-reflow-session-layout-edge-index session)
(ebox-native-reflow--retained-edge-index (ebox-native-reflow--retained-edge-index
postorder new-cache)) postorder new-cache node-table))
package))))) package)))))
(defconst ebox-native-reflow--delta-edge-fields (defconst ebox-native-reflow--delta-edge-fields
@ -2924,9 +2954,9 @@ RULE identifies the compiler lowering, and RETAINED supplies its stable slot."
(owner-id (owner-id
(and nodes parents (and nodes parents
(ebox-native-reflow--delta-owner-id state dirty-id index))) (ebox-native-reflow--delta-owner-id state dirty-id index)))
(owner (and owner-id (gethash owner-id nodes))) (owner (and owner-id (ebox-runtime-index-get owner-id nodes)))
(parent-id (and owner-id (gethash owner-id parents))) (parent-id (and owner-id (ebox-runtime-index-get owner-id parents)))
(parent (and parent-id (gethash parent-id nodes))) (parent (and parent-id (ebox-runtime-index-get parent-id nodes)))
(current-parent-rule (current-parent-rule
(and parent (ebox-native-reflow--retained-edge-rule parent))) (and parent (ebox-native-reflow--retained-edge-rule parent)))
(retained-parent-rule (retained-parent-rule
@ -2994,9 +3024,9 @@ RULE identifies the compiler lowering, and RETAINED supplies its stable slot."
(let ((parents (plist-get state :parent-table)) (let ((parents (plist-get state :parent-table))
(nodes (plist-get state :node-table)) (nodes (plist-get state :node-table))
(current node-id)) (current node-id))
(when-let* ((source (and nodes (gethash current nodes))) (when-let* ((source (and nodes (ebox-runtime-index-get current nodes)))
(parent-id (and parents (gethash current parents))) (parent-id (and parents (ebox-runtime-index-get current parents)))
(parent (and nodes (gethash parent-id nodes)))) (parent (and nodes (ebox-runtime-index-get parent-id nodes))))
(when (and (eq (plist-get source :ebox-kind) 'text) (when (and (eq (plist-get source :ebox-kind) 'text)
(eq (plist-get parent :ebox-kind) 'box) (eq (plist-get parent :ebox-kind) 'box)
(eq (ebox-layout-config-kind (eq (ebox-layout-config-kind
@ -3006,7 +3036,7 @@ RULE identifies the compiler lowering, and RETAINED supplies its stable slot."
(while (and current (while (and current
(null (ebox-native-reflow--persistent-index-get (null (ebox-native-reflow--persistent-index-get
index current))) index current)))
(setq current (and parents (gethash current parents)))) (setq current (and parents (ebox-runtime-index-get current parents))))
current)) current))
(defun ebox-native-reflow--compile-delta-slots (node old-fragment) (defun ebox-native-reflow--compile-delta-slots (node old-fragment)
@ -3073,7 +3103,7 @@ RULE identifies the compiler lowering, and RETAINED supplies its stable slot."
(old-index (ebox-native-reflow-session-layout-fragment-index session)) (old-index (ebox-native-reflow-session-layout-fragment-index session))
(node-table (plist-get state :node-table)) (node-table (plist-get state :node-table))
(touched (plist-get state :native-touched-node-ids))) (touched (plist-get state :native-touched-node-ids)))
(when (and old-package old-index (hash-table-p node-table) (when (and old-package old-index (ebox-runtime-index-like-p node-table)
(plist-get state :native-topology-stable-p) (plist-get state :native-topology-stable-p)
(plist-member state :native-local-dirty-entries) (plist-member state :native-local-dirty-entries)
(not (ebox-native-reflow--delta-edge-change-p (not (ebox-native-reflow--delta-edge-change-p
@ -3126,7 +3156,7 @@ RULE identifies the compiler lowering, and RETAINED supplies its stable slot."
(let* ((cached (ebox-native-reflow--persistent-index-get (let* ((cached (ebox-native-reflow--persistent-index-get
old-index owner-id)) old-index owner-id))
(old-fragment (plist-get cached :fragment)) (old-fragment (plist-get cached :fragment))
(source (gethash owner-id node-table)) (source (ebox-runtime-index-get owner-id node-table))
(expected (plist-get cached :revision)) (expected (plist-get cached :revision))
patches new-fragment) patches new-fragment)
(unless (and cached source (integerp expected)) (unless (and cached source (integerp expected))

View File

@ -12,6 +12,7 @@
(require 'cl-lib) (require 'cl-lib)
(require 'subr-x) (require 'subr-x)
(require 'ebox-runtime-index)
(define-error 'ebox-patch-plan-error "Invalid Ebox patch plan input") (define-error 'ebox-patch-plan-error "Invalid Ebox patch plan input")
@ -115,14 +116,14 @@
"Return OWNER-ID's strict ancestors from immutable PARENT-TABLE." "Return OWNER-ID's strict ancestors from immutable PARENT-TABLE."
(let ((ancestors (make-hash-table :test #'equal)) (let ((ancestors (make-hash-table :test #'equal))
(seen (make-hash-table :test #'equal)) (seen (make-hash-table :test #'equal))
(walk (gethash owner-id parent-table))) (walk (ebox-runtime-index-get owner-id parent-table)))
(while walk (while walk
(when (gethash walk seen) (when (gethash walk seen)
(signal 'ebox-patch-plan-error (signal 'ebox-patch-plan-error
(list :cyclic-parent-table :node-id walk))) (list :cyclic-parent-table :node-id walk)))
(puthash walk t seen) (puthash walk t seen)
(puthash walk t ancestors) (puthash walk t ancestors)
(setq walk (gethash walk parent-table))) (setq walk (ebox-runtime-index-get walk parent-table)))
ancestors)) ancestors))
(defun ebox-patch-plan--make-index () (defun ebox-patch-plan--make-index ()
@ -216,7 +217,7 @@
PARENT-TABLE maps a node id to its parent id and is treated as immutable. PARENT-TABLE maps a node id to its parent id and is treated as immutable.
OPERATIONS are patch artifact plists. This function mutates neither input and OPERATIONS are patch artifact plists. This function mutates neither input and
has no publication capability." has no publication capability."
(unless (hash-table-p parent-table) (unless (ebox-runtime-index-like-p parent-table)
(signal 'ebox-patch-plan-error (signal 'ebox-patch-plan-error
(list :malformed-parent-table parent-table))) (list :malformed-parent-table parent-table)))
(unless (proper-list-p operations) (unless (proper-list-p operations)

237
ebox-runtime-index.el Normal file
View File

@ -0,0 +1,237 @@
;;; ebox-runtime-index.el --- Immutable runtime indexes for Ebox -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Compressed persistent radix maps used by runtime state. Branches retain
;; only nibble positions where codes diverge; leaves hold exact equal-key
;; collision buckets. Adapters continue to accept legacy hash tables.
;;; Code:
(require 'cl-lib)
(cl-defstruct (ebox-runtime-index
(:constructor ebox-runtime-index--create
(root count key-set-token)))
"Immutable compressed radix index."
root
count
key-set-token)
(defun ebox-runtime-index-empty ()
"Return an empty immutable runtime index."
(ebox-runtime-index--create nil 0 nil))
(defun ebox-runtime-index-like-p (object)
"Return non-nil when OBJECT is a supported runtime index."
(or (ebox-runtime-index-p object) (hash-table-p object)))
(defun ebox-runtime-index--code (key)
"Return a stable 64-bit radix code for KEY."
(logand (if (and (integerp key) (>= key 0)) key (sxhash-equal key))
#xffffffffffffffff))
(defun ebox-runtime-index--branch (shift code &optional original)
"Return a fresh branch for nibble SHIFT and representative CODE.
Copy ORIGINAL when supplied; its metadata already carries SHIFT and CODE.
All branch allocations, including path copies, pass through this function."
(if original
(copy-sequence original)
(let ((branch (make-vector 18 nil)))
(aset branch 0 shift)
(aset branch 1 code)
branch)))
(defun ebox-runtime-index--join (left left-code right right-code)
"Join LEFT and RIGHT above the first differing nibble of their codes.
LEFT-CODE and RIGHT-CODE are distinct 64-bit representative codes."
(let* ((difference (logxor left-code right-code))
(shift (logand (logcount (1- (logand difference (- difference))))
-4))
(branch (ebox-runtime-index--branch shift left-code)))
(aset branch (+ 2 (logand (ash left-code (- shift)) 15)) left)
(aset branch (+ 2 (logand (ash right-code (- shift)) 15)) right)
branch))
(defun ebox-runtime-index--root-get (root key missing)
"Return KEY from persistent ROOT, or MISSING."
(let ((node root)
(code (ebox-runtime-index--code key)))
(while (vectorp node)
(setq node (aref node (+ 2 (logand (ash code (- (aref node 0))) 15)))))
(if (and node (= code (car node)))
(let ((pair (assoc key (cdr node))))
(if pair (cdr pair) missing))
missing)))
(defun ebox-runtime-index-get (key index &optional missing)
"Return KEY's value from INDEX, or MISSING.
INDEX may be an immutable runtime index or a legacy hash table."
(cond
((ebox-runtime-index-p index)
(ebox-runtime-index--root-get (ebox-runtime-index-root index) key missing))
((hash-table-p index) (gethash key index missing))
(t missing)))
(defun ebox-runtime-index-contains-p (key index)
"Return non-nil when INDEX contains KEY, including a nil value."
(let ((missing (make-symbol "ebox-runtime-index-missing")))
(not (eq (ebox-runtime-index-get key index missing) missing))))
(defun ebox-runtime-index--root-put (root key value code)
"Return `(ROOT . ADDED)' after mapping KEY to VALUE using CODE."
(cond
((null root) (cons (cons code (list (cons key value))) t))
((vectorp root)
(let ((shift (aref root 0))
(representative (aref root 1)))
(if (/= (logand (logxor code representative) (1- (ash 1 shift))) 0)
(cons (ebox-runtime-index--join
root representative (cons code (list (cons key value))) code)
t)
(let* ((slot (+ 2 (logand (ash code (- shift)) 15)))
(result (ebox-runtime-index--root-put
(aref root slot) key value code))
(copy (ebox-runtime-index--branch shift representative root)))
(aset copy slot (car result))
(cons copy (cdr result))))))
((= code (car root))
(let* ((bucket (cdr root))
(present (assoc key bucket)))
(cons (cons code
(cons (cons key value)
(if present
(cl-remove key bucket :key #'car :test #'equal)
bucket)))
(not present))))
(t (cons (ebox-runtime-index--join
root (car root) (cons code (list (cons key value))) code)
t))))
(defun ebox-runtime-index-put (key value index)
"Return INDEX with KEY mapped to VALUE.
Immutable indexes return a new value. Legacy hash tables are mutated and
returned for compatibility."
(cond
((ebox-runtime-index-p index)
(let ((result
(ebox-runtime-index--root-put
(ebox-runtime-index-root index) key value
(ebox-runtime-index--code key))))
(ebox-runtime-index--create
(car result)
(+ (ebox-runtime-index-count index) (if (cdr result) 1 0))
(if (cdr result)
(make-symbol "ebox-runtime-index-key-set")
(ebox-runtime-index-key-set-token index)))))
((hash-table-p index) (puthash key value index) index)
(t (signal 'wrong-type-argument (list 'ebox-runtime-index-like-p index)))))
(defun ebox-runtime-index--root-delete (root key code)
"Return `(ROOT . REMOVED)' after deleting KEY using CODE."
(cond
((null root) (cons nil nil))
((vectorp root)
(let* ((shift (aref root 0))
(slot (+ 2 (logand (ash code (- shift)) 15)))
(result (ebox-runtime-index--root-delete (aref root slot) key code)))
(if (not (cdr result))
(cons root nil)
(let ((children 0) survivor)
(unless (car result)
(dotimes (offset 16)
(let ((position (+ offset 2)))
(when (and (/= position slot) (aref root position))
(cl-incf children)
(setq survivor (aref root position))))))
(if (= children 1)
(cons survivor t)
(let ((copy (ebox-runtime-index--branch shift (aref root 1) root)))
(aset copy slot (car result))
(cons copy t)))))))
((and (= code (car root)) (assoc key (cdr root)))
(let ((bucket (cl-remove key (cdr root) :key #'car :test #'equal)))
(cons (and bucket (cons code bucket)) t)))
(t (cons root nil))))
(defun ebox-runtime-index-delete (key index)
"Return INDEX without KEY.
Immutable indexes return a new value. Legacy hash tables are mutated and
returned for compatibility."
(cond
((ebox-runtime-index-p index)
(let ((result
(ebox-runtime-index--root-delete
(ebox-runtime-index-root index) key
(ebox-runtime-index--code key))))
(if (cdr result)
(let ((count (1- (ebox-runtime-index-count index))))
(ebox-runtime-index--create
(car result) count
(and (> count 0)
(make-symbol "ebox-runtime-index-key-set"))))
index)))
((hash-table-p index) (remhash key index) index)
(t (signal 'wrong-type-argument (list 'ebox-runtime-index-like-p index)))))
(defun ebox-runtime-index-size (index)
"Return the number of entries in INDEX."
(cond
((ebox-runtime-index-p index) (ebox-runtime-index-count index))
((hash-table-p index) (hash-table-count index))
(t 0)))
(defun ebox-runtime-index-key-set-equal-p (left right)
"Return non-nil when supported indexes LEFT and RIGHT have equal keys."
(let ((persistent-shared-keys-p
(and (ebox-runtime-index-p left)
(ebox-runtime-index-p right)
(= (ebox-runtime-index-count left)
(ebox-runtime-index-count right))
(eq (ebox-runtime-index-key-set-token left)
(ebox-runtime-index-key-set-token right)))))
(cond
(persistent-shared-keys-p t)
((and (ebox-runtime-index-like-p left)
(ebox-runtime-index-like-p right)
(= (ebox-runtime-index-size left) (ebox-runtime-index-size right)))
(let ((equal-p t)
(missing (make-symbol "ebox-runtime-index-missing")))
(ebox-runtime-index-map
(lambda (key _value)
(when (eq (ebox-runtime-index-get key right missing) missing)
(setq equal-p nil)))
left)
equal-p))
(t nil))))
(defun ebox-runtime-index--map-root (function root)
"Call FUNCTION for entries below ROOT, visiting only live trie nodes."
(when root
(if (vectorp root)
(dotimes (branch 16)
(let ((child (aref root (+ 2 branch))))
(when child (ebox-runtime-index--map-root function child))))
(dolist (pair (cdr root)) (funcall function (car pair) (cdr pair))))))
(defun ebox-runtime-index-map (function index)
"Call FUNCTION with every key and value in INDEX."
(cond
((ebox-runtime-index-p index)
(ebox-runtime-index--map-root
function (ebox-runtime-index-root index)))
((hash-table-p index) (maphash function index))
(t (signal 'wrong-type-argument (list 'ebox-runtime-index-like-p index))))
nil)
(defun ebox-runtime-index-keys (index)
"Return a list of keys in INDEX."
(let (keys)
(ebox-runtime-index-map (lambda (key _value) (push key keys)) index)
keys))
(provide 'ebox-runtime-index)
;;; ebox-runtime-index.el ends here

View File

@ -18,6 +18,7 @@
(require 'ebox-tree) (require 'ebox-tree)
(require 'ebox-layout) (require 'ebox-layout)
(require 'ebox-incremental) (require 'ebox-incremental)
(require 'ebox-runtime-index)
(require 'tp-reactive) (require 'tp-reactive)
(require 'tp-surface) (require 'tp-surface)
(require 'tp) (require 'tp)
@ -1521,7 +1522,7 @@ PREVIOUS-STATE's node-object table."
(context nodes node-root old-objects objects-by-node) (context nodes node-root old-objects objects-by-node)
"Reuse native NODES whose object topology is proven unchanged." "Reuse native NODES whose object topology is proven unchanged."
(tp-object-reuse-subtree context node-root) (tp-object-reuse-subtree context node-root)
(maphash (ebox-runtime-index-map
(lambda (node-id node) (lambda (node-id node)
(let ((object (gethash node-id old-objects))) (let ((object (gethash node-id old-objects)))
(unless object (unless object
@ -1544,7 +1545,7 @@ PREVIOUS-STATE's node-object table."
(old-objects (plist-get previous-state :surface-node-object-table)) (old-objects (plist-get previous-state :surface-node-object-table))
(touched (make-hash-table :test 'equal)) (touched (make-hash-table :test 'equal))
(objects-by-id (make-hash-table :test 'equal))) (objects-by-id (make-hash-table :test 'equal)))
(unless (and (hash-table-p nodes) (hash-table-p parents) (unless (and (ebox-runtime-index-like-p nodes) (ebox-runtime-index-like-p parents)
(hash-table-p old-objects) (hash-table-p old-objects)
(or (plist-get state-overrides :native-topology-stable-p) (or (plist-get state-overrides :native-topology-stable-p)
touched-ids)) touched-ids))
@ -1554,7 +1555,7 @@ PREVIOUS-STATE's node-object table."
context nodes node-root old-objects objects-by-node) context nodes node-root old-objects objects-by-node)
(tp-object-retain context node-root) (tp-object-retain context node-root)
(dolist (node-id touched-ids) (puthash node-id t touched)) (dolist (node-id touched-ids) (puthash node-id t touched))
(maphash (ebox-runtime-index-map
(lambda (node-id node) (lambda (node-id node)
(when subject-table (when subject-table
(when-let* ((subject (when-let* ((subject
@ -1574,10 +1575,10 @@ PREVIOUS-STATE's node-object table."
(puthash node-id object objects-by-id)))) (puthash node-id object objects-by-id))))
nodes) nodes)
(dolist (node-id touched-ids) (dolist (node-id touched-ids)
(let* ((node (gethash node-id nodes)) (let* ((node (ebox-runtime-index-get node-id nodes))
(parent-id (and node (gethash node-id parents))) (parent-id (and node (ebox-runtime-index-get node-id parents)))
(old-object (and node (gethash node-id old-objects))) (old-object (and node (gethash node-id old-objects)))
(parent-node (and parent-id (gethash parent-id nodes))) (parent-node (and parent-id (ebox-runtime-index-get parent-id nodes)))
(position (position
(if parent-node (if parent-node
(or (cl-position (or (cl-position
@ -2009,7 +2010,7 @@ batch without asking TP to rediscover the same diff from a full plan."
(progn (progn
(setq object (and objects (gethash node-id objects))) (setq object (and objects (gethash node-id objects)))
(or (not object) (not (tp-object-mounted-p object))))) (or (not object) (not (tp-object-mounted-p object)))))
(setq node-id (and parents (gethash node-id parents)))) (setq node-id (and parents (ebox-runtime-index-get node-id parents))))
(unless (and object (tp-object-live-p object) (unless (and object (tp-object-live-p object)
(tp-object-mounted-p object)) (tp-object-mounted-p object))
(error "Ebox scoped owner has no mounted TP object")) (error "Ebox scoped owner has no mounted TP object"))
@ -2457,19 +2458,19 @@ source-handle-to-subject table when the requested local preparation completed."
(when (gethash node-id visiting) (when (gethash node-id visiting)
(error "Ebox candidate style parent cycle at %S" node-id)) (error "Ebox candidate style parent cycle at %S" node-id))
(puthash node-id t visiting) (puthash node-id t visiting)
(let* ((node (gethash node-id new-nodes)) (let* ((node (ebox-runtime-index-get node-id new-nodes))
(old-node (gethash node-id old-nodes)) (old-node (ebox-runtime-index-get node-id old-nodes))
(parent-id (gethash node-id parents)) (parent-id (ebox-runtime-index-get node-id parents))
(parent-style (and parent-id (resolve parent-id))) (parent-style (and parent-id (resolve parent-id)))
(parent-subject (parent-subject
(and parent-id (gethash parent-id subjects-by-id))) (and parent-id (gethash parent-id subjects-by-id)))
(old-parent-id (old-parent-id
(and old-node (and old-node
(gethash node-id (ebox-runtime-index-get node-id
(plist-get old-state :parent-table)))) (plist-get old-state :parent-table))))
(old-parent (old-parent
(and old-parent-id (and old-parent-id
(gethash old-parent-id old-nodes))) (ebox-runtime-index-get old-parent-id old-nodes)))
(old-parent-style (old-parent-style
(and old-parent (and old-parent
(plist-get old-parent :ebox-computed-style))) (plist-get old-parent :ebox-computed-style)))
@ -2534,7 +2535,7 @@ source-handle-to-subject table when the requested local preparation completed."
(ebox-surface--project-font (ebox-surface--project-font
node style node style
(and parent-id (and parent-id
(plist-get (gethash parent-id new-nodes) (plist-get (ebox-runtime-index-get parent-id new-nodes)
:ebox-font-fact)) :ebox-font-fact))
snapshot) snapshot)
(cond (cond
@ -2556,7 +2557,7 @@ source-handle-to-subject table when the requested local preparation completed."
(puthash node-id style resolved) (puthash node-id style resolved)
style)))))) style))))))
(dolist (node-id node-ids) (dolist (node-id node-ids)
(when (gethash node-id new-nodes) (when (ebox-runtime-index-get node-id new-nodes)
(resolve node-id)))) (resolve node-id))))
subjects-by-handle)))) subjects-by-handle))))
@ -2671,7 +2672,7 @@ dependencies, or any malformed index conservatively preserves root planning."
signature))))) signature)))))
(and (hash-table-p objects) (and (hash-table-p objects)
(hash-table-p style-states) (hash-table-p style-states)
(hash-table-p candidate-nodes) (ebox-runtime-index-like-p candidate-nodes)
dirty-set dirty-set
(cl-every (cl-every
(lambda (entry) (lambda (entry)
@ -2681,7 +2682,8 @@ dependencies, or any malformed index conservatively preserves root planning."
(object (and node-id (gethash node-id objects))) (object (and node-id (gethash node-id objects)))
(style-state (and object (gethash object style-states))) (style-state (and object (gethash object style-states)))
(candidate-node (and node-id (candidate-node (and node-id
(gethash node-id candidate-nodes))) (ebox-runtime-index-get
node-id candidate-nodes)))
(subject (and style-state (subject (and style-state
(plist-get style-state :subject))) (plist-get style-state :subject)))
(candidate-declarations (candidate-declarations
@ -2790,7 +2792,7 @@ dependencies, or any malformed index conservatively preserves root planning."
(defun ebox-surface--region-object-table (state node-objects) (defun ebox-surface--region-object-table (state node-objects)
"Return region-to-object table from candidate STATE and NODE-OBJECTS." "Return region-to-object table from candidate STATE and NODE-OBJECTS."
(let ((table (make-hash-table :test 'equal))) (let ((table (make-hash-table :test 'equal)))
(maphash (ebox-runtime-index-map
(lambda (region-id node-id) (lambda (region-id node-id)
(let ((object (gethash node-id node-objects))) (let ((object (gethash node-id node-objects)))
(unless object (unless object
@ -2975,10 +2977,10 @@ valid because their declarative layout and viewport did not change."
"Attach retained TP objects to candidate nodes in STATE." "Attach retained TP objects to candidate nodes in STATE."
(let ((nodes (plist-get state :node-table)) (let ((nodes (plist-get state :node-table))
(objects (plist-get state :surface-node-object-table))) (objects (plist-get state :surface-node-object-table)))
(when (and (hash-table-p nodes) (hash-table-p objects)) (when (and (ebox-runtime-index-like-p nodes) (hash-table-p objects))
(maphash (maphash
(lambda (node-id object) (lambda (node-id object)
(when-let* ((node (gethash node-id nodes))) (when-let* ((node (ebox-runtime-index-get node-id nodes)))
(plist-put node :surface-object object))) (plist-put node :surface-object object)))
objects)) objects))
state)) state))
@ -2994,7 +2996,7 @@ valid because their declarative layout and viewport did not change."
(objects (plist-get state :surface-node-object-table)) (objects (plist-get state :surface-node-object-table))
(style-states (plist-get state :style-binding-states))) (style-states (plist-get state :style-binding-states)))
(dolist (owner-id owner-ids) (dolist (owner-id owner-ids)
(when-let* ((node (and nodes (gethash owner-id nodes))) (when-let* ((node (and nodes (ebox-runtime-index-get owner-id nodes)))
(object (and objects (gethash owner-id objects))) (object (and objects (gethash owner-id objects)))
(style-state (and style-states (style-state (and style-states
(gethash object style-states))) (gethash object style-states)))
@ -3255,11 +3257,11 @@ old allocated width while the owner changes its natural content length."
(old-snapshot (old-snapshot
(and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id))) (and owner-id (ebox--ensure-layout-snapshot-details buffer owner-id)))
(spans (and old-snapshot (plist-get old-snapshot :buffer-spans))) (spans (and old-snapshot (plist-get old-snapshot :buffer-spans)))
(node (and owner-id (gethash owner-id (plist-get state :node-table)))) (node (and owner-id (ebox-runtime-index-get owner-id (plist-get state :node-table))))
(parent-id (and owner-id (parent-id (and owner-id
(gethash owner-id (plist-get state :parent-table)))) (ebox-runtime-index-get owner-id (plist-get state :parent-table))))
(parent (and parent-id (parent (and parent-id
(gethash parent-id (plist-get state :node-table)))) (ebox-runtime-index-get parent-id (plist-get state :node-table))))
(slot-sized-render-p (slot-sized-render-p
(and role-owned-lines-p parent (and role-owned-lines-p parent
(eq (ebox-tree-display-inner parent) 'flex))) (eq (ebox-tree-display-inner parent) 'flex)))
@ -3343,7 +3345,7 @@ old allocated width while the owner changes its natural content length."
(let* ((owner-id (plist-get proof :owner-id)) (let* ((owner-id (plist-get proof :owner-id))
(old-snapshot (plist-get proof :snapshot)) (old-snapshot (plist-get proof :snapshot))
(spans (plist-get old-snapshot :buffer-spans)) (spans (plist-get old-snapshot :buffer-spans))
(node (gethash owner-id (plist-get state :node-table))) (node (ebox-runtime-index-get owner-id (plist-get state :node-table)))
(render-node (render-node
(if (and node (numberp (plist-get proof :allocated-width))) (if (and node (numberp (plist-get proof :allocated-width)))
(plist-put (copy-sequence node) (plist-put (copy-sequence node)
@ -3566,7 +3568,7 @@ untouched."
(snapshot (and proof (plist-get proof :snapshot))) (snapshot (and proof (plist-get proof :snapshot)))
(old-spans (and proof (plist-get proof :old-spans))) (old-spans (and proof (plist-get proof :old-spans)))
(node (and owner-id (node (and owner-id
(gethash owner-id (plist-get state :node-table)))) (ebox-runtime-index-get owner-id (plist-get state :node-table))))
(allocated-width (and proof (allocated-width (and proof
(plist-get proof :allocated-width)))) (plist-get proof :allocated-width))))
(when (and proof snapshot old-spans node (when (and proof snapshot old-spans node
@ -3577,16 +3579,16 @@ untouched."
(parent-table (plist-get state :parent-table)) (parent-table (plist-get state :parent-table))
(ancestor-owner-ids (ancestor-owner-ids
(let ((walk (and parent-table (let ((walk (and parent-table
(gethash owner-id parent-table))) (ebox-runtime-index-get owner-id parent-table)))
owners) owners)
(while walk (while walk
(when-let* ((ancestor (when-let* ((ancestor
(gethash walk (plist-get state :node-table))) (ebox-runtime-index-get walk (plist-get state :node-table)))
(region-id (region-id
(ebox-surface--node-editable-region-id (ebox-surface--node-editable-region-id
ancestor))) ancestor)))
(setq owners (append owners (list region-id)))) (setq owners (append owners (list region-id))))
(setq walk (gethash walk parent-table))) (setq walk (ebox-runtime-index-get walk parent-table)))
owners)) owners))
(rendered (rendered
(ebox--maplines (ebox--maplines
@ -3965,11 +3967,11 @@ box with wrapper chrome falls back to the retained wrapper renderer."
(nodes (plist-get state :node-table))) (nodes (plist-get state :node-table)))
(and (plist-get state :runtime-index-prepared-p) (and (plist-get state :runtime-index-prepared-p)
root-id root-id
(hash-table-p nodes) (ebox-runtime-index-like-p nodes)
(eq root (gethash root-id nodes)) (eq root (ebox-runtime-index-get root-id nodes))
(hash-table-p (plist-get state :parent-table)) (ebox-runtime-index-like-p (plist-get state :parent-table))
(hash-table-p (plist-get state :region-id-set)) (hash-table-p (plist-get state :region-id-set))
(hash-table-p (plist-get state :region-node-table)) (ebox-runtime-index-like-p (plist-get state :region-node-table))
(hash-table-p (plist-get state :region-box-count-table)) (hash-table-p (plist-get state :region-box-count-table))
(hash-table-p (plist-get state :region-box-table)) (hash-table-p (plist-get state :region-box-table))
(hash-table-p (hash-table-p
@ -4075,7 +4077,7 @@ Each owner appears at most once for one rendered fragment."
owners) owners)
(dolist (region-id (delete-dups (mapcar #'cdr role-ids))) (dolist (region-id (delete-dups (mapcar #'cdr role-ids)))
(let ((object (gethash region-id region-objects)) (let ((object (gethash region-id region-objects))
(node-id (gethash region-id region-node-table))) (node-id (ebox-runtime-index-get region-id region-node-table)))
(unless (and object node-id) (unless (and object node-id)
(error "Ebox output references unknown region %S" region-id)) (error "Ebox output references unknown region %S" region-id))
(unless (gethash object attached) (unless (gethash object attached)
@ -4083,7 +4085,7 @@ Each owner appears at most once for one rendered fragment."
(ebox-surface--region-role-tags region-id role-ids)) (ebox-surface--region-role-tags region-id role-ids))
owners) owners)
(puthash object t attached)) (puthash object t attached))
(setq node-id (gethash node-id parent-table)) (setq node-id (ebox-runtime-index-get node-id parent-table))
(while node-id (while node-id
(let ((ancestor (gethash node-id node-objects))) (let ((ancestor (gethash node-id node-objects)))
(unless ancestor (unless ancestor
@ -4091,7 +4093,7 @@ Each owner appears at most once for one rendered fragment."
(unless (gethash ancestor attached) (unless (gethash ancestor attached)
(push (list ancestor (list :ebox/descendant-output t)) owners) (push (list ancestor (list :ebox/descendant-output t)) owners)
(puthash ancestor t attached))) (puthash ancestor t attached)))
(setq node-id (gethash node-id parent-table))))) (setq node-id (ebox-runtime-index-get node-id parent-table)))))
(nreverse owners))) (nreverse owners)))
(defun ebox-surface--rendered-fragments (rendered) (defun ebox-surface--rendered-fragments (rendered)
@ -4514,7 +4516,7 @@ all descendant ranges remain unchanged."
(let* ((proof (plist-get state :formatting-context-reflow-proof)) (let* ((proof (plist-get state :formatting-context-reflow-proof))
(owner-id (plist-get proof :owner-id)) (owner-id (plist-get proof :owner-id))
(owner (and owner-id (gethash owner-id node-objects))) (owner (and owner-id (gethash owner-id node-objects)))
(node (and owner-id (gethash owner-id (plist-get state :node-table)))) (node (and owner-id (ebox-runtime-index-get owner-id (plist-get state :node-table))))
(region-id (and node (plist-get node :region-id))) (region-id (and node (plist-get node :region-id)))
(block-start (block-start
(max 0 (max 0
@ -4720,7 +4722,7 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let ((key node-id) (let ((key node-id)
(parents (plist-get state :parent-table)) (parents (plist-get state :parent-table))
(depth 0)) (depth 0))
(while (setq node-id (and node-id (gethash node-id parents))) (while (setq node-id (and node-id (ebox-runtime-index-get node-id parents)))
(cl-incf depth)) (cl-incf depth))
(when ebox-surface--paint-node-depth-cache (when ebox-surface--paint-node-depth-cache
(puthash key depth ebox-surface--paint-node-depth-cache)) (puthash key depth ebox-surface--paint-node-depth-cache))
@ -4737,14 +4739,16 @@ NODE-OBJECTS and REGION-OBJECTS supply retained ownership ranges."
(let ((region-nodes (plist-get state :region-node-table)) (let ((region-nodes (plist-get state :region-node-table))
(parents (plist-get state :parent-table)) deepest deepest-depth) (parents (plist-get state :parent-table)) deepest deepest-depth)
(dolist (entry role-ids) (dolist (entry role-ids)
(when-let* ((node-id (gethash (cdr entry) region-nodes))) (when-let* ((node-id
(ebox-runtime-index-get
(cdr entry) region-nodes)))
(let ((depth (ebox-surface--node-depth state node-id))) (let ((depth (ebox-surface--node-depth state node-id)))
(when (or (null deepest-depth) (> depth deepest-depth)) (when (or (null deepest-depth) (> depth deepest-depth))
(setq deepest node-id deepest-depth depth))))) (setq deepest node-id deepest-depth depth)))))
(let (chain) (let (chain)
(while deepest (while deepest
(push deepest chain) (push deepest chain)
(setq deepest (gethash deepest parents))) (setq deepest (ebox-runtime-index-get deepest parents)))
(setq chain (nreverse chain)) (setq chain (nreverse chain))
(when ebox-surface--paint-node-chain-cache (when ebox-surface--paint-node-chain-cache
(puthash role-ids chain ebox-surface--paint-node-chain-cache)) (puthash role-ids chain ebox-surface--paint-node-chain-cache))
@ -4816,7 +4820,7 @@ ANCESTOR-P means BOX wraps a more specific rendered surface."
(let ((nodes (plist-get state :node-table)) result first) (let ((nodes (plist-get state :node-table)) result first)
(setq first t) (setq first t)
(dolist (node-id (ebox-surface--paint-node-chain state role-ids)) (dolist (node-id (ebox-surface--paint-node-chain state role-ids))
(when-let* ((node (gethash node-id nodes)) (when-let* ((node (ebox-runtime-index-get node-id nodes))
(box (ebox-fragment-style-source-node node))) (box (ebox-fragment-style-source-node node)))
(let* ((region-id (plist-get box :region-id)) (let* ((region-id (plist-get box :region-id))
(roles (roles
@ -5003,7 +5007,7 @@ relative face contributions and performs the final merge during prepare."
"Return FRAGMENTS with horizontal border roles updated from STATE." "Return FRAGMENTS with horizontal border roles updated from STATE."
(let ((nodes (plist-get state :node-table))) (let ((nodes (plist-get state :node-table)))
(dolist (dirty dirty-set fragments) (dolist (dirty dirty-set fragments)
(when-let* ((node (gethash (plist-get dirty :node-id) nodes)) (when-let* ((node (ebox-runtime-index-get (plist-get dirty :node-id) nodes))
(box (ebox-fragment-style-source-node node)) (box (ebox-fragment-style-source-node node))
(region-id (plist-get box :region-id))) (region-id (plist-get box :region-id)))
(dolist (entry '(((:border-top-width :border-top-style) (dolist (entry '(((:border-top-width :border-top-style)
@ -5084,7 +5088,7 @@ OLD-TEXT is a defensive snapshot of the published TP content."
(when (hash-table-p snapshots) (when (hash-table-p snapshots)
(dolist (dirty dirty-set) (dolist (dirty dirty-set)
(when-let* ((node-id (plist-get dirty :node-id)) (when-let* ((node-id (plist-get dirty :node-id))
(node (gethash node-id nodes)) (node (ebox-runtime-index-get node-id nodes))
(snapshot (gethash node-id snapshots))) (snapshot (gethash node-id snapshots)))
(plist-put snapshot :style-signature (plist-put snapshot :style-signature
(ebox-fragment-node-style-signature node))))) (ebox-fragment-node-style-signature node)))))

View File

@ -15,6 +15,7 @@
(require 'ebox-style) (require 'ebox-style)
(require 'ebox-node-factory) (require 'ebox-node-factory)
(require 'ebox-child-range) (require 'ebox-child-range)
(require 'ebox-runtime-index)
(defvar ebox-tree--incoming-source-indexes nil (defvar ebox-tree--incoming-source-indexes nil
"Transaction-local handle to incoming source-index map for one delta.") "Transaction-local handle to incoming source-index map for one delta.")
@ -739,8 +740,8 @@ handles, reused node objects, and cycles without consulting node metadata."
(defun ebox-tree--indexed-parent-context (defun ebox-tree--indexed-parent-context
(node-id node-table parent-table) (node-id node-table parent-table)
"Return the direct parent layout kind for NODE-ID in indexed tree." "Return the direct parent layout kind for NODE-ID in indexed tree."
(let* ((parent-id (gethash node-id parent-table)) (let* ((parent-id (ebox-runtime-index-get node-id parent-table))
(parent (and parent-id (gethash parent-id node-table)))) (parent (and parent-id (ebox-runtime-index-get parent-id node-table))))
(and parent (ebox-tree--child-layout-kind parent nil)))) (and parent (ebox-tree--child-layout-kind parent nil))))
(defun ebox-tree-validate-indexed-participation (defun ebox-tree-validate-indexed-participation
@ -748,7 +749,7 @@ handles, reused node objects, and cycles without consulting node metadata."
"Validate NODE-IDS in indexed final tree using AUTHOR or COMPUTED SOURCE." "Validate NODE-IDS in indexed final tree using AUTHOR or COMPUTED SOURCE."
(setq source (or source 'author)) (setq source (or source 'author))
(dolist (node-id (delete-dups (copy-sequence node-ids))) (dolist (node-id (delete-dups (copy-sequence node-ids)))
(when-let* ((node (gethash node-id node-table))) (when-let* ((node (ebox-runtime-index-get node-id node-table)))
(ebox-tree--validate-node-parent-participation (ebox-tree--validate-node-parent-participation
node node
(ebox-tree--indexed-parent-context node-id node-table parent-table) (ebox-tree--indexed-parent-context node-id node-table parent-table)
@ -1379,12 +1380,12 @@ stale until a query or full projection materializes them."
(parent-id (nth 2 entry)) (parent-id (nth 2 entry))
parent-subject) parent-subject)
(while (and parent-id (null parent-subject)) (while (and parent-id (null parent-subject))
(when-let* ((parent (gethash parent-id node-table))) (when-let* ((parent (ebox-runtime-index-get parent-id node-table)))
(when-let* ((parent-handle (when-let* ((parent-handle
(ebox-tree-node-source-handle parent))) (ebox-tree-node-source-handle parent)))
(setq parent-subject (node-subject parent-handle)))) (setq parent-subject (node-subject parent-handle))))
(unless parent-subject (unless parent-subject
(setq parent-id (gethash parent-id parent-table)))) (setq parent-id (ebox-runtime-index-get parent-id parent-table))))
(setf (ecss-subject-parent subject) parent-subject) (setf (ecss-subject-parent subject) parent-subject)
(puthash (ebox-source--handle-id-view handle) (puthash (ebox-source--handle-id-view handle)
subject added-subjects) subject added-subjects)

16
ebox.el
View File

@ -23,7 +23,8 @@
"Directory containing the active Ebox Lisp sources.") "Directory containing the active Ebox Lisp sources.")
(defconst ebox--compile-sources (defconst ebox--compile-sources
'("ebox-cache.el" "ebox-source.el" "ebox-state-contract.el" '("ebox-cache.el" "ebox-source.el" "ebox-runtime-index.el"
"ebox-state-contract.el"
"ebox-font.el" "ebox-style.el" "ebox-font.el" "ebox-style.el"
"ebox-layout-config.el" "ebox-layout-config.el"
"ebox-node-factory.el" "ebox-node-factory.el"
@ -44,6 +45,7 @@
(require 'subr-x) (require 'subr-x)
(require 'ebox-cache) (require 'ebox-cache)
(require 'ebox-source) (require 'ebox-source)
(require 'ebox-runtime-index)
(require 'ebox-state-contract) (require 'ebox-state-contract)
(require 'ebox-font) (require 'ebox-font)
(require 'ebox-style) (require 'ebox-style)
@ -1141,7 +1143,7 @@ remain transaction-local."
(let* ((template-box (plist-get template :box)) (let* ((template-box (plist-get template :box))
(node-id (and template-box (ebox--ensure-node-id template-box))) (node-id (and template-box (ebox--ensure-node-id template-box)))
(node-table (ebox--buffer-node-table (current-buffer)))) (node-table (ebox--buffer-node-table (current-buffer))))
(or (and node-table node-id (gethash node-id node-table)) (or (and node-table node-id (ebox-runtime-index-get node-id node-table))
(plist-get (ebox--scroll-get-state region-id) :box) (plist-get (ebox--scroll-get-state region-id) :box)
(gethash region-id ebox--region-box-table)))) (gethash region-id ebox--region-box-table))))
@ -1164,7 +1166,7 @@ remain transaction-local."
(or (ebox-get effective-box :scroll-offset) 0)) (or (ebox-get effective-box :scroll-offset) 0))
(or portable (or portable
(null node-table) (null node-table)
(eq box (gethash node-id node-table))) (eq box (ebox-runtime-index-get node-id node-table)))
(or (null live-state) (or (null live-state)
(eq effective-box (plist-get live-state :box))) (eq effective-box (plist-get live-state :box)))
(not (plist-get live-state :lazy-scroll-prefix-dirty)) (not (plist-get live-state :lazy-scroll-prefix-dirty))
@ -2931,7 +2933,9 @@ Scroll routing uses semantic ancestry rather than mount span length because
nested owners may render equal-sized clipped spans." nested owners may render equal-sized clipped spans."
(let* ((state (ebox--buffer-render-state (current-buffer))) (let* ((state (ebox--buffer-render-state (current-buffer)))
(region-nodes (plist-get state :region-node-table)) (region-nodes (plist-get state :region-node-table))
(node-id (and region-nodes (gethash region-id region-nodes)))) (node-id
(and region-nodes
(ebox-runtime-index-get region-id region-nodes))))
(if node-id (ebox-surface--node-depth state node-id) -1))) (if node-id (ebox-surface--node-depth state node-id) -1)))
(defun ebox--scroll-region-ids-in-buffer-outer-first () (defun ebox--scroll-region-ids-in-buffer-outer-first ()
@ -4110,7 +4114,7 @@ cannot be changed through the unpublished batch root."
entries) entries)
(let ((parents (ebox--buffer-parent-table buffer)) ancestors) (let ((parents (ebox--buffer-parent-table buffer)) ancestors)
(dolist (node-id node-ids) (dolist (node-id node-ids)
(while (setq node-id (gethash node-id parents)) (while (setq node-id (ebox-runtime-index-get node-id parents))
(push node-id ancestors))) (push node-id ancestors)))
(delete-dups ancestors)))) (delete-dups ancestors))))
@ -4122,7 +4126,7 @@ cannot be changed through the unpublished batch root."
(let ((parents (ebox--buffer-parent-table buffer))) (let ((parents (ebox--buffer-parent-table buffer)))
(delete-dups (delete-dups
(delq nil (delq nil
(mapcar (lambda (node-id) (gethash node-id parents)) (mapcar (lambda (node-id) (ebox-runtime-index-get node-id parents))
node-ids)))))) node-ids))))))
(defun ebox--publish-scoped-region-candidate (defun ebox--publish-scoped-region-candidate

View File

@ -355,8 +355,8 @@
(should-not (plist-member empty-record :sequence)) (should-not (plist-member empty-record :sequence))
(should (= (plist-get empty-resolved :rank) 1)) (should (= (plist-get empty-resolved :rank) 1))
(should (= (plist-get items-resolved :rank) 1)) (should (= (plist-get items-resolved :rank) 1))
(should (= (hash-table-count (plist-get state :node-table)) (should (= (ebox-runtime-index-size (plist-get state :node-table))
(hash-table-count (plist-get direct-state :node-table)))) (ebox-runtime-index-size (plist-get direct-state :node-table))))
(should (= (hash-table-count (plist-get state :region-id-set)) (should (= (hash-table-count (plist-get state :region-id-set))
(hash-table-count (hash-table-count
(plist-get direct-state :region-id-set)))) (plist-get direct-state :region-id-set))))
@ -482,7 +482,9 @@
(node-id (node-id
(gethash ref (gethash ref
(ebox-child-range-test--host-ref-table state))) (ebox-child-range-test--host-ref-table state)))
(node (gethash node-id (plist-get state :node-table)))) (node
(ebox-runtime-index-get
node-id (plist-get state :node-table))))
(should node-id) (should node-id)
(should (equal (should (equal
(ebox-child-range-test--node-key (ebox-child-range-test--node-key
@ -668,7 +670,7 @@
(ebox-commit buffer candidate)) (ebox-commit buffer candidate))
(let* ((state (ebox--buffer-render-state buffer)) (let* ((state (ebox--buffer-render-state buffer))
(record (gethash 'items (plist-get state :range-ref-table))) (record (gethash 'items (plist-get state :range-ref-table)))
(parent (gethash (plist-get record :parent-node-id) (parent (ebox-runtime-index-get (plist-get record :parent-node-id)
(plist-get state :node-table))) (plist-get state :node-table)))
(segment (segment
(ebox-child-range--lookup-ref (ebox-child-range--lookup-ref
@ -742,7 +744,7 @@
(ebox-commit buffer candidate)) (ebox-commit buffer candidate))
(let* ((state (ebox--buffer-render-state buffer)) (let* ((state (ebox--buffer-render-state buffer))
(record (gethash 'items (plist-get state :range-ref-table))) (record (gethash 'items (plist-get state :range-ref-table)))
(parent (gethash (plist-get record :parent-node-id) (parent (ebox-runtime-index-get (plist-get record :parent-node-id)
(plist-get state :node-table))) (plist-get state :node-table)))
(segment (segment
(ebox-child-range--lookup-ref (ebox-child-range--lookup-ref
@ -1208,7 +1210,7 @@
node-id node-id
(plist-get state (plist-get state
:surface-node-object-table)))) :surface-node-object-table))))
(should (eq node (gethash node-id (should (eq node (ebox-runtime-index-get node-id
(plist-get state :node-table)))) (plist-get state :node-table))))
(should object) (should object)
(should (eq object (plist-get node :surface-object)))))))) (should (eq object (plist-get node :surface-object))))))))
@ -1301,7 +1303,9 @@
(current-id (current-id
(gethash 'child (gethash 'child
(ebox-child-range-test--host-ref-table state))) (ebox-child-range-test--host-ref-table state)))
(node (gethash current-id (plist-get state :node-table)))) (node
(ebox-runtime-index-get
current-id (plist-get state :node-table))))
(when node-id (should (equal node-id current-id))) (when node-id (should (equal node-id current-id)))
(setq node-id current-id) (setq node-id current-id)
(should (plist-get node :ebox-sequence-location)))) (should (plist-get node :ebox-sequence-location))))

View File

@ -43,9 +43,10 @@
(defun ebox-commit-test--hash-facts (table &optional values) (defun ebox-commit-test--hash-facts (table &optional values)
"Return sorted TABLE keys, or key/value pairs when VALUES is non-nil." "Return sorted TABLE keys, or key/value pairs when VALUES is non-nil."
(let (facts) (let (facts)
(maphash (lambda (key value) (ebox-runtime-index-map
(push (if values (cons key value) key) facts)) (lambda (key value)
table) (push (if values (cons key value) key) facts))
table)
(sort facts (sort facts
(lambda (left right) (lambda (left right)
(string< (prin1-to-string left) (string< (prin1-to-string left)
@ -653,7 +654,7 @@
new-root new-source-index)) new-root new-source-index))
(new-index (ebox--runtime-index new-root t new-source-index)) (new-index (ebox--runtime-index new-root t new-source-index))
(root-id (plist-get old-root :node-id))) (root-id (plist-get old-root :node-id)))
(maphash (lambda (node-id _node) (ebox-runtime-index-map (lambda (node-id _node)
(puthash node-id (list 'object node-id) old-objects)) (puthash node-id (list 'object node-id) old-objects))
(plist-get old-index :node-table)) (plist-get old-index :node-table))
(let* ((old-state (append (list :root-node old-root (let* ((old-state (append (list :root-node old-root
@ -700,7 +701,7 @@
new-root new-source-index)) new-root new-source-index))
(new-index (ebox--runtime-index new-root t new-source-index)) (new-index (ebox--runtime-index new-root t new-source-index))
(root-id (plist-get old-root :node-id))) (root-id (plist-get old-root :node-id)))
(maphash (lambda (node-id _node) (ebox-runtime-index-map (lambda (node-id _node)
(puthash node-id (list 'object node-id) old-objects)) (puthash node-id (list 'object node-id) old-objects))
(plist-get old-index :node-table)) (plist-get old-index :node-table))
(let ((old-state (append (list :root-node old-root (let ((old-state (append (list :root-node old-root
@ -1342,20 +1343,24 @@ remain retained identities."
(node-table (plist-get state :node-table)) (node-table (plist-get state :node-table))
(parent-table (plist-get state :parent-table)) (parent-table (plist-get state :parent-table))
(node-id (and region-node-table (node-id (and region-node-table
(gethash value region-node-table))) (ebox-runtime-index-get
value region-node-table)))
(source-node-id node-id) (source-node-id node-id)
(root-node-id (root-node-id
(plist-get (plist-get state :root-node) (plist-get (plist-get state :root-node)
:node-id)) :node-id))
key) key)
(while (and node-id (not key)) (while (and node-id (not key))
(when-let* ((node (gethash node-id node-table))) (when-let* ((node
(ebox-runtime-index-get
node-id node-table)))
(setq key (setq key
(ebox-tree-node-key (ebox-tree-node-key
(plist-get state :source-index) node))) (plist-get state :source-index) node)))
(setq node-id (setq node-id
(and (not key) (and (not key)
(gethash node-id parent-table)))) (ebox-runtime-index-get
node-id parent-table))))
(or key (or key
(and (equal source-node-id root-node-id) 'root) (and (equal source-node-id root-node-id) 'root)
value)) value))
@ -2587,6 +2592,187 @@ remain retained identities."
(ebox-native-reflow--persistent-index-get next 17))) (ebox-native-reflow--persistent-index-get next 17)))
(should-not (eq base next)))) (should-not (eq base next))))
(ert-deftest ebox-logical-candidate-path-copies-runtime-indexes-only ()
"A local logical commit shares its base and never copies a complete core map."
(let* ((input
(ebox-test-column
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "old"))
(ebox-test-box :key 'tail (ebox-test-text "tail"))))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-runtime-index-local*") input))
(old-state (ebox--buffer-render-state buffer))
(old-nodes (plist-get old-state :node-table))
(old-parents (plist-get old-state :parent-table))
(old-regions (plist-get old-state :region-node-table))
(old-postorder (plist-get old-state :native-node-postorder))
(old-message (ebox--host-ref-node buffer 'message))
(original-copy (symbol-function 'copy-hash-table))
copied-core)
(unwind-protect
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'message
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "new")))
(cl-letf (((symbol-function 'copy-hash-table)
(lambda (table)
(when (memq table
(list old-nodes old-parents old-regions))
(setq copied-core t))
(funcall original-copy table))))
(ebox-commit buffer candidate))
(let* ((state (ebox--buffer-render-state buffer))
(nodes (plist-get state :node-table))
(parents (plist-get state :parent-table))
(regions (plist-get state :region-node-table)))
(should-not copied-core)
(should (ebox-runtime-index-p nodes))
(should (ebox-runtime-index-p parents))
(should (ebox-runtime-index-p regions))
(should-not (eq nodes old-nodes))
(should (eq regions old-regions))
(should (eq (plist-get state :native-node-postorder)
old-postorder))
(should (eq (plist-get state :native-node-postorder-ids)
old-postorder))
(should (eq (ebox-runtime-index-get
(plist-get old-message :node-id) old-nodes)
old-message))
(should
(cl-every
(lambda (node-id)
(ebox-runtime-index-get node-id nodes))
old-postorder))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-logical-candidate-converts-legacy-native-postorder ()
"Legacy and mixed vectors resolve every entry against candidate nodes."
(let* ((old-leaf '(:ebox-type text :node-id 1 :content "old"))
(old-root (list :ebox-type 'column :node-id 2
:children (list old-leaf)))
(new-leaf '(:ebox-type text :node-id 1 :content "new"))
(new-root (list :ebox-type 'column :node-id 2
:children (list new-leaf))))
(dolist (table (list (ebox-runtime-index-empty)
(make-hash-table :test 'equal)))
(setq table (ebox-runtime-index-put 1 new-leaf table)
table (ebox-runtime-index-put 2 new-root table))
(dolist (legacy (list (vector old-leaf old-root)
(vector 1 old-root)
(vector old-leaf 2)))
(let* ((before (copy-sequence legacy))
(state (list :native-node-postorder legacy
:native-node-postorder-ids (vector 1 2)))
(postorder
(ebox-incremental--candidate-retain-native-postorder
state table)))
(should (equal postorder [1 2]))
(should-not (eq postorder legacy))
(should (equal legacy before))
(should (eq (ebox-native-reflow--postorder-node
(aref postorder 0) table)
new-leaf))
(should (eq (ebox-native-reflow--postorder-node
(aref postorder 1) table)
new-root)))))))
(ert-deftest ebox-logical-candidate-native-postorder-validates-legacy-membership ()
"Unmarked retained entries reject missing candidate nodes; empty is valid."
(let* ((node '(:ebox-type text :node-id 1 :content "old"))
(table (ebox-runtime-index-empty)))
(should-error
(ebox-incremental--candidate-retain-native-postorder
(list :native-node-postorder (vector node)) table)
:type 'error)
(should (equal
(ebox-incremental--candidate-retain-native-postorder
(list :native-node-postorder []) table)
[]))
(should-not
(ebox-incremental--candidate-retain-native-postorder nil table))))
(ert-deftest ebox-logical-candidate-retains-native-id-postorder-without-lookups ()
"Generated ID vectors retain their exact identity without walking nodes."
(let* ((input (ebox-test-column (ebox-test-text "retained")))
(root (ebox-test-root input))
(index (ebox--runtime-index root nil (ebox-test-source-index input)))
(postorder (plist-get index :native-node-postorder)))
(should (eq postorder (plist-get index :native-node-postorder-ids)))
(cl-letf (((symbol-function 'ebox-runtime-index-get)
(lambda (&rest _arguments)
(ert-fail "Generated native ID postorder was remapped"))))
(should (eq postorder
(ebox-incremental--candidate-retain-native-postorder
index (plist-get index :node-table)))))))
(defun ebox-test--native-topology-full-gate-fixture ()
"Return `(BUFFER OLD-STATE CANDIDATE-STATE PREPARED TAIL)' for a paint edit."
(let* ((previous-message
(ebox-test-box :key 'message :source-identity 'message
:background-color "#111111"
(ebox-test-text "message")))
(previous
(ebox-test-column
previous-message
(ebox-test-box :key 'tail :source-identity 'tail
(ebox-test-text "tail"))))
(next
(ebox-test-box :key 'message :source-identity 'message
:background-color "#222222"
(ebox-test-text "message")))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-topology-authority*") previous))
(old-state (ebox--buffer-render-state buffer))
(candidate (ebox-candidate-begin buffer)))
(unless (ebox-candidate-patch-host-paint
candidate 'message
previous-message next)
(error "Topology authority fixture paint patch was rejected"))
(let* ((prepared
(ebox-incremental--prepare-logical-candidate
buffer old-state candidate))
(candidate-state
(ebox-incremental--candidate-state
old-state (plist-get prepared :root)
(plist-get prepared :index) prepared)))
(list buffer old-state candidate-state prepared
(ebox--host-ref-node buffer 'tail)))))
(ert-deftest ebox-native-topology-full-gate-rejects-untouched-object-loss ()
"The full topology gate rejects a missing untouched surface object."
(pcase-let ((`(,buffer ,old-state ,candidate-state ,prepared ,tail)
(ebox-test--native-topology-full-gate-fixture)))
(unwind-protect
(progn
(should (ebox-native-commit-topology-stable-p
old-state candidate-state prepared))
(remhash (plist-get tail :node-id)
(plist-get old-state :surface-node-object-table))
(should-not (ebox-native-commit-topology-stable-p
old-state candidate-state prepared)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-native-topology-full-gate-rejects-untouched-source-key-change ()
"The full topology gate rejects an untouched source key change."
(pcase-let ((`(,buffer ,old-state ,candidate-state ,prepared ,tail)
(ebox-test--native-topology-full-gate-fixture)))
(unwind-protect
(progn
(should (ebox-native-commit-topology-stable-p
old-state candidate-state prepared))
(let* ((source-index (plist-get candidate-state :source-index))
(binding
(ebox-source-index-rebind
source-index (ebox-tree-node-source-handle tail)
:key 'tampered-tail)))
(plist-put candidate-state :source-index (car binding)))
(should-not (ebox-native-commit-topology-stable-p
old-state candidate-state prepared)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-native-session-fork-shares-immutable-compiler-roots () (ert-deftest ebox-native-session-fork-shares-immutable-compiler-roots ()
"Forking does not clone the retained fragment map or persistent indexes." "Forking does not clone the retained fragment map or persistent indexes."
(require 'ebox-native-reflow) (require 'ebox-native-reflow)

View File

@ -875,6 +875,31 @@
(when (and buffer (buffer-live-p buffer)) (when (and buffer (buffer-live-p buffer))
(kill-buffer buffer))))) (kill-buffer buffer)))))
(ert-deftest ebox-runtime-bootstrap-uses-persistent-core-indexes-and-id-postorder ()
"Runtime bootstrap stores persistent core indexes and stable node ids."
(ebox-test--reset-runtime-state)
(let* ((input
(ebox-test-column
(ebox-test-box :key 'left (ebox-test-text "Left"))
(ebox-test-box :key 'right (ebox-test-text "Right"))))
(root (ebox-test-root input))
(index (ebox--runtime-index root t (ebox-test-source-index input)))
(nodes (plist-get index :node-table))
(postorder (plist-get index :native-node-postorder)))
(should (ebox-runtime-index-p nodes))
(should (ebox-runtime-index-p (plist-get index :parent-table)))
(should (ebox-runtime-index-p (plist-get index :region-node-table)))
(should (vectorp postorder))
(should (> (length postorder) 0))
(should
(cl-every
(lambda (node-id)
(and (not (listp node-id))
(ebox-runtime-index-get node-id nodes)))
postorder))
(should (equal (aref postorder (1- (length postorder)))
(plist-get root :node-id)))))
(ert-deftest ebox-region-render-owner-index-keeps-earlier-duplicate-box () (ert-deftest ebox-region-render-owner-index-keeps-earlier-duplicate-box ()
"A later flex wrapper should not replace an earlier duplicate region owner." "A later flex wrapper should not replace an earlier duplicate region owner."
(ebox-test--reset-runtime-state) (ebox-test--reset-runtime-state)
@ -894,7 +919,7 @@
(expected (car (ebox--node-path-to-region (expected (car (ebox--node-path-to-region
layout-node region-id)))) layout-node region-id))))
(should (eq expected plain-node)) (should (eq expected plain-node))
(should (equal (gethash region-id table) (should (equal (ebox-runtime-index-get region-id table)
(ebox--ensure-node-id expected)))))) (ebox--ensure-node-id expected))))))
(ert-deftest ebox-region-render-owner-index-falls-back-for-legacy-state () (ert-deftest ebox-region-render-owner-index-falls-back-for-legacy-state ()
@ -2440,7 +2465,7 @@
(should (eq (plist-get report :constraint-owner-type) 'box)) (should (eq (plist-get report :constraint-owner-type) 'box))
(should (should
(equal (plist-get report :constraint-owner-id) (equal (plist-get report :constraint-owner-id)
(gethash left-id (ebox-runtime-index-get left-id
(ebox--buffer-region-node-table (ebox--buffer-region-node-table
(current-buffer))))) (current-buffer)))))
(should (equal (plist-get report :dirty-kinds) (should (equal (plist-get report :dirty-kinds)

View File

@ -24,14 +24,16 @@
(defconst ebox-docs-test--active-files (defconst ebox-docs-test--active-files
'("Makefile" ".github/workflows/ci.yml" '("Makefile" ".github/workflows/ci.yml"
"ebox.el" "ebox-cache.el" "ebox-state-contract.el" "ebox-style.el" "ebox.el" "ebox-cache.el" "ebox-runtime-index.el"
"ebox-state-contract.el" "ebox-style.el"
"ebox-child-range.el" "ebox-tree.el" "ebox-child-range.el" "ebox-tree.el"
"ebox-measure.el" "ebox-fragment.el" "ebox-render-context.el" "ebox-measure.el" "ebox-fragment.el" "ebox-render-context.el"
"ebox-layout.el" "ebox-flex.el" "ebox-grid.el" "ebox-layout.el" "ebox-flex.el" "ebox-grid.el"
"ebox-buffer-backend.el" "ebox-patch-plan.el" "ebox-incremental.el" "ebox-buffer-backend.el" "ebox-patch-plan.el" "ebox-incremental.el"
"ebox-surface.el" "ebox-dsl.el" "ebox-spi.el" "ebox-surface.el" "ebox-dsl.el" "ebox-spi.el"
"ebox-selector.el" "ebox-native-reflow.el" "ebox-selector.el" "ebox-native-reflow.el"
"tests/ebox-core-render-tests.el" "tests/ebox-state-contract-tests.el" "tests/ebox-core-render-tests.el" "tests/ebox-runtime-index-tests.el"
"tests/ebox-state-contract-tests.el"
"tests/ebox-layout-boundary-tests.el" "tests/ebox-layout-boundary-tests.el"
"tests/ebox-patch-plan-tests.el" "tests/ebox-patch-plan-tests.el"
"tests/ebox-style-schema-tests.el" "tests/ebox-style-schema-tests.el"
@ -50,7 +52,8 @@
"Active Ebox files that the maintainer map must cover.") "Active Ebox files that the maintainer map must cover.")
(defconst ebox-docs-test--targets (defconst ebox-docs-test--targets
'("check" "ci" "load" "compile" "core-tests" "child-range-tests" "grid-tests" '("check" "ci" "load" "compile" "core-tests" "runtime-index-tests"
"child-range-tests" "grid-tests"
"ebox-commit-tests" "surface-tests" "visual-check-tests" "package-tests" "ebox-commit-tests" "surface-tests" "visual-check-tests" "package-tests"
"selector-tests" "dsl-tests" "flex-tests" "state-contract-tests" "selector-tests" "dsl-tests" "flex-tests" "state-contract-tests"
"layout-boundary-tests" "layout-boundary-performance" "layout-boundary-tests" "layout-boundary-performance"

View File

@ -156,7 +156,8 @@
(should (commandp 'ebox-byte-compile)) (should (commandp 'ebox-byte-compile))
(should (should
(equal ebox--compile-sources (equal ebox--compile-sources
'("ebox-cache.el" "ebox-source.el" "ebox-state-contract.el" '("ebox-cache.el" "ebox-source.el" "ebox-runtime-index.el"
"ebox-state-contract.el"
"ebox-font.el" "ebox-style.el" "ebox-font.el" "ebox-style.el"
"ebox-layout-config.el" "ebox-layout-config.el"
"ebox-node-factory.el" "ebox-node-factory.el"

View File

@ -0,0 +1,295 @@
;;; ebox-runtime-index-tests.el --- Runtime index tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'ebox-runtime-index)
(defun ebox-runtime-index-test--shape (index)
"Validate compressed INDEX and return `(BRANCHES LEAVES MAX-DEPTH)'."
(let ((branches 0) (leaves 0) (max-depth 0))
(cl-labels
((visit (node depth parent-shift mask prefix)
(setq max-depth (max max-depth depth))
(cond
((vectorp node)
(should (= (length node) 18))
(let ((shift (aref node 0))
(code (aref node 1))
(children 0))
(should (and (integerp shift) (<= 0 shift 60)
(= (% shift 4) 0) (> shift parent-shift)))
(should (= (logand code mask) prefix))
(cl-incf branches)
(dotimes (slot 16)
(when-let* ((child (aref node (+ slot 2))))
(cl-incf children)
(visit child (1+ depth) shift
(1- (ash 1 (+ shift 4)))
(logior (logand code (1- (ash 1 shift)))
(ash slot shift)))))
(should (>= children 2))))
(node
(should (and (consp node) (integerp (car node)) (cdr node)))
(should (= (logand (car node) mask) prefix))
(dolist (entry (cdr node))
(should (= (ebox-runtime-index--code (car entry))
(car node))))
(cl-incf leaves)))))
(visit (ebox-runtime-index-root index) 0 -1 0 0))
(list branches leaves max-depth)))
(ert-deftest ebox-runtime-index-persistent-update-isolates-base ()
(let* ((base (ebox-runtime-index-put 1 'old (ebox-runtime-index-empty)))
(changed (ebox-runtime-index-put 1 'new base))
(added (ebox-runtime-index-put 17 nil changed))
(deleted (ebox-runtime-index-delete 1 added)))
(should (eq (ebox-runtime-index-get 1 base) 'old))
(should (eq (ebox-runtime-index-get 1 changed) 'new))
(should (ebox-runtime-index-contains-p 17 added))
(should-not (ebox-runtime-index-get 17 added 'missing))
(should-not (ebox-runtime-index-contains-p 1 deleted))
(should (ebox-runtime-index-key-set-equal-p base changed))
(should-not (ebox-runtime-index-key-set-equal-p base added))
(should-not (ebox-runtime-index-key-set-equal-p base deleted))
(should (= (ebox-runtime-index-size base) 1))
(should (= (ebox-runtime-index-size added) 2))
(should (= (ebox-runtime-index-size deleted) 1))))
(ert-deftest ebox-runtime-index-key-set-proof-does-not-enumerate-persistent-indexes ()
(let* ((base (ebox-runtime-index-put 1 'old (ebox-runtime-index-empty)))
(changed (ebox-runtime-index-put 1 'new base)))
(cl-letf (((symbol-function 'ebox-runtime-index-map)
(lambda (&rest _args)
(ert-fail "persistent key-set proof enumerated its input"))))
(should (ebox-runtime-index-key-set-equal-p base changed)))))
(ert-deftest ebox-runtime-index-key-set-equality-supports-independent-indexes ()
(let ((left (ebox-runtime-index-empty))
(right (ebox-runtime-index-empty)))
(dolist (key '(1 17 33))
(setq left (ebox-runtime-index-put key key left)))
(dolist (key '(33 17 1))
(setq right (ebox-runtime-index-put key nil right)))
(should (ebox-runtime-index-key-set-equal-p left right))))
(ert-deftest ebox-runtime-index-preserves-equal-key-collisions ()
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (_key) 0)))
(let* ((base (ebox-runtime-index-empty))
(one (ebox-runtime-index-put '(same code one) 1 base))
(two (ebox-runtime-index-put '(same code two) 2 one)))
(should (= (ebox-runtime-index-get '(same code one) two) 1))
(should (= (ebox-runtime-index-get '(same code two) two) 2))
(should (= (ebox-runtime-index-size two) 2)))))
(ert-deftest ebox-runtime-index-map-and-keys-cover-exact-entries ()
(let ((index (ebox-runtime-index-empty))
entries)
(dolist (pair '((5 . five) (1 . one) (9 . nine)))
(setq index (ebox-runtime-index-put (car pair) (cdr pair) index)))
(ebox-runtime-index-map
(lambda (key value) (push (cons key value) entries)) index)
(should (equal (sort entries (lambda (a b) (< (car a) (car b))))
'((1 . one) (5 . five) (9 . nine))))
(should (equal (sort (ebox-runtime-index-keys index) #'<) '(1 5 9)))))
(ert-deftest ebox-runtime-index-adapters-accept-legacy-hash-tables ()
(let ((table (make-hash-table :test #'equal)))
(should (eq (ebox-runtime-index-put 'key nil table) table))
(should (ebox-runtime-index-contains-p 'key table))
(should (= (ebox-runtime-index-size table) 1))
(should (equal (ebox-runtime-index-keys table) '(key)))
(should (eq (ebox-runtime-index-delete 'key table) table))
(should (= (ebox-runtime-index-size table) 0))))
(ert-deftest ebox-runtime-index-update-work-is-bounded-by-changed-keys ()
"Path-copy work grows with changed keys rather than retained index size."
(dolist (case '((32 . 2) (128 . 2) (512 . 3)))
(let ((size (car case))
(max-depth (cdr case))
(base (ebox-runtime-index-empty)))
(dotimes (id size)
(setq base (ebox-runtime-index-put id id base)))
(dolist (changed-count '(1 4 16))
(let ((next base)
(vector-copies 0)
(original-copy (symbol-function 'copy-sequence)))
(cl-letf (((symbol-function 'copy-sequence)
(lambda (sequence)
(when (vectorp sequence)
(cl-incf vector-copies))
(funcall original-copy sequence))))
(dotimes (id changed-count)
(setq next (ebox-runtime-index-put id (- id) next))))
(should (<= vector-copies (* changed-count max-depth)))
(should (= (ebox-runtime-index-size next) size))
(should (= (ebox-runtime-index-get (1- size) base) (1- size)))
(should (= (ebox-runtime-index-get 0 base) 0)))))))
(ert-deftest ebox-runtime-index-compresses-prefixes-for-generic-keys ()
"Noninteger keys with long shared codes keep only real branching levels."
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (key) (logior #x123456789a (ash (cadr key) 40)))))
(let ((index (ebox-runtime-index-empty)))
(dotimes (id 128)
(setq index (ebox-runtime-index-put (list 'key id) id index)))
(pcase-let ((`(,branches ,leaves ,depth)
(ebox-runtime-index-test--shape index)))
(should (= branches 17))
(should (= leaves 128))
(should (= depth 2)))
(dotimes (id 128)
(should (= (ebox-runtime-index-get (list 'key id) index) id))))))
(ert-deftest ebox-runtime-index-splits-prefixes-and-collapses-deleted-branches ()
"Splitting above retained branches and deleting representatives isolate forks."
(let ((index (ebox-runtime-index-empty)) snapshots)
(dolist (key '(#x1100 #x2100 #x0101 #x1110 #x3110))
(push index snapshots)
(setq index (ebox-runtime-index-put key key index))
(ebox-runtime-index-test--shape index))
(let ((base index))
;; The first key supplied representative codes to several branch nodes.
(setq index (ebox-runtime-index-delete #x1100 index))
(ebox-runtime-index-test--shape index)
(setq index (ebox-runtime-index-put #x4110 'later index))
(ebox-runtime-index-test--shape index)
(should (= (ebox-runtime-index-get #x1100 base) #x1100))
(should-not (ebox-runtime-index-contains-p #x4110 base))
(should (eq (ebox-runtime-index-get #x4110 index) 'later))
(dolist (key '(#x2100 #x0101 #x1110 #x3110))
(setq index (ebox-runtime-index-delete key index))
(ebox-runtime-index-test--shape index))
(should (equal (ebox-runtime-index-test--shape index) '(0 1 0)))
(should (eq index (ebox-runtime-index-delete 'absent index)))
(setq index (ebox-runtime-index-delete #x4110 index))
(should (= (ebox-runtime-index-size index) 0))
(should-not (ebox-runtime-index-root index)))
(cl-loop for snapshot in snapshots
for count downfrom 4
do (should (= (ebox-runtime-index-size snapshot) count))
do (ebox-runtime-index-test--shape snapshot))))
(ert-deftest ebox-runtime-index-preserves-truncated-large-integer-collisions ()
"Keys differing above bit 63 retain independent exact values and membership."
(let* ((small 7)
(large (+ 7 (ash 1 80)))
(larger (+ 7 (ash 1 100)))
(base (ebox-runtime-index-put small 'small (ebox-runtime-index-empty)))
(base (ebox-runtime-index-put large nil base))
(base (ebox-runtime-index-put larger 'larger base))
(changed (ebox-runtime-index-put large 'large base))
(deleted (ebox-runtime-index-delete small changed)))
(should (= (ebox-runtime-index--code small)
(ebox-runtime-index--code larger)))
(should (= (ebox-runtime-index-size base) 3))
(should (ebox-runtime-index-contains-p large base))
(should-not (ebox-runtime-index-get large base 'missing))
(should (eq (ebox-runtime-index-get large deleted) 'large))
(should (eq (ebox-runtime-index-get larger deleted) 'larger))
(should-not (ebox-runtime-index-contains-p small deleted))
(should (ebox-runtime-index-key-set-equal-p base changed))
(should (equal (ebox-runtime-index-test--shape deleted) '(0 1 0)))))
(ert-deftest ebox-runtime-index-branches-at-the-highest-code-nibble ()
"The compressed prefix arithmetic covers all 64 code bits."
(let ((index (ebox-runtime-index-empty)))
(dolist (key (list 0 (ash 1 60) (ash 1 63)))
(setq index (ebox-runtime-index-put key key index)))
(should (equal (ebox-runtime-index-test--shape index) '(1 3 1)))
(should (= (aref (ebox-runtime-index-root index) 0) 60))
(setq index (ebox-runtime-index-delete 0 index))
(setq index (ebox-runtime-index-put (ash 1 62) 'later index))
(ebox-runtime-index-test--shape index)
(should (= (ebox-runtime-index-get (ash 1 63) index) (ash 1 63)))
(should (eq (ebox-runtime-index-get (ash 1 62) index) 'later))))
(ert-deftest ebox-runtime-index-put-discovers-membership-in-one-traversal ()
"Insertion and replacement do not perform a separate membership lookup."
(let ((base (ebox-runtime-index-put 'one nil (ebox-runtime-index-empty))))
(cl-letf (((symbol-function 'ebox-runtime-index--root-get)
(lambda (&rest _arguments)
(ert-fail "Put performed a preliminary membership lookup"))))
(should (= (ebox-runtime-index-size
(ebox-runtime-index-put 'one 'changed base))
1))
(should (= (ebox-runtime-index-size
(ebox-runtime-index-put 'two nil base))
2)))))
(ert-deftest ebox-runtime-index-collision-updates-and-deletes-preserve-equal-keys ()
"Colliding noninteger keys compare with equal across immutable forks."
(cl-letf (((symbol-function 'ebox-runtime-index--code)
(lambda (_key) 23)))
(let* ((base (ebox-runtime-index-put
(list "key" 1) nil (ebox-runtime-index-empty)))
(base (ebox-runtime-index-put ["key" 2] 'two base))
(changed (ebox-runtime-index-put (list "key" 1) 'one base))
(deleted (ebox-runtime-index-delete (vector "key" 2) changed)))
(should (= (ebox-runtime-index-size changed) 2))
(should (ebox-runtime-index-contains-p (list "key" 1) base))
(should-not (ebox-runtime-index-get (list "key" 1) base 'missing))
(should (eq (ebox-runtime-index-get (list "key" 1) deleted) 'one))
(should-not (ebox-runtime-index-contains-p ["key" 2] deleted))
(should (eq (ebox-runtime-index-get ["key" 2] base) 'two))
(ebox-runtime-index-test--shape deleted))))
(ert-deftest ebox-runtime-index-map-visits-only-live-compressed-nodes ()
"Enumeration visits at most one leaf and one branch per distinct code."
(let ((index (ebox-runtime-index-empty))
(visits 0)
(entries 0)
(original (symbol-function 'ebox-runtime-index--map-root)))
(dotimes (id 512)
(setq index (ebox-runtime-index-put id id index)))
(cl-letf (((symbol-function 'ebox-runtime-index--map-root)
(lambda (&rest arguments)
(cl-incf visits)
(apply original arguments))))
(ebox-runtime-index-map
(lambda (_key _value) (cl-incf entries)) index))
(should (= entries 512))
(should (<= visits (1- (* entries 2))))))
(ert-deftest ebox-runtime-index-mixed-key-updates-match-hash-table ()
"Generic insertion/deletion sequences preserve exact facts and old snapshots."
(let ((keys (vector nil t -1 0 1 17 256 (ash 1 80) (1+ (ash 1 80))
"key" '(key . 1) '[key 2]))
(index (ebox-runtime-index-empty))
(expected (make-hash-table :test 'equal))
(random-state 1729)
snapshots)
(dotimes (step 256)
(setq random-state (mod (+ (* random-state 1103515245) 12345)
2147483648))
(let ((key (aref keys (% (/ random-state 16) (length keys))))
(value (and (/= (% step 7) 0) step)))
(if (= (% random-state 3) 0)
(progn
(setq index (ebox-runtime-index-delete key index))
(remhash key expected))
(setq index (ebox-runtime-index-put key value index))
(puthash key value expected)))
(should (= (ebox-runtime-index-size index) (hash-table-count expected)))
(ebox-runtime-index-test--shape index)
(cl-loop for key across keys do
(should (equal (ebox-runtime-index-get key index 'missing)
(gethash key expected 'missing))))
(when (= (% step 16) 0)
(push (cons index (copy-hash-table expected)) snapshots)))
(dolist (snapshot snapshots)
(ebox-runtime-index-test--shape (car snapshot))
(should (= (ebox-runtime-index-size (car snapshot))
(hash-table-count (cdr snapshot))))
(cl-loop for key across keys do
(should (equal
(ebox-runtime-index-get key (car snapshot) 'missing)
(gethash key (cdr snapshot) 'missing)))))))
(provide 'ebox-runtime-index-tests)
;;; ebox-runtime-index-tests.el ends here

View File

@ -396,7 +396,7 @@
(ebox-source-record-classes (ebox-source-record-classes
(ebox-source-index-record (ebox-source-index-record
old-index old-handle)))) old-index old-handle))))
(maphash (ebox-runtime-index-map
(lambda (_node-id node) (lambda (_node-id node)
(when (ebox-node-kind node) (when (ebox-node-kind node)
(should (ebox-source-index-record (should (ebox-source-index-record

View File

@ -501,7 +501,7 @@ candidate cannot hide mutations by restoring the old hash-table pointer."
(defun ebox-surface-test--object-by-key (state key) (defun ebox-surface-test--object-by-key (state key)
"Return the candidate surface object for Ebox node KEY in STATE." "Return the candidate surface object for Ebox node KEY in STATE."
(let (object) (let (object)
(maphash (ebox-runtime-index-map
(lambda (_node-id node) (lambda (_node-id node)
(when (equal (plist-get node :key) key) (when (equal (plist-get node :key) key)
(setq object (plist-get node :surface-object)))) (setq object (plist-get node :surface-object))))
@ -511,7 +511,7 @@ candidate cannot hide mutations by restoring the old hash-table pointer."
(defun ebox-surface-test--node-by-key (state key) (defun ebox-surface-test--node-by-key (state key)
"Return the runtime Ebox node for KEY in STATE." "Return the runtime Ebox node for KEY in STATE."
(let (match) (let (match)
(maphash (ebox-runtime-index-map
(lambda (_node-id node) (lambda (_node-id node)
(when (equal (plist-get node :key) key) (when (equal (plist-get node :key) key)
(setq match node))) (setq match node)))
@ -2099,7 +2099,7 @@ candidate cannot hide mutations by restoring the old hash-table pointer."
(style-states (plist-get state :style-binding-states)) (style-states (plist-get state :style-binding-states))
(source-index (plist-get state :source-index)) (source-index (plist-get state :source-index))
text-id text-node) text-id text-node)
(maphash (ebox-runtime-index-map
(lambda (node-id node) (lambda (node-id node)
(when (and (eq (plist-get node :ebox-kind) 'text) (when (and (eq (plist-get node :ebox-kind) 'text)
(equal (plist-get node :content) "Inherited")) (equal (plist-get node :content) "Inherited"))
@ -2107,13 +2107,14 @@ candidate cannot hide mutations by restoring the old hash-table pointer."
nodes) nodes)
(should text-id) (should text-id)
(let* ((parent-id (let* ((parent-id
(gethash text-id (plist-get state :parent-table))) (ebox-runtime-index-get
text-id (plist-get state :parent-table)))
(object (gethash text-id objects)) (object (gethash text-id objects))
(parent-object (gethash parent-id objects)) (parent-object (gethash parent-id objects))
(style-state (gethash object style-states)) (style-state (gethash object style-states))
(parent-state (gethash parent-object style-states)) (parent-state (gethash parent-object style-states))
(candidate-node (copy-sequence text-node)) (candidate-node (copy-sequence text-node))
(candidate-nodes (copy-hash-table nodes)) (candidate-nodes nodes)
(candidate-state (copy-sequence state))) (candidate-state (copy-sequence state)))
(should style-state) (should style-state)
(should parent-state) (should parent-state)
@ -2126,7 +2127,9 @@ candidate cannot hide mutations by restoring the old hash-table pointer."
(ecss-subject-id (plist-get style-state :subject)))) (ecss-subject-id (plist-get style-state :subject))))
(should (ebox-surface--static-style-state-p style-state)) (should (ebox-surface--static-style-state-p style-state))
(plist-put candidate-node :ebox-candidate-computed-style-p t) (plist-put candidate-node :ebox-candidate-computed-style-p t)
(puthash text-id candidate-node candidate-nodes) (setq candidate-nodes
(ebox-runtime-index-put
text-id candidate-node candidate-nodes))
(plist-put candidate-state :node-table candidate-nodes) (plist-put candidate-state :node-table candidate-nodes)
(let ((ebox-incremental--allocated-slot-proof-cache (let ((ebox-incremental--allocated-slot-proof-cache
(make-hash-table :test 'equal))) (make-hash-table :test 'equal)))
@ -3207,7 +3210,7 @@ changes. Geometry and non-inherited computed values must remain identical."
(maphash (maphash
(lambda (id node) (lambda (id node)
(should (eq node (should (eq node
(gethash (gethash id (ebox-runtime-index-get (ebox-runtime-index-get id
(plist-get state (plist-get state
:region-node-table)) :region-node-table))
(plist-get state :node-table))))) (plist-get state :node-table)))))