geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

refactor!: publish transactions exclusively through protocol v2

Browse Source
This commit is contained in:
Kinneyzhang 2026-09-05 05:25:29 +08:00
parent 25cb66c040
commit c05174ff9d
15 changed files with 290 additions and 577 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
CHANGELOG.md
View File

@ -2,19 +2,20 @@
All notable changes to the tp library are documented here. All notable changes to the tp library are documented here.
## 1.0.1 (Unreleased) ## 2.0.0 (Unreleased)
### Added ### Added
- A standalone retained surface runtime with pure defensive plans, prepare-scoped stable objects, keyed/positional reconciliation, content and properties capabilities, marker-backed range anchors, object/mount indexes, scoped updates, opaque client state, generic reports, and lifecycle cleanup. - A standalone retained surface runtime with pure defensive plans, prepare-scoped stable objects, keyed/positional reconciliation, content and properties capabilities, marker-backed range anchors, object/mount indexes, scoped updates, opaque client state, generic reports, and lifecycle cleanup.
- Exact signal-to-binding and binding-to-binding dependency tracking with conditional rewiring, equality cutoffs, batched transactions, nested-write stabilization, owner disposal, buffer-scoped sources, variable adapters, cycle paths, and public structural counters. - Exact signal-to-binding and binding-to-binding dependency tracking with conditional rewiring, equality cutoffs, batched transactions, nested-write stabilization, owner disposal, buffer-scoped sources, variable adapters, cycle paths, and public structural counters.
- Atomic single- and multi-surface publication with candidate source values, prepare-all/publish-all ordering, explicit property journals, rollback-capable transaction participants, observer isolation, and authoritative kill-buffer cleanup. - Atomic single- and multi-surface publication with candidate source values, prepare-all/publish-all ordering, explicit property journals, rollback-capable transaction participants, observer isolation, and authoritative kill-buffer cleanup.
- Transaction protocol v2 artifacts: transaction-scoped publication batches, structured v1 participant bridges, bounded opaque final-accept markers using the closed `tp-vector-slots/v1` primitive, immutable tagged outcomes, and property/revision shadow proofs over the selected single live writer. - Transaction protocol v2: transaction-scoped publication batches, structured
- `tp-runtime-manifest`, advertising `tp-transaction-protocol-v1+v2` without removing the v1 participant route. participants, bounded opaque final-accept markers using the closed
- Supported `tp-transaction-execution-route` kill switch with `structured` as `tp-vector-slots/v1` primitive, immutable tagged outcomes, and one live writer.
the default live authority and `v1` as the complete legacy rollback route. - `tp-runtime-manifest`, advertising `tp-transaction-protocol-v2` and package
version 2.0.0.
- Public `tp-transaction-participate-v2` registration for cross-package - Public `tp-transaction-participate-v2` registration for cross-package
structured participants, with the v1 call-shape adapter retained unchanged. structured participants.
- Native property policies and contribution composition with explicit nil/absence, normalization, validation, equality, merge, projection, named direct styles, and explicit `tp-computed` value sources. - Native property policies and contribution composition with explicit nil/absence, normalization, validation, equality, merge, projection, named direct styles, and explicit `tp-computed` value sources.
- `tp-propertize`, `tp-apply`, and `tp-watch` as the one-shot string, one-shot buffer-range, and reactive existing-text conveniences over the same direct property/surface core. - `tp-propertize`, `tp-apply`, and `tp-watch` as the one-shot string, one-shot buffer-range, and reactive existing-text conveniences over the same direct property/surface core.
- Retained logical objects with `tp-object-retain` and `tp-object-attach-fragment`, allowing one object to own multiple disjoint physical fragments without placing handles or positions in plans. - Retained logical objects with `tp-object-retain` and `tp-object-attach-fragment`, allowing one object to own multiple disjoint physical fragments without placing handles or positions in plans.
@ -22,18 +23,9 @@ All notable changes to the tp library are documented here.
### Changed ### Changed
- Structured publication batches now own the single live surface-entry loop, - Structured publication batches own the single live surface-entry loop,
participant stage/precommit/commit vector, and candidate-bound final accept. participant stage/precommit/commit vector, and candidate-bound final accept.
The public `tp-transaction-participate` API remains a v1 adapter over the same - Package metadata now identifies the v2-only breaking transaction contract.
participant object; structured and v1 routes are mutually exclusive.
- Runtime manifest fields now report active structured batch execution and the
supported route list/option, single-writer invariant, and retained v1
adapter/rollback route. The package version remains 1.0.1 because
this is the planned authority cutover within the unreleased 1.0.1 protocol,
with no public API removal or dependency change.
- Package metadata now distinguishes builds that include
`tp-transaction.el`; consumers can require TP 1.0.1 without an older 1.0.0
development snapshot being accepted as a complete transaction runtime.
- `define-tp` and `define-tps` now define static or parameterized direct declaration recipes. Applying a recipe produces ordinary properties and never publishes runtime identity metadata. - `define-tp` and `define-tps` now define static or parameterized direct declaration recipes. Applying a recipe produces ordinary properties and never publishes runtime identity metadata.
- TP is no longer a CSS engine. Selector, stylesheet, specificity, origin/importance, cascade layer, CSS-wide value, custom property, winner, and provenance behavior belongs to the independent ECSS package. - TP is no longer a CSS engine. Selector, stylesheet, specificity, origin/importance, cascade layer, CSS-wide value, custom property, winner, and provenance behavior belongs to the independent ECSS package.
- Function-valued properties are always literal. Only values wrapped by `tp-computed` execute and participate in dependency collection. - Function-valued properties are always literal. Only values wrapped by `tp-computed` execute and participate in dependency collection.
@ -42,6 +34,12 @@ All notable changes to the tp library are documented here.
### Removed ### Removed
- The public `tp-transaction-participate` v1 facade. Replace
`(tp-transaction-participate KEY PUBLISH ROLLBACK)` with
`(tp-transaction-participate-v2 :key KEY :stage PUBLISH :rollback ROLLBACK)`.
- The v1 publication writer, execution-route kill switch, artifact-mode switch,
and their runtime manifest claims.
- `tp-render.el`, `tp-stack.el`, the scan-driven renderer, layer-to-buffer registry, and duplicate managed transaction path. - `tp-render.el`, `tp-stack.el`, the scan-driven renderer, layer-to-buffer registry, and duplicate managed transaction path.
- Managed stack mutation, attach/detach, diagnostics, and lifecycle APIs that depended on inline stack storage. - Managed stack mutation, attach/detach, diagnostics, and lifecycle APIs that depended on inline stack storage.
- `tp-text`, `$variable` declaration syntax, automatic layer refresh, and character-level `tp-name`/`tp-layers`/`tp-meta` runtime storage. - `tp-text`, `$variable` declaration syntax, automatic layer refresh, and character-level `tp-name`/`tp-layers`/`tp-meta` runtime storage.

15
Makefile
View File

@ -5,7 +5,7 @@
# make test-shuffled # run the suite in a random order (SHUFFLE_SEED=n reproduces) # make test-shuffled # run the suite in a random order (SHUFFLE_SEED=n reproduces)
# make test-m0a # run current TP completion characterization # make test-m0a # run current TP completion characterization
# make test-m1a # run additive transaction contract + fault gates # make test-m1a # run additive transaction contract + fault gates
# make test-v1 # run every legacy suite with v2 artifacts disabled # make test-c1b # run the v2-only transaction regression gate
# make doctest # execute README examples against the code # make doctest # execute README examples against the code
# make benchmark # run reproducible correctness-first benchmarks # make benchmark # run reproducible correctness-first benchmarks
# make compile # byte-compile the library modules # make compile # byte-compile the library modules
@ -27,12 +27,11 @@ LOADPATH = -L . -L $(TEST_DIR) -L examples $(LOAD_EXTRA)
SRC = tp-core.el tp-style.el tp-transaction.el tp-reactive.el tp-surface.el tp-layer.el tp-ops.el tp-search.el \ SRC = tp-core.el tp-style.el tp-transaction.el tp-reactive.el tp-surface.el tp-layer.el tp-ops.el tp-search.el \
tp-query.el tp-palette.el tp-builtins.el tp.el tp-query.el tp-palette.el tp-builtins.el tp.el
TESTS = $(wildcard $(TEST_DIR)/*-tests.el) TESTS = $(wildcard $(TEST_DIR)/*-tests.el)
V1_TESTS = $(filter-out $(TEST_DIR)/tp-transaction-tests.el,$(TESTS))
TEST_SUPPORT = $(TEST_DIR)/tp-doctest.el $(TEST_DIR)/tp-run-shuffled.el TEST_SUPPORT = $(TEST_DIR)/tp-doctest.el $(TEST_DIR)/tp-run-shuffled.el
EXAMPLES = $(wildcard examples/*.el) EXAMPLES = $(wildcard examples/*.el)
DEV = $(TEST_SUPPORT) $(EXAMPLES) tp-benchmark.el DEV = $(TEST_SUPPORT) $(EXAMPLES) tp-benchmark.el
.PHONY: test test-m0a test-m1a test-v1 test-shuffled doctest benchmark compile compile-all checkdoc package-lint diff-check clean .PHONY: test test-m0a test-m1a test-c1b test-shuffled doctest benchmark compile compile-all checkdoc package-lint diff-check clean
test: test:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \ $(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
@ -53,11 +52,13 @@ test-m1a:
-l $(TEST_DIR)/tp-transaction-tests.el \ -l $(TEST_DIR)/tp-transaction-tests.el \
--eval '(ert-run-tests-batch-and-exit "tp-transaction-test-\\|tp-m0a-characterization-test-\\|tp-binding-test-signal-commit-journal-rolls-back-every-write\\|tp-binding-test-rollback-preserves-primary-and-runs-all-phases\\|tp-surface-test-global-signal-update-is-multi-surface-atomic\\|tp-surface-test-full-and-scoped-precommit-stages-roll-back\\|tp-surface-test-full-and-scoped-final-accept-roll-back")' --eval '(ert-run-tests-batch-and-exit "tp-transaction-test-\\|tp-m0a-characterization-test-\\|tp-binding-test-signal-commit-journal-rolls-back-every-write\\|tp-binding-test-rollback-preserves-primary-and-runs-all-phases\\|tp-surface-test-global-signal-update-is-multi-surface-atomic\\|tp-surface-test-full-and-scoped-precommit-stages-roll-back\\|tp-surface-test-full-and-scoped-final-accept-roll-back")'
test-v1: test-c1b:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el \ $(EMACS) -Q --batch $(LOADPATH) -l tp.el \
--eval '(setq tp-transaction-execution-route (quote v1))' \ -l $(TEST_DIR)/tp-binding-tests.el \
--eval '(setq tp--transaction-artifact-mode (quote v1))' \ -l $(TEST_DIR)/tp-surface-tests.el \
$(patsubst %,-l %,$(V1_TESTS)) -f ert-run-tests-batch-and-exit -l $(TEST_DIR)/tp-m0a-characterization-tests.el \
-l $(TEST_DIR)/tp-transaction-tests.el \
--eval '(ert-run-tests-batch-and-exit "tp-transaction-test-\\|tp-m0a-characterization-test-participant-failure-preserves-condition\\|tp-binding-test-participant-key-is-owned-by-transaction\\|tp-binding-test-rollback-preserves-primary-and-runs-all-phases\\|tp-surface-test-transaction-participant\\|tp-surface-test-failing-participant")'
test-shuffled: test-shuffled:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \ $(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \

29
README.md
View File

@ -1,13 +1,13 @@
# TP # TP
TP 1.0 is a standalone retained/reactive text runtime for Emacs. It projects declarative properties, reactive data, and stable text objects onto strings and buffers while owning text-property composition, exact dependency tracking, retained identity, marker-backed mounts, diffing, transactions, rollback, and final buffer publication. TP 2.0 is a standalone retained/reactive text runtime for Emacs. It projects declarative properties, reactive data, and stable text objects onto strings and buffers while owning text-property composition, exact dependency tracking, retained identity, marker-backed mounts, diffing, transactions, rollback, and final buffer publication.
TP does not depend on Ebox or ECSS. It does not implement CSS selectors, stylesheets, specificity, cascade winners, Box, Flex, Grid, measurement, or layout. A CSS consumer may compute final declarations with ECSS and publish them through TP, but TP itself only understands Emacs text properties and generic retained text surfaces. TP does not depend on Ebox or ECSS. It does not implement CSS selectors, stylesheets, specificity, cascade winners, Box, Flex, Grid, measurement, or layout. A CSS consumer may compute final declarations with ECSS and publish them through TP, but TP itself only understands Emacs text properties and generic retained text surfaces.
Chinese documentation: [README_CN.md](README_CN.md). Chinese documentation: [README_CN.md](README_CN.md).
Complete public API reference: [API-REFERENCE.md](docs/API-REFERENCE.md) (中文). Complete public API reference: [API-REFERENCE.md](docs/API-REFERENCE.md) (中文).
It is the symbol-level usage index for the current TP 1.0 implementation; this It is the symbol-level usage index for the current TP 2.0 implementation; this
README remains the conceptual quick start. README remains the conceptual quick start.
## Requirements ## Requirements
@ -146,14 +146,12 @@ TP records the host baseline and each TP contribution per property interval. Ove
Observers run only after a successful commit. Their failures are recorded and do not roll back an already committed transaction. A buffer killed during publication remains killed; rollback never recreates it. Observers run only after a successful commit. Their failures are recorded and do not roll back an already committed transaction. A buffer killed during publication remains killed; rollback never recreates it.
TP's default `structured` route drives the single live publication from exact TP 2.0 drives the single live publication from exact transaction-scoped batch
transaction-scoped batch entries, one frozen participant vector, and the entries, one frozen participant vector, and the candidate-bound final accept.
candidate-bound final accept. The same journals, surface snapshots, and change The same journals, surface snapshots, and change group are shared rather than
group are shared rather than copied. Set `tp-transaction-execution-route` to copied. Transaction participants register through
`v1` before an outer transaction to use the complete legacy writer; the route is `tp-transaction-participate-v2`; TP has no alternate transaction writer or
frozen for that transaction and the two writers are mutually exclusive. Shadow runtime route switch.
mode remains read-only compatibility evidence over whichever single route was
selected; it never opens a second change group or writes a buffer twice.
Generic opaque authority markers are bounded and whitelist-validated before Generic opaque authority markers are bounded and whitelist-validated before
final accept, then reverse-restored before ordinary rollback on partial apply or final accept, then reverse-restored before ordinary rollback on partial apply or
accept failure. `tp-with-transaction` still returns its body value, and accept failure. `tp-with-transaction` still returns its body value, and
@ -187,7 +185,7 @@ cycles instead of spinning.
| Core inspection and debug | `tp-debug-*`, `tp-intervals`, `tp-intervals-map`, `tp-plist`, `tp-text-snapshot`, `tp-empty-p` | | Core inspection and debug | `tp-debug-*`, `tp-intervals`, `tp-intervals-map`, `tp-plist`, `tp-text-snapshot`, `tp-empty-p` |
| Property policy and declarations | `tp-define-property-policy`, `tp-register-text-property`, `tp-text-declarations`, `tp-computed`, `tp-resolve-value`, `tp-merge-declarations`, `tp-define-style`, `tp-style-declarations` | | Property policy and declarations | `tp-define-property-policy`, `tp-register-text-property`, `tp-text-declarations`, `tp-computed`, `tp-resolve-value`, `tp-merge-declarations`, `tp-define-style`, `tp-style-declarations` |
| Static recipes | `define-tp`/`tp-define-layer`, `define-tps`/`define-tp-group`/`tp-define-group`, layer/group queries, undefine/reset/describe | | Static recipes | `define-tp`/`tp-define-layer`, `define-tps`/`define-tp-group`/`tp-define-group`, layer/group queries, undefine/reset/describe |
| Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate`, `tp-transaction-participate-v2`, read-only `tp-transaction-active-p`, `tp-runtime-manifest`, counters/reset | | Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate-v2`, read-only `tp-transaction-active-p`, `tp-runtime-manifest`, counters/reset |
| Objects and plans | plan/result constructors, `tp-object-ensure`, retain/reuse, fragment/content-range attachment, resolve, mounted/mounts | | Objects and plans | plan/result constructors, `tp-object-ensure`, retain/reuse, fragment/content-range attachment, resolve, mounted/mounts |
| Host ranges | `tp-range-anchor-create`, `tp-range-anchor-live-p`, `tp-object-attach-range`, `tp-range-rebase` | | Host ranges | `tp-range-anchor-create`, `tp-range-anchor-live-p`, `tp-object-attach-range`, `tp-range-rebase` |
| Surfaces | mount/update/scoped update, materialize, live/revision/client-state, at-point, report/report-summary/inspect, unmount | | Surfaces | mount/update/scoped update, materialize, live/revision/client-state, at-point, report/report-summary/inspect, unmount |
@ -205,6 +203,15 @@ for module boundaries and transaction flow.
TP 1.0 removes the 0.3 managed stack/renderer runtime instead of hiding it behind compatibility branches. Removed behavior includes `tp-render.el`, `tp-stack.el`, stack mutation APIs, `tp-text`, `$variable` declarations, layer-to-buffer registries, scan-driven refresh, managed attach/detach/diagnostics, and inline `tp-name`/`tp-layers`/`tp-meta` runtime storage. TP 1.0 removes the 0.3 managed stack/renderer runtime instead of hiding it behind compatibility branches. Removed behavior includes `tp-render.el`, `tp-stack.el`, stack mutation APIs, `tp-text`, `$variable` declarations, layer-to-buffer registries, scan-driven refresh, managed attach/detach/diagnostics, and inline `tp-name`/`tp-layers`/`tp-meta` runtime storage.
## TP 2.0 transaction migration
TP 2.0 removes the v1 transaction participant facade and the legacy execution
route. Replace `(tp-transaction-participate KEY PUBLISH ROLLBACK)` exactly with
`(tp-transaction-participate-v2 :key KEY :stage PUBLISH :rollback ROLLBACK)`.
Callers that inspect `tp-runtime-manifest` must require
`tp-transaction-protocol-v2`; route-selection and v1-adapter fields are no
longer published.
Use direct recipes for reusable static declarations, `tp-watch` for reactive properties on existing text, and retained content surfaces for reactive text or structured UI. TP does not automatically scan historical propertized text to reconstruct runtime identity. Use direct recipes for reusable static declarations, `tp-watch` for reactive properties on existing text, and retained content surfaces for reactive text or structured UI. TP does not automatically scan historical propertized text to reconstruct runtime identity.
## Examples ## Examples

26
README_CN.md
View File

@ -1,13 +1,13 @@
# TP # TP
TP 1.0 是一个可独立使用的 Emacs retained/reactive text runtime。它把声明式属性、响应式数据和稳定文本对象投影到 string 与 buffer，并拥有文本属性 contribution 合成、精确依赖追踪、保留式身份、marker-backed mount、diff、事务、回滚和最终 Buffer publication。 TP 2.0 是一个可独立使用的 Emacs retained/reactive text runtime。它把声明式属性、响应式数据和稳定文本对象投影到 string 与 buffer，并拥有文本属性 contribution 合成、精确依赖追踪、保留式身份、marker-backed mount、diff、事务、回滚和最终 Buffer publication。
TP 不依赖 Ebox 或 ECSS，也不实现 CSS selector、stylesheet、specificity、cascade winner、Box、Flex、Grid、测量或布局。需要 CSS 的调用者可以先用 ECSS 算出最终 declarations，再交给 TP 发布；TP 自身只理解 Emacs 文本属性和通用 retained text surface。 TP 不依赖 Ebox 或 ECSS，也不实现 CSS selector、stylesheet、specificity、cascade winner、Box、Flex、Grid、测量或布局。需要 CSS 的调用者可以先用 ECSS 算出最终 declarations，再交给 TP 发布；TP 自身只理解 Emacs 文本属性和通用 retained text surface。
英文文档：[README.md](README.md)。 英文文档：[README.md](README.md)。
完整公共 API 参考：[API-REFERENCE.md](docs/API-REFERENCE.md)。本文负责概念 完整公共 API 参考：[API-REFERENCE.md](docs/API-REFERENCE.md)。本文负责概念
和快速开始；API 参考按当前 TP 1.0 源码列出入口、参数语义、返回值和用法。 和快速开始；API 参考按当前 TP 2.0 源码列出入口、参数语义、返回值和用法。
## 运行要求 ## 运行要求
@ -145,13 +145,11 @@ TP 为每个 property interval 保存 host baseline 和各个 TP contribution。
observer 只在成功提交之后运行，observer failure 只记录，不回滚已完成的 transaction。publication 过程中被 kill 的 buffer 保持死亡，rollback 不会把它重新创建。 observer 只在成功提交之后运行，observer failure 只记录，不回滚已完成的 transaction。publication 过程中被 kill 的 buffer 保持死亡，rollback 不会把它重新创建。
TP 默认由 `structured` route 从 transaction-scoped batch 的 exact entries、 TP 2.0 从 transaction-scoped batch 的 exact entries、同一个冻结 participant
同一个冻结 participant vector 和 candidate-bound final accept 驱动唯一 live vector 和 candidate-bound final accept 驱动唯一 live publication；journal、
publication；journal、surface snapshot 与 change group 仍只保留一份。outer surface snapshot 与 change group 仍只保留一份。transaction participant 统一通过
transaction 开始前把 `tp-transaction-execution-route` 设为 `v1`，即可使用完整 `tp-transaction-participate-v2` 注册，不再提供备用 transaction writer 或 runtime
legacy writer；route 会在该 transaction 内冻结，两条 writer 分支始终互斥。 route switch。generic opaque authority marker 在 final accept 前
shadow mode 只对已选择的单一路径生成只读兼容证据，不会建立第二个 change
group，也不会双写 Buffer。generic opaque authority marker 在 final accept 前
完成固定上界与 whitelist 校验；partial apply 或 accept failure 时先逆序恢复 完成固定上界与 whitelist 校验；partial apply 或 accept failure 时先逆序恢复
marker，再执行普通 rollback。`tp-with-transaction` 仍返回 body result，内部 marker，再执行普通 rollback。`tp-with-transaction` 仍返回 body result，内部
outcome 仅作为只读 side-channel evidence。 outcome 仅作为只读 side-channel evidence。
@ -182,7 +180,7 @@ effect 的 input/version tuple，重复或超过图规模上限时停止循环
| Core inspection 与 debug | `tp-debug-*`、`tp-intervals`、`tp-intervals-map`、`tp-plist`、`tp-text-snapshot`、`tp-empty-p` | | Core inspection 与 debug | `tp-debug-*`、`tp-intervals`、`tp-intervals-map`、`tp-plist`、`tp-text-snapshot`、`tp-empty-p` |
| Property policy 与 declaration | `tp-define-property-policy`、`tp-register-text-property`、`tp-text-declarations`、`tp-computed`、`tp-resolve-value`、`tp-merge-declarations`、`tp-define-style`、`tp-style-declarations` | | Property policy 与 declaration | `tp-define-property-policy`、`tp-register-text-property`、`tp-text-declarations`、`tp-computed`、`tp-resolve-value`、`tp-merge-declarations`、`tp-define-style`、`tp-style-declarations` |
| 静态 recipe | `define-tp`/`tp-define-layer`、`define-tps`/`define-tp-group`/`tp-define-group`、layer/group 查询、undefine/reset/describe | | 静态 recipe | `define-tp`/`tp-define-layer`、`define-tps`/`define-tp-group`/`tp-define-group`、layer/group 查询、undefine/reset/describe |
| Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate`、`tp-transaction-participate-v2`、只读 `tp-transaction-active-p`、`tp-runtime-manifest`、counter/reset | | Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate-v2`、只读 `tp-transaction-active-p`、`tp-runtime-manifest`、counter/reset |
| Object 与 plan | plan/result constructor、`tp-object-ensure`、retain/reuse、fragment/content-range attach、resolve、mounted/mounts | | Object 与 plan | plan/result constructor、`tp-object-ensure`、retain/reuse、fragment/content-range attach、resolve、mounted/mounts |
| Host range | `tp-range-anchor-create`、`tp-range-anchor-live-p`、`tp-object-attach-range`、`tp-range-rebase` | | Host range | `tp-range-anchor-create`、`tp-range-anchor-live-p`、`tp-object-attach-range`、`tp-range-rebase` |
| Surface | mount/update/scoped update、materialize、live/revision/client-state、at-point、report/report-summary/inspect、unmount | | Surface | mount/update/scoped update、materialize、live/revision/client-state、at-point、report/report-summary/inspect、unmount |
@ -199,6 +197,14 @@ ownership、生命周期、错误和返回值合同见 [API semantics](docs/API-
TP 1.0 直接删除 0.3 的 managed stack/renderer runtime，不使用隐藏兼容分支。删除的行为包括 `tp-render.el`、`tp-stack.el`、stack mutation APIs、`tp-text`、`$variable` declarations、layer-to-buffer registry、scan-driven refresh、managed attach/detach/diagnostics，以及以 `tp-name`/`tp-layers`/`tp-meta` 作为权威 runtime storage 的机制。 TP 1.0 直接删除 0.3 的 managed stack/renderer runtime，不使用隐藏兼容分支。删除的行为包括 `tp-render.el`、`tp-stack.el`、stack mutation APIs、`tp-text`、`$variable` declarations、layer-to-buffer registry、scan-driven refresh、managed attach/detach/diagnostics，以及以 `tp-name`/`tp-layers`/`tp-meta` 作为权威 runtime storage 的机制。
## TP 2.0 transaction 迁移
TP 2.0 删除 v1 transaction participant facade 和 legacy execution route。把
`(tp-transaction-participate KEY PUBLISH ROLLBACK)` 精确替换为
`(tp-transaction-participate-v2 :key KEY :stage PUBLISH :rollback ROLLBACK)`。
检查 `tp-runtime-manifest` 的调用方必须要求 `tp-transaction-protocol-v2`；manifest
不再发布 route-selection 和 v1-adapter 字段。
可复用静态声明使用 direct recipe；已有文本的响应式属性使用 `tp-watch`；响应式文字或结构化 UI 使用 retained content surface。TP 不会自动扫描历史 propertized text 来重建 runtime identity。 可复用静态声明使用 direct recipe；已有文本的响应式属性使用 `tp-watch`；响应式文字或结构化 UI 使用 retained content surface。TP 不会自动扫描历史 propertized text 来重建 runtime identity。
## 示例 ## 示例

52
docs/API-REFERENCE.md
View File

@ -1,4 +1,4 @@
# TP 1.0 公共 API 与用法参考 # TP 2.0 公共 API 与用法参考
本文是 TP 当前实现的完整公共入口索引。它以 tp.el 加载的模块为准；带 本文是 TP 当前实现的完整公共入口索引。它以 tp.el 加载的模块为准；带
tp-- 前缀的函数、变量和结构体是内部实现，不属于本文的稳定 API。 tp-- 前缀的函数、变量和结构体是内部实现，不属于本文的稳定 API。
@ -226,20 +226,14 @@ tp-binding-dispose 释放单个 binding。
(tp-signal-dispose left) (tp-signal-dispose left)
(tp-signal-dispose right)) (tp-signal-dispose right))
(tp-transaction-participate (tp-with-transaction
'my-external-state (tp-transaction-participate-v2
(lambda () (my-publish)) :key 'my-structured-state
(lambda () (my-rollback))) :stage (lambda () (my-stage))
:rollback (lambda () (my-rollback))))
(tp-transaction-participate-v2
:key 'my-structured-state
:stage (lambda () (my-stage))
:rollback (lambda () (my-rollback)))
(tp-transaction-active-p) (tp-transaction-active-p)
(setq tp-transaction-execution-route 'structured) ; structured 或 v1
(tp-runtime-manifest) (tp-runtime-manifest)
(tp-variable-signal 'my-variable) (tp-variable-signal 'my-variable)
@ -251,8 +245,8 @@ tp-binding-dispose 释放单个 binding。
tp-with-transaction 将 signal、binding、surface 和注册的 transaction tp-with-transaction 将 signal、binding、surface 和注册的 transaction
participant 一起原子处理。participant 必须在 active transaction 内注册； participant 一起原子处理。participant 必须在 active transaction 内注册；
publish 在 surface publication 后、source commit 前运行，失败时按逆序 stage 在 surface publication 后、source commit 前运行，失败时按逆序
rollback。跨包 structured consumer 使用 `tp-transaction-participate-v2`；它 rollback。consumer 使用 `tp-transaction-participate-v2`；它
返回 key，不暴露内部 participant 对象。tp-variable-signal 用 Emacs variable 返回 key，不暴露内部 participant 对象。tp-variable-signal 用 Emacs variable
watcher 适配全局或指定 watcher 适配全局或指定
Buffer 的变量，不是旧的 $variable API。 Buffer 的变量，不是旧的 $variable API。
@ -262,25 +256,17 @@ tp-transaction-active-p 是只读边界查询：只在当前 dynamic extent 已
对象、participant 或内部状态，调用方只能用它在 mutation 前拒绝不支持的 对象、participant 或内部状态，调用方只能用它在 mutation 前拒绝不支持的
嵌套事务边界。 嵌套事务边界。
`tp-transaction-execution-route` 是受支持的 live authority kill switch，默认
为 `structured`，也可在 outer transaction 开始前设为 `v1`。outer transaction
会校验并冻结选择；中途修改 public option 不改变当前 transaction，只在下一次
outer transaction 生效。`structured` 从 publication batch 的 exact entries、
同一个 participant vector 和 candidate-bound final accept 执行；`v1` 恢复原 prepared-list、
registration-list 与 transaction final-accept 循环。两条 route 互斥。
tp-runtime-manifest 返回防御性 capability snapshot；本版本的 tp-runtime-manifest 返回防御性 capability snapshot；本版本的
`:transaction-protocol` 为 `tp-transaction-protocol-v1+v2`。structured core `:transaction-protocol` 为 `tp-transaction-protocol-v2`，`:version` 为
现在是默认 live authority，因此 `:execution-default` 为 `structured`、 `"2.0.0"`。`:structured-participant-api` 指向
`:execution-routes` 为 `(structured v1)`、`:route-option` 为 `tp-transaction-participate-v2`；`:batch-execute`、`:batch-artifacts` 和
`tp-transaction-execution-route`，兼容字段 `:execution-route` 与 `:single-live-writer` 均为 non-nil。manifest 不再发布 execution route、
`:batch-execution` 也均为 `structured`，`:batch-execute` 为 non-nil。公开 v1 adapter 或 v1 rollback route。
structured registration 由 `:structured-participant-api` 指向
`tp-transaction-participate-v2`；`tp-transaction-participate` 仍是 v1 adapter， 从 TP 1.x 迁移时，把 `(tp-transaction-participate KEY PUBLISH ROLLBACK)`
manifest 以 `:v1-adapter` 和 精确替换为 `(tp-transaction-participate-v2 :key KEY :stage PUBLISH
`:v1-rollback-route` 明确声明 adapter 与完整旧 route 均保留； :rollback ROLLBACK)`。删除所有对 `tp-transaction-execution-route` 和
`:single-live-writer` 明确声明 route 不会双写； `tp--transaction-artifact-mode` 的设置。
`:batch-artifacts` 与 `:shadow-proof` 也保持 non-nil。
ETAF registers one opaque participant for its immutable generation and Ebox ETAF registers one opaque participant for its immutable generation and Ebox
client state. Its publish is paired with rollback across TP final accept; the client state. Its publish is paired with rollback across TP final accept; the
@ -632,7 +618,7 @@ TP 1.0 已删除并且不应在新代码中使用：
| tp-core.el | tp-debug-*、tp-with-current-buffer、tp-intervals、tp-intervals-map、tp-empty-p、tp-plist、tp-text-snapshot | | tp-core.el | tp-debug-*、tp-with-current-buffer、tp-intervals、tp-intervals-map、tp-empty-p、tp-plist、tp-text-snapshot |
| tp-style.el | tp-define-property-policy、tp-property-policy、tp-text-property-id、tp-register-text-property、tp-text-declarations、tp-computed、tp-resolve-value、tp-merge-declarations、tp-define-style、tp-style-declarations、tp-undefine-style | | tp-style.el | tp-define-property-policy、tp-property-policy、tp-text-property-id、tp-register-text-property、tp-text-declarations、tp-computed、tp-resolve-value、tp-merge-declarations、tp-define-style、tp-style-declarations、tp-undefine-style |
| tp-layer.el | define-tp/tp-define-layer、define-tps/define-tp-group/tp-define-group、layer/group query、tp-layer-reset、tp-undefine-*、tp-describe-layer | | tp-layer.el | define-tp/tp-define-layer、define-tps/define-tp-group/tp-define-group、layer/group query、tp-layer-reset、tp-undefine-*、tp-describe-layer |
| tp-transaction.el | additive batch/entry、final-marker 与 tagged-outcome 内部合同 | | tp-transaction.el | structured batch/entry、final-marker 与 tagged-outcome 内部合同 |
| tp-reactive.el | signal、binding、transaction coordinator、variable adapter、counter 和 reset API | | tp-reactive.el | signal、binding、transaction coordinator、variable adapter、counter 和 reset API |
| tp-surface.el | plan/result、object、range anchor、surface lifecycle、scoped update、report、tp-watch | | tp-surface.el | plan/result、object、range anchor、surface lifecycle、scoped update、report、tp-watch |
| tp-ops.el | tp-propertize、tp-apply、tp-set、tp-reset、tp-add、tp-remove、tp-clear、tp-get、tp-at、tp-member | | tp-ops.el | tp-propertize、tp-apply、tp-set、tp-reset、tp-add、tp-remove、tp-clear、tp-get、tp-at、tp-member |

29
docs/API-SEMANTICS.md
View File

@ -1,6 +1,6 @@
# TP 1.0 API Semantics # TP 2.0 API Semantics
本文记录 TP 1.0 当前公共 API 的 ownership、presence、响应式、retained surface、事务与失败合同。它描述已经实现的行为；目标背景与设计理由见 [retained runtime architecture](retained-runtime-target-architecture.md)。 本文记录 TP 2.0 当前公共 API 的 ownership、presence、响应式、retained surface、事务与失败合同。它描述已经实现的行为；目标背景与设计理由见 [retained runtime architecture](retained-runtime-target-architecture.md)。
完整的公共符号、参数形状、返回值和示例见 [API reference](API-REFERENCE.md)。 完整的公共符号、参数形状、返回值和示例见 [API reference](API-REFERENCE.md)。
@ -209,24 +209,19 @@ TP 为每个 interval 保存：
嵌套 transaction 加入最外层。一个 global signal 可以原子触达多个 buffers；任一 surface 失败时，已发布 surfaces 和 source/binding state 全部回滚。 嵌套 transaction 加入最外层。一个 global signal 可以原子触达多个 buffers；任一 surface 失败时，已发布 surfaces 和 source/binding state 全部回滚。
`tp-transaction-participate` 允许 client side state 在 surfaces 发布后、source commit 前加入同一 rollback boundary。它保留公共 v1 调用形状，但在默认 structured route 中适配成同一个 participant record 的 `stage` capability，只执行一次。participant key 在一个 outer transaction 中必须唯一。它不是 observer；失败会回滚 transaction。Observer failure 只记录，不回滚已提交结果。 `tp-transaction-participate-v2` 允许 client side state 在 surfaces 发布后、
source commit 前加入同一 rollback boundary。调用方通过 `:key`、`:stage` 和
跨包 consumer 使用公开 `tp-transaction-participate-v2` 直接注册 structured `:rollback` 注册 structured participant；返回值仍是 key，内部 participant
`stage`/`rollback` pair；返回值仍是 key，内部 participant identity、state 与 identity、state 与 journal 不暴露。participant key 在一个 outer transaction
journal 不暴露。完整 v1 execution route 也能执行该同一 v2 participant object， 中必须唯一。它不是 observer；失败会回滚 transaction。Observer failure 只记录，
因此 Ebox 可以独立 cutover，而不要求同步改变 TP live route。 不回滚已提交结果。
publication batch、structured participant、final marker 与 tagged outcome 共享 publication batch、structured participant、final marker 与 tagged outcome 共享
现有 journal/change-group，不复制第二份 live state。默认 `structured` route 是 现有 journal/change-group，不复制第二份 live state。publication batch 是唯一
唯一 live writer：surface 从 candidate entries 执行，participant 从 candidate live writer：surface 从 candidate entries 执行，participant 从 candidate
绑定的同一 identity vector 执行，final accept 从 candidate binding 执行；任何 绑定的同一 identity vector 执行，final accept 从 candidate binding 执行；任何
binding/order 漂移都会 fail-fast 并回滚。把 binding/order 漂移都会 fail-fast 并回滚。TP 2.0 不再提供 alternate writer、
`tp-transaction-execution-route` 在 outer transaction 前设为 `v1` 会立即恢复 execution route 或 artifact-mode switch。`tp-with-transaction` 的返回值仍是 body result；
完整 legacy prepared-list、registration-list 与 final-accept route。route 在 outer
transaction 入口冻结，中途修改 option 只影响下一次 outer transaction；
structured/v1 分支始终互斥，不双写 Buffer
或 participant state。`tp--transaction-artifact-mode` 只控制 v1/shadow 兼容证据，
不能关闭 structured candidate。`tp-with-transaction` 的返回值仍是 body result；
success/failure outcome 只走内部 side channel。zero-surface 与 output-equal success/failure outcome 只走内部 side channel。zero-surface 与 output-equal
operation 不创建 publication batch。 operation 不创建 publication batch。

23
docs/ARCHITECTURE.md
View File

@ -1,6 +1,6 @@
# TP 1.0 Current Architecture # TP 2.0 Current Architecture
本文描述 TP 1.0 当前实现的模块边界、权威状态、数据流和事务模型。公共行为合同见 [API semantics](API-SEMANTICS.md)，设计背景见 [retained runtime architecture](retained-runtime-target-architecture.md)。 本文描述 TP 2.0 当前实现的模块边界、权威状态、数据流和事务模型。公共行为合同见 [API semantics](API-SEMANTICS.md)，设计背景见 [retained runtime architecture](retained-runtime-target-architecture.md)。
按功能查找公共入口和用法时，使用 [API reference](API-REFERENCE.md)。 按功能查找公共入口和用法时，使用 [API reference](API-REFERENCE.md)。
@ -45,7 +45,7 @@ tp.el loads the public package surface
| --- | --- | --- | | --- | --- | --- |
| `tp-core.el` | canonical ranges/requests/results、interval traversal、plist/face merge、native property facts | runtime identity、reactivity、publication | | `tp-core.el` | canonical ranges/requests/results、interval traversal、plist/face merge、native property facts | runtime identity、reactivity、publication |
| `tp-style.el` | native property policies、direct declarations、explicit computed source、projection | selector、stylesheet、specificity、CSS winner | | `tp-style.el` | native property policies、direct declarations、explicit computed source、projection | selector、stylesheet、specificity、CSS winner |
| `tp-transaction.el` | additive batch/entry validators、one-shot states、opaque final-marker descriptors、tagged outcomes | live buffer writer、consumer semantics、parallel journals | | `tp-transaction.el` | structured batch/entry validators、one-shot states、opaque final-marker descriptors、tagged outcomes | live buffer writer、consumer semantics、parallel journals |
| `tp-reactive.el` | signals、bindings、dynamic dependency graph、scheduler、candidate source state、transaction participants | buffer scans、mount positions、layout impact | | `tp-reactive.el` | signals、bindings、dynamic dependency graph、scheduler、candidate source state、transaction participants | buffer scans、mount positions、layout impact |
| `tp-surface.el` | prepare context、objects、plans、anchors、mount/index、contribution ledger、diff、publication、rollback、reports | stylesheet/cascade、consumer layout decisions | | `tp-surface.el` | prepare context、objects、plans、anchors、mount/index、contribution ledger、diff、publication、rollback、reports | stylesheet/cascade、consumer layout decisions |
| `tp-layer.el` | `define-tp`/`define-tps` declaration recipes and registry | live layer stack、inline runtime metadata、watcher engine | | `tp-layer.el` | `define-tp`/`define-tps` declaration recipes and registry | live layer stack、inline runtime metadata、watcher engine |
@ -182,11 +182,10 @@ An equal candidate produces no prepared publication. It preserves revision, repo
The outer transaction owns candidate source values, dirty bindings, prepared surfaces, participants, inverse journals, view state, and final observer scheduling. The outer transaction owns candidate source values, dirty bindings, prepared surfaces, participants, inverse journals, view state, and final observer scheduling.
The additive v2 contract is a structured view over those exact owners. It does The v2 contract uses those exact owners. It does not copy participant,
not copy participant, scheduler, snapshot, journal, or change-group state. The scheduler, snapshot, journal, or change-group state. The publication batch is
public v1 participant façade and the v1 surface writer remain authoritative; the sole writer and validates its canonical entries against the committed
shadow mode constructs canonical entries and compares property-for-property and property and revision state after commit or rollback.
revision-for-revision after commit or rollback.
```text ```text
freeze candidate writes freeze candidate writes
@ -208,11 +207,11 @@ Content publication edits the minimal text span and then exact property runs. Pr
Rollback restores text, properties, marker/index state, plans, producer, client state, signal values, binding values/dependencies, dirty queues, revisions and reports. Property journals are explicit because `atomic-change-group` alone does not cover every silent property mutation path. Rollback restores text, properties, marker/index state, plans, producer, client state, signal values, binding values/dependencies, dirty queues, revisions and reports. Property journals are explicit because `atomic-change-group` alone does not cover every silent property mutation path.
`tp-transaction-participate` lets a consumer promote rollback-capable opaque state inside this boundary. Observers are different: they run only after the transaction commits, and observer failure is recorded rather than rolled back. `tp-transaction-participate-v2` lets a consumer promote rollback-capable opaque state inside this boundary. Observers are different: they run only after the transaction commits, and observer failure is recorded rather than rolled back.
The v1 participant record is also its structured v2 bridge: one stable key, Each structured participant has one stable key, registration order, stage,
registration order, stage, rollback, optional declared precommit, contained rollback, optional declared precommit, contained after-commit work, owner
after-commit work, owner journal, and one-shot state. Final markers are not journal, and one-shot state. Final markers are not
participants. TP treats their values as opaque and accepts only predeclared, participants. TP treats their values as opaque and accepts only predeclared,
fixed-bound operations. M1a's closed `tp-vector-slots/v1` primitive accepts fixed-bound operations. M1a's closed `tp-vector-slots/v1` primitive accepts
only prebuilt vector-slot expectations and writes; marker registration cannot only prebuilt vector-slot expectations and writes; marker registration cannot

24
tests/tp-binding-tests.el
View File

@ -399,20 +399,20 @@
(setq failure (setq failure
(condition-case condition (condition-case condition
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'first :key 'first
(lambda () :stage (lambda ()
(push 'publish-first (push 'publish-first
tp-binding-test-transaction-trace)) tp-binding-test-transaction-trace))
(lambda () :rollback (lambda ()
(push 'rollback-first (push 'rollback-first
tp-binding-test-transaction-trace))) tp-binding-test-transaction-trace)))
(tp-transaction-participate (tp-transaction-participate-v2
'second :key 'second
(lambda () :stage (lambda ()
(push 'publish-second (push 'publish-second
tp-binding-test-transaction-trace)) tp-binding-test-transaction-trace))
(lambda () :rollback (lambda ()
(push 'rollback-second (push 'rollback-second
tp-binding-test-transaction-trace))) tp-binding-test-transaction-trace)))
(tp-signal-set signal 2)) (tp-signal-set signal 2))
@ -689,7 +689,8 @@
(caller-vector (vector (copy-sequence "key"))) (caller-vector (vector (copy-sequence "key")))
(key (list 'test caller-string caller-vector))) (key (list 'test caller-string caller-vector)))
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate key #'ignore #'ignore) (tp-transaction-participate-v2
:key key :stage #'ignore :rollback #'ignore)
(let ((stored (tp--transaction-participant-key (let ((stored (tp--transaction-participant-key
(car tp--transaction-participants)))) (car tp--transaction-participants))))
(should-not (eq (nth 1 stored) caller-string)) (should-not (eq (nth 1 stored) caller-string))
@ -701,8 +702,9 @@
(should (equal (nth 1 stored) "participant")) (should (equal (nth 1 stored) "participant"))
(should (equal (nth 2 stored) ["key"])) (should (equal (nth 2 stored) ["key"]))
(should-error (should-error
(tp-transaction-participate (tp-transaction-participate-v2
(list 'test "participant" ["key"]) #'ignore #'ignore) :key (list 'test "participant" ["key"])
:stage #'ignore :rollback #'ignore)
:type 'tp-reactive-error)))))) :type 'tp-reactive-error))))))
(ert-deftest tp-binding-test-dirty-target-can-break-an-old-cycle-edge () (ert-deftest tp-binding-test-dirty-target-can-break-an-old-cycle-edge ()

8
tests/tp-m0a-characterization-tests.el
View File

@ -107,12 +107,12 @@
(tp-m0a-characterization--capture (tp-m0a-characterization--capture
(lambda () (lambda ()
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'm0a-participant :key 'm0a-participant
(lambda () :stage (lambda ()
(setq external 'candidate) (setq external 'candidate)
(signal (car injected) (cdr injected))) (signal (car injected) (cdr injected)))
(lambda () (setq external 'old))) :rollback (lambda () (setq external 'old)))
(tp-signal-set source 2)))))) (tp-signal-set source 2))))))
(should (equal failure injected))) (should (equal failure injected)))
(should (eq external 'old)) (should (eq external 'old))

22
tests/tp-surface-tests.el
View File

@ -2687,14 +2687,14 @@
(push (list 'observer (buffer-string)) events)))))) (push (list 'observer (buffer-string)) events))))))
(setq events nil) (setq events nil)
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'(test . promotion) :key '(test . promotion)
(lambda () :stage (lambda ()
(push (list 'participant (push (list 'participant
(buffer-string) (buffer-string)
(tp-surface-client-state surface)) (tp-surface-client-state surface))
events)) events))
(lambda () (push '(rollback) events))) :rollback (lambda () (push '(rollback) events)))
(tp-surface-update (tp-surface-update
surface surface
(lambda (context) (lambda (context)
@ -2717,12 +2717,12 @@
rollback-ran) rollback-ran)
(should-error (should-error
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'(test . failure) :key '(test . failure)
(lambda () :stage (lambda ()
(setq external 'candidate) (setq external 'candidate)
(error "Participant failure")) (error "Participant failure"))
(lambda () :rollback (lambda ()
(setq external 'old (setq external 'old
rollback-ran t))) rollback-ran t)))
(tp-signal-set signal 2))) (tp-signal-set signal 2)))
@ -2736,8 +2736,10 @@
"Participant keys are unique within the outer transaction." "Participant keys are unique within the outer transaction."
(should-error (should-error
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate 'same #'ignore #'ignore) (tp-transaction-participate-v2
(tp-transaction-participate 'same #'ignore #'ignore)) :key 'same :stage #'ignore :rollback #'ignore)
(tp-transaction-participate-v2
:key 'same :stage #'ignore :rollback #'ignore))
:type 'tp-reactive-error)) :type 'tp-reactive-error))
(ert-deftest tp-surface-test-equal-reactive-plan-skips-surface-publication () (ert-deftest tp-surface-test-equal-reactive-plan-skips-surface-publication ()

403
tests/tp-transaction-tests.el
View File

@ -4,8 +4,8 @@
;;; Commentary: ;;; Commentary:
;; Characterization and fault tests for the v1+v2 transaction protocol and its ;; Characterization and fault tests for the v2 transaction protocol. These
;; controlled structured-authority cutover. These tests deliberately exercise ;; tests deliberately exercise
;; the internal protocol: the public contract remains `tp-with-transaction' ;; the internal protocol: the public contract remains `tp-with-transaction'
;; body return and primary condition preservation. ;; body return and primary condition preservation.
@ -23,10 +23,6 @@
(declare-function tp--transaction-participant-journal "tp-reactive" (value)) (declare-function tp--transaction-participant-journal "tp-reactive" (value))
(declare-function tp--transaction-register-final-marker (declare-function tp--transaction-register-final-marker
"tp-reactive" (&rest args)) "tp-reactive" (&rest args))
(declare-function tp-runtime-manifest "tp" ())
(defvar tp--transaction-artifact-mode)
(defvar tp-transaction-execution-route)
(defvar tp--transaction-publication-batch) (defvar tp--transaction-publication-batch)
(defvar tp--transaction-outcome) (defvar tp--transaction-outcome)
(defvar tp--last-shadow-proof) (defvar tp--last-shadow-proof)
@ -237,8 +233,8 @@
(when (tp-signal-live-p ,source) (when (tp-signal-live-p ,source)
(tp-signal-dispose ,source))))) (tp-signal-dispose ,source)))))
(ert-deftest tp-transaction-test-v1-body-return-and-phase-order () (ert-deftest tp-transaction-test-v2-body-return-and-phase-order ()
"The v1 facade returns BODY and retains its established phase order." "The v2 facade returns BODY and retains its established phase order."
(let ((tp-transaction-test--trace nil) (let ((tp-transaction-test--trace nil)
(tp--transaction-precommit-functions (tp--transaction-precommit-functions
'(tp--transaction-test-precommit-inject)) '(tp--transaction-test-precommit-inject))
@ -247,10 +243,10 @@
(should (should
(equal (equal
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'v1 :key 'v2
(lambda () (push 'participant tp-transaction-test--trace)) :stage (lambda () (push 'participant tp-transaction-test--trace))
(lambda () (push 'rollback tp-transaction-test--trace))) :rollback (lambda () (push 'rollback tp-transaction-test--trace)))
(tp--enqueue-after-commit (tp--enqueue-after-commit
(lambda () (push 'after-commit tp-transaction-test--trace))) (lambda () (push 'after-commit tp-transaction-test--trace)))
(push 'body tp-transaction-test--trace) (push 'body tp-transaction-test--trace)
@ -259,8 +255,8 @@
(should (equal (nreverse tp-transaction-test--trace) (should (equal (nreverse tp-transaction-test--trace)
'(body participant precommit after-commit))))) '(body participant precommit after-commit)))))
(ert-deftest tp-transaction-test-v1-participant-and-precommit-fault-order () (ert-deftest tp-transaction-test-v2-participant-and-precommit-fault-order ()
"A late v1 fault rolls staged participants back in reverse order." "A late v2 fault rolls staged participants back in reverse order."
(let* ((injected '(tp-transaction-test-error :phase precommit :raw (1 2))) (let* ((injected '(tp-transaction-test-error :phase precommit :raw (1 2)))
(tp-transaction-test--trace nil) (tp-transaction-test--trace nil)
(tp-transaction-test--precommit-condition injected) (tp-transaction-test--precommit-condition injected)
@ -272,14 +268,14 @@
(tp-transaction-test--capture (tp-transaction-test--capture
(lambda () (lambda ()
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'first :key 'first
(lambda () (push 'stage-first tp-transaction-test--trace)) :stage (lambda () (push 'stage-first tp-transaction-test--trace))
(lambda () (push 'rollback-first tp-transaction-test--trace))) :rollback (lambda () (push 'rollback-first tp-transaction-test--trace)))
(tp-transaction-participate (tp-transaction-participate-v2
'second :key 'second
(lambda () (push 'stage-second tp-transaction-test--trace)) :stage (lambda () (push 'stage-second tp-transaction-test--trace))
(lambda () (push 'rollback-second tp-transaction-test--trace)))))))) :rollback (lambda () (push 'rollback-second tp-transaction-test--trace))))))))
(should (equal failure injected)) (should (equal failure injected))
(should (equal (nreverse tp-transaction-test--trace) (should (equal (nreverse tp-transaction-test--trace)
'(stage-first stage-second precommit '(stage-first stage-second precommit
@ -356,14 +352,15 @@
(should-error (tp--publication-batch-transition discarded 'staged) (should-error (tp--publication-batch-transition discarded 'staged)
:type 'tp-publication-state-error)))) :type 'tp-publication-state-error))))
(ert-deftest tp-transaction-test-v1-bridge-is-the-structured-participant () (ert-deftest tp-transaction-test-v2-participant-is-single-structured-record ()
"The v1 facade installs one v2 record, not parallel participant state." "The v2 facade installs one structured record with no legacy bridge."
(let (saved) (let (saved)
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate 'legacy #'ignore #'ignore) (tp-transaction-participate-v2 :key 'structured :stage #'ignore
:rollback #'ignore)
(setq saved (car tp--transaction-participants)) (setq saved (car tp--transaction-participants))
(should (= (length tp--transaction-participants) 1)) (should (= (length tp--transaction-participants) 1))
(should (eq (tp--transaction-participant-protocol saved) 'v1-bridge)) (should (eq (tp--transaction-participant-protocol saved) 'v2))
(should (eq (tp--transaction-participant-state saved) 'prepared))) (should (eq (tp--transaction-participant-state saved) 'prepared)))
(should (eq (tp--transaction-participant-state saved) 'committed)))) (should (eq (tp--transaction-participant-state saved) 'committed))))
@ -389,12 +386,10 @@
'(:owner old-state))) '(:owner old-state)))
(should (eq (tp--transaction-participant-state participant) 'committed)))) (should (eq (tp--transaction-participant-state participant) 'committed))))
(ert-deftest tp-transaction-test-public-v2-participant-api-spans-both-routes () (ert-deftest tp-transaction-test-public-v2-participant-api-registers-v2-record ()
"The public v2 API registers one v2 object under structured and v1 writers." "The public v2 API registers one v2 object on the sole live route."
(dolist (route '(structured v1)) (let ((tp-transaction-test--trace nil)
(let ((tp-transaction-execution-route route) participant)
(tp-transaction-test--trace nil)
participant)
(should (should
(eq (eq
(tp-with-transaction (tp-with-transaction
@ -413,7 +408,7 @@
(should (eq (tp--transaction-participant-protocol participant) 'v2)) (should (eq (tp--transaction-participant-protocol participant) 'v2))
(should (equal (tp--transaction-participant-journal participant) (should (equal (tp--transaction-participant-journal participant)
'(:owner public))) '(:owner public)))
(should (eq (tp--transaction-participant-state participant) 'committed))))) (should (eq (tp--transaction-participant-state participant) 'committed))))
(ert-deftest tp-transaction-test-v2-participant-stage-fault-rolls-back-prior-only () (ert-deftest tp-transaction-test-v2-participant-stage-fault-rolls-back-prior-only ()
"A structured stage fault reverses only participants that entered staged." "A structured stage fault reverses only participants that entered staged."
@ -606,6 +601,10 @@
tp--last-transaction-outcome)) tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts (tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list surface)) tp--last-transaction-outcome (list surface))
(should (equal (plist-get tp--last-shadow-proof :phase) 'commit))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 1))
(should (eq (plist-get (should (eq (plist-get
(tp--committed-success-outcome-snapshot (tp--committed-success-outcome-snapshot
tp--last-transaction-outcome) tp--last-transaction-outcome)
@ -791,8 +790,7 @@
(dolist (id before) (dolist (id before)
(should (memq id outcome-ids))) (should (memq id outcome-ids)))
(tp-transaction-test--should-match-outcome-counts (tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list surface)) tp--last-transaction-outcome (list surface))))
(should (plist-get tp--last-shadow-proof :equivalent))))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest tp-transaction-test-candidates-remain-invisible-until-staged () (ert-deftest tp-transaction-test-candidates-remain-invisible-until-staged ()
@ -811,8 +809,8 @@
(with-current-buffer buffer (with-current-buffer buffer
(should (equal (buffer-string) text)))))) (should (equal (buffer-string) text))))))
(ert-deftest tp-transaction-test-shadow-is-multisurface-and-single-writer () (ert-deftest tp-transaction-test-v2-is-multisurface-and-single-writer ()
"Shadow artifacts cover all surfaces while each live writer runs once." "The v2 artifacts cover all surfaces while each live writer runs once."
(let* ((source (tp-signal-create 1)) (let* ((source (tp-signal-create 1))
(producer (tp-transaction-test--producer source)) (producer (tp-transaction-test--producer source))
(first-buffer (generate-new-buffer " *tp-transaction-first*")) (first-buffer (generate-new-buffer " *tp-transaction-first*"))
@ -828,16 +826,17 @@
(let ((surface (tp--prepared-surface-surface prepared))) (let ((surface (tp--prepared-surface-surface prepared)))
(puthash surface (1+ (gethash surface calls 0)) calls)) (puthash surface (1+ (gethash surface calls 0)) calls))
(funcall writer prepared)))) (funcall writer prepared))))
(let ((tp--transaction-artifact-mode 'shadow)) (tp-signal-set source 2)
(tp-signal-set source 2))
(should (= (gethash first calls 0) 1)) (should (= (gethash first calls 0) 1))
(should (= (gethash second calls 0) 1)) (should (= (gethash second calls 0) 1))
(should (tp-committed-success-outcome-p (should (tp-committed-success-outcome-p
tp--last-transaction-outcome)) tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts (tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list first second)) tp--last-transaction-outcome (list first second))
(should (equal (plist-get tp--last-shadow-proof :phase) 'commit))
(should (plist-get tp--last-shadow-proof :equivalent)) (should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent)) (should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 2))
(should (integerp (should (integerp
(tp-committed-success-outcome-mapping-generation (tp-committed-success-outcome-mapping-generation
tp--last-transaction-outcome))) tp--last-transaction-outcome)))
@ -855,6 +854,31 @@
(when (buffer-live-p second-buffer) (kill-buffer second-buffer)) (when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(when (tp-signal-live-p source) (tp-signal-dispose source))))) (when (tp-signal-live-p source) (tp-signal-dispose source)))))
(ert-deftest tp-transaction-test-canonical-artifact-mismatch-is-diagnostic ()
"A postcommit canonical artifact mismatch is detected and contained."
(tp-transaction-test--with-surface (buffer surface source)
(let ((current-artifact (symbol-function 'tp--shadow-current-artifact)))
(cl-letf (((symbol-function 'tp--shadow-current-artifact)
(lambda (target)
(let ((artifact (funcall current-artifact target)))
(plist-put artifact :revision
(1+ (plist-get artifact :revision)))))))
(tp-signal-set source 2))
(should (= (tp-signal-peek source) 2))
(should (= (tp-surface-revision surface) 2))
(with-current-buffer buffer
(should (equal (buffer-string) "2")))
(should (equal (plist-get tp--last-shadow-proof :phase) 'commit))
(should-not (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 1))
(should
(cl-some
(lambda (entry)
(and (eq (car entry) 'shadow-proof)
(eq (cadr entry) 'commit)))
tp--last-transaction-diagnostics)))))
(ert-deftest tp-transaction-test-zero-surface-does-not-create-batch-or-outcome () (ert-deftest tp-transaction-test-zero-surface-does-not-create-batch-or-outcome ()
"Pure, semantic and external-only transactions stay outside batch API." "Pure, semantic and external-only transactions stay outside batch API."
(let ((tp--last-transaction-outcome 'sentinel) (let ((tp--last-transaction-outcome 'sentinel)
@ -868,7 +892,8 @@
(should-not captured-outcome) (should-not captured-outcome)
(should-not tp--last-transaction-outcome) (should-not tp--last-transaction-outcome)
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate 'external-only #'ignore #'ignore)) (tp-transaction-participate-v2 :key 'external-only
:stage #'ignore :rollback #'ignore))
(should-not tp--last-transaction-outcome))) (should-not tp--last-transaction-outcome)))
(ert-deftest tp-transaction-test-unobserved-signal-excludes-publication-batch () (ert-deftest tp-transaction-test-unobserved-signal-excludes-publication-batch ()
@ -885,8 +910,7 @@
(should (= (tp-signal-peek signal) 2)) (should (= (tp-signal-peek signal) 2))
(should (= (tp-signal-revision signal) 1)) (should (= (tp-signal-revision signal) 1))
(should (= batch-calls 0)) (should (= batch-calls 0))
(should-not tp--last-transaction-outcome) (should-not tp--last-transaction-outcome))
(should-not tp--last-shadow-proof))
(when (tp-signal-live-p signal) (tp-signal-dispose signal))))) (when (tp-signal-live-p signal) (tp-signal-dispose signal)))))
(ert-deftest tp-transaction-test-surface-unmount-excludes-publication-batch () (ert-deftest tp-transaction-test-surface-unmount-excludes-publication-batch ()
@ -900,8 +924,7 @@
(batch-calls 0)) (batch-calls 0))
(unwind-protect (unwind-protect
(progn (progn
(setq tp--last-transaction-outcome nil (setq tp--last-transaction-outcome nil)
tp--last-shadow-proof nil)
(cl-letf (cl-letf
(((symbol-function 'tp--transaction-begin-publication-batch) (((symbol-function 'tp--transaction-begin-publication-batch)
(lambda (&rest arguments) (lambda (&rest arguments)
@ -910,7 +933,6 @@
(tp-surface-unmount surface)) (tp-surface-unmount surface))
(should (= batch-calls 0)) (should (= batch-calls 0))
(should-not tp--last-transaction-outcome) (should-not tp--last-transaction-outcome)
(should-not tp--last-shadow-proof)
(should-not (tp-surface-live-p surface)) (should-not (tp-surface-live-p surface))
(with-current-buffer buffer (with-current-buffer buffer
(should (equal (buffer-string) "")))) (should (equal (buffer-string) ""))))
@ -966,13 +988,11 @@
(should (= (length outcome-cell) 1)) (should (= (length outcome-cell) 1))
(should (tp-committed-success-outcome-p (aref outcome-cell 0))) (should (tp-committed-success-outcome-p (aref outcome-cell 0)))
(should (eq (aref outcome-cell 0) tp--last-transaction-outcome)) (should (eq (aref outcome-cell 0) tp--last-transaction-outcome))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (tp-surface-revision surface) (1+ old-revision))) (should (= (tp-surface-revision surface) (1+ old-revision)))
(with-current-buffer buffer (with-current-buffer buffer
(should (equal (buffer-string) "2")))))) (should (equal (buffer-string) "2"))))))
(ert-deftest tp-transaction-test-scoped-content-shadow-equivalence () (ert-deftest tp-transaction-test-scoped-content-v2-publication ()
"Scoped content artifacts equal the single committed writer result." "Scoped content artifacts equal the single committed writer result."
(let ((buffer (generate-new-buffer " *tp-transaction-scoped*")) (let ((buffer (generate-new-buffer " *tp-transaction-scoped*"))
(middle "B") (middle "B")
@ -1005,9 +1025,8 @@
(revision (tp-surface-revision surface))) (revision (tp-surface-revision surface)))
(setq middle "LONG" (setq middle "LONG"
middle-face 'italic) middle-face 'italic)
(let ((tp--transaction-artifact-mode 'shadow)) (tp-surface-update-scoped
(tp-surface-update-scoped surface (list middle-object) producer)
surface (list middle-object) producer))
(should (= (tp-surface-revision surface) (1+ revision))) (should (= (tp-surface-revision surface) (1+ revision)))
(with-current-buffer buffer (with-current-buffer buffer
(should (equal (buffer-string) "ALONGC")) (should (equal (buffer-string) "ALONGC"))
@ -1015,14 +1034,10 @@
(should (tp-committed-success-outcome-p (should (tp-committed-success-outcome-p
tp--last-transaction-outcome)) tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts (tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list surface)) tp--last-transaction-outcome (list surface)))
(should (equal (plist-get tp--last-shadow-proof :phase) 'commit))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 1)))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest tp-transaction-test-properties-only-shadow-equivalence () (ert-deftest tp-transaction-test-properties-only-v2-publication ()
"Properties-only artifacts equal live properties without replacing text." "Properties-only artifacts equal live properties without replacing text."
(let ((buffer (generate-new-buffer " *tp-transaction-properties*")) (let ((buffer (generate-new-buffer " *tp-transaction-properties*"))
(value 'bold)) (value 'bold))
@ -1043,19 +1058,14 @@
buffer producer '(:capability properties))) buffer producer '(:capability properties)))
(revision (tp-surface-revision surface))) (revision (tp-surface-revision surface)))
(setq value 'italic) (setq value 'italic)
(let ((tp--transaction-artifact-mode 'shadow)) (tp-surface-update surface producer)
(tp-surface-update surface producer))
(should (equal (buffer-string) "host")) (should (equal (buffer-string) "host"))
(should (eq (get-text-property 2 'face) 'italic)) (should (eq (get-text-property 2 'face) 'italic))
(should (= (tp-surface-revision surface) (1+ revision))) (should (= (tp-surface-revision surface) (1+ revision)))
(should (tp-committed-success-outcome-p (should (tp-committed-success-outcome-p
tp--last-transaction-outcome)) tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts (tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list surface)) tp--last-transaction-outcome (list surface))))
(should (equal (plist-get tp--last-shadow-proof :phase) 'commit))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 1))))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest tp-transaction-test-property-surface-fault-matrix-restores-exact-state () (ert-deftest tp-transaction-test-property-surface-fault-matrix-restores-exact-state ()
@ -1126,11 +1136,11 @@
(lambda () (lambda ()
(tp-with-transaction (tp-with-transaction
(when (eq phase 'participant) (when (eq phase 'participant)
(tp-transaction-participate (tp-transaction-participate-v2
'property-fault-participant :key 'property-fault-participant
(lambda () :stage (lambda ()
(signal (car injected) (cdr injected))) (signal (car injected) (cdr injected)))
#'ignore)) :rollback #'ignore))
(tp-signal-set source 2))))) (tp-signal-set source 2)))))
injected))) injected)))
(should (= (tp-signal-peek source) 1)) (should (= (tp-signal-peek source) 1))
@ -1144,106 +1154,18 @@
(with-current-buffer second-buffer (with-current-buffer second-buffer
(should (eq (get-text-property 2 'face) 'bold))) (should (eq (get-text-property 2 'face) 'bold)))
(should (tp-publication-failure-outcome-p (should (tp-publication-failure-outcome-p
tp--last-transaction-outcome)) tp--last-transaction-outcome)))
(should (equal (plist-get tp--last-shadow-proof :phase)
'rollback))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 2)))
(when (buffer-live-p first-buffer) (kill-buffer first-buffer)) (when (buffer-live-p first-buffer) (kill-buffer first-buffer))
(when (buffer-live-p second-buffer) (kill-buffer second-buffer)) (when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(when (tp-signal-live-p source) (tp-signal-dispose source)))))) (when (tp-signal-live-p source) (tp-signal-dispose source))))))
(ert-deftest tp-transaction-test-v1-and-shadow-artifact-modes-are-equivalent () (ert-deftest tp-transaction-test-final-accept-source-uses-v2-binding ()
"Independent v1 and shadow surfaces commit identical live artifacts." "V2 validates the candidate final accept binding before publication."
(let* ((v1-buffer (generate-new-buffer " *tp-transaction-v1*"))
(shadow-buffer (generate-new-buffer " *tp-transaction-shadow*"))
(initial
(tp-surface-plan-create
:key 'root :kind 'text :text "old" :props '(face bold)
:capability 'content))
(next
(tp-surface-plan-create
:key 'root :kind 'text :text "new" :props '(face italic)
:capability 'content))
(v1-surface
(tp-surface-mount v1-buffer initial '(:capability content)))
(shadow-surface
(tp-surface-mount shadow-buffer initial '(:capability content)))
(writer (symbol-function 'tp--publish-one-surface))
(shadow-writes 0))
(unwind-protect
(progn
(let ((tp-transaction-execution-route 'v1)
(tp--transaction-artifact-mode 'v1))
(tp-surface-update v1-surface next))
(should-not tp--last-transaction-outcome)
(should-not tp--last-shadow-proof)
(cl-letf (((symbol-function 'tp--publish-one-surface)
(lambda (prepared)
(cl-incf shadow-writes)
(funcall writer prepared))))
(let ((tp--transaction-artifact-mode 'shadow))
(let ((tp-transaction-execution-route 'v1))
(tp-surface-update shadow-surface next))))
(should (= shadow-writes 1))
(should (tp-committed-success-outcome-p
tp--last-transaction-outcome))
(should (plist-get tp--last-shadow-proof :equivalent))
(should (plist-get tp--last-shadow-proof :outcome-equivalent))
(should (= (tp-surface-revision v1-surface)
(tp-surface-revision shadow-surface)))
(should
(equal-including-properties
(with-current-buffer v1-buffer (buffer-string))
(with-current-buffer shadow-buffer (buffer-string))))
(with-current-buffer v1-buffer
(should (equal (buffer-string) "new"))
(should (eq (get-text-property 1 'face) 'italic))))
(when (buffer-live-p v1-buffer) (kill-buffer v1-buffer))
(when (buffer-live-p shadow-buffer) (kill-buffer shadow-buffer)))))
(ert-deftest tp-transaction-test-structured-and-v1-routes-are-equivalent ()
"Structured and v1 authorities commit equivalent state with one write each."
(let* ((structured-buffer (generate-new-buffer " *tp-route-structured*"))
(v1-buffer (generate-new-buffer " *tp-route-v1*"))
(initial (tp-transaction-test--leaf "old"))
(next (tp-transaction-test--leaf "new"))
(structured (tp-surface-mount structured-buffer initial
'(:capability content)))
(v1 (tp-surface-mount v1-buffer initial '(:capability content)))
(writer (symbol-function 'tp--publish-one-surface))
(writes (make-hash-table :test #'eq)))
(unwind-protect
(cl-letf (((symbol-function 'tp--publish-one-surface)
(lambda (prepared)
(let ((surface (tp--prepared-surface-surface prepared)))
(puthash surface (1+ (gethash surface writes 0)) writes))
(funcall writer prepared))))
(let ((tp-transaction-execution-route 'structured)
(tp--transaction-artifact-mode 'v1))
(tp-surface-update structured next))
(let ((tp-transaction-execution-route 'v1)
(tp--transaction-artifact-mode 'v1))
(tp-surface-update v1 next))
(should (= (gethash structured writes 0) 1))
(should (= (gethash v1 writes 0) 1))
(should (= (tp-surface-revision structured) (tp-surface-revision v1)))
(should (equal-including-properties
(with-current-buffer structured-buffer (buffer-string))
(with-current-buffer v1-buffer (buffer-string)))))
(when (buffer-live-p structured-buffer) (kill-buffer structured-buffer))
(when (buffer-live-p v1-buffer) (kill-buffer v1-buffer)))))
(ert-deftest tp-transaction-test-final-accept-source-follows-route ()
"Structured validates candidate final accept; v1 shadow uses legacy binding."
(let* ((structured-buffer (generate-new-buffer " *tp-final-structured*")) (let* ((structured-buffer (generate-new-buffer " *tp-final-structured*"))
(v1-buffer (generate-new-buffer " *tp-final-v1*"))
(initial (tp-transaction-test--leaf "old")) (initial (tp-transaction-test--leaf "old"))
(next (tp-transaction-test--leaf "new")) (next (tp-transaction-test--leaf "new"))
(structured (tp-surface-mount structured-buffer initial (structured (tp-surface-mount structured-buffer initial
'(:capability content))) '(:capability content)))
(v1 (tp-surface-mount v1-buffer initial '(:capability content)))
(sync (symbol-function 'tp--transaction-sync-publication-batch))) (sync (symbol-function 'tp--transaction-sync-publication-batch)))
(unwind-protect (unwind-protect
(cl-letf (((symbol-function 'tp--transaction-sync-publication-batch) (cl-letf (((symbol-function 'tp--transaction-sync-publication-batch)
@ -1253,23 +1175,14 @@
(setf (tp-publication-batch-candidate-final-accept (setf (tp-publication-batch-candidate-final-accept
tp--transaction-publication-batch) tp--transaction-publication-batch)
#'ignore))))) #'ignore)))))
(let ((tp-transaction-execution-route 'structured)) (should-error (tp-surface-update structured next)
(should-error (tp-surface-update structured next) :type 'tp-publication-binding-error)
:type 'tp-publication-binding-error))
(with-current-buffer structured-buffer (with-current-buffer structured-buffer
(should (equal (buffer-string) "old"))) (should (equal (buffer-string) "old")))
(let ((tp-transaction-execution-route 'v1) (should (tp-publication-failure-outcome-p
(tp--transaction-artifact-mode 'shadow)) tp--last-transaction-outcome)))
(tp-surface-update v1 next))
(with-current-buffer v1-buffer
(should (equal (buffer-string) "new")))
(should (tp-committed-success-outcome-p tp--last-transaction-outcome)))
(when (buffer-live-p structured-buffer) (kill-buffer structured-buffer)) (when (buffer-live-p structured-buffer) (kill-buffer structured-buffer))
(when (buffer-live-p v1-buffer) (kill-buffer v1-buffer))))) )))
(ert-deftest tp-transaction-test-default-execution-route-is-structured ()
"The supported live execution route defaults to the structured core."
(should (eq (default-value 'tp-transaction-execution-route) 'structured)))
(ert-deftest tp-transaction-test-structured-batch-owns-surface-stage-once () (ert-deftest tp-transaction-test-structured-batch-owns-surface-stage-once ()
"Structured execution enters the candidate seam and writes each entry once." "Structured execution enters the candidate seam and writes each entry once."
@ -1293,9 +1206,7 @@
(let ((surface (tp--prepared-surface-surface prepared))) (let ((surface (tp--prepared-surface-surface prepared)))
(puthash surface (1+ (gethash surface calls 0)) calls)) (puthash surface (1+ (gethash surface calls 0)) calls))
(funcall writer prepared)))) (funcall writer prepared))))
(let ((tp-transaction-execution-route 'structured) (tp-signal-set source 2)
(tp--transaction-artifact-mode 'v1))
(tp-signal-set source 2))
(should (= stage-calls 1)) (should (= stage-calls 1))
(should (= (gethash first calls 0) 1)) (should (= (gethash first calls 0) 1))
(should (= (gethash second calls 0) 1)) (should (= (gethash second calls 0) 1))
@ -1304,93 +1215,27 @@
(when (buffer-live-p second-buffer) (kill-buffer second-buffer)) (when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(when (tp-signal-live-p source) (tp-signal-dispose source))))) (when (tp-signal-live-p source) (tp-signal-dispose source)))))
(ert-deftest tp-transaction-test-public-v1-adapter-stages-once-from-batch () (ert-deftest tp-transaction-test-public-v2-participant-stages-once-from-batch ()
"The public v1 adapter is one structured participant in the batch vector." "The public v2 participant is one structured participant in the batch vector."
(tp-transaction-test--with-surface (buffer _surface source) (tp-transaction-test--with-surface (buffer _surface source)
(let ((stages 0) captured participant) (let ((stages 0) captured participant)
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'public-v1 :key 'public-v2
(lambda () :stage (lambda ()
(cl-incf stages) (cl-incf stages)
(setq captured tp--transaction-publication-batch (setq captured tp--transaction-publication-batch
participant participant
(aref (tp-publication-batch-candidate-participants (aref (tp-publication-batch-candidate-participants
tp--transaction-publication-batch) tp--transaction-publication-batch)
0))) 0)))
#'ignore) :rollback #'ignore)
(tp-signal-set source 2)) (tp-signal-set source 2))
(should (= stages 1)) (should (= stages 1))
(should (tp-publication-batch-candidate-p captured)) (should (tp-publication-batch-candidate-p captured))
(should (eq (tp--transaction-participant-protocol participant) (should (eq (tp--transaction-participant-protocol participant) 'v2))
'v1-bridge))
(should (eq (tp--transaction-participant-state participant) 'committed))))) (should (eq (tp--transaction-participant-state participant) 'committed)))))
(ert-deftest tp-transaction-test-v1-kill-switch-preserves-legacy-authority ()
"The v1 kill switch uses legacy loops without a structured batch writer."
(tp-transaction-test--with-surface (buffer _surface source)
(let ((tp-transaction-execution-route 'v1)
(tp--transaction-artifact-mode 'v1)
(stage-seam-calls 0)
(participant-calls 0)
(seam (symbol-function 'tp--publication-batch-execute-stage)))
(cl-letf (((symbol-function 'tp--publication-batch-execute-stage)
(lambda (candidate)
(cl-incf stage-seam-calls)
(funcall seam candidate))))
(should
(eq (tp-with-transaction
(tp-transaction-participate
'legacy (lambda () (cl-incf participant-calls)) #'ignore)
(tp-signal-set source 2)
'legacy-result)
'legacy-result)))
(should (= stage-seam-calls 0))
(should (= participant-calls 1))
(should-not tp--last-transaction-outcome))))
(ert-deftest tp-transaction-test-invalid-route-fails-before-body-mutation ()
"An invalid route is rejected before the transaction body can mutate state."
(let ((tp-transaction-execution-route 'invalid)
(body-calls 0))
(should-error
(tp-with-transaction (cl-incf body-calls))
:type 'tp-transaction-contract-error)
(should (= body-calls 0))))
(ert-deftest tp-transaction-test-route-change-applies-to-next-outer-transaction ()
"An active outer transaction keeps its snapshot; the next uses the new route."
(tp-transaction-test--with-surface (buffer surface source)
(let ((revision (tp-surface-revision surface))
(tp-transaction-execution-route 'structured)
(tp--transaction-artifact-mode 'v1)
(stage (symbol-function 'tp--publication-batch-execute-stage))
(writer (symbol-function 'tp--publish-one-surface))
(stage-calls 0)
(writer-calls 0)
first-outcome)
(cl-letf (((symbol-function 'tp--publication-batch-execute-stage)
(lambda (candidate)
(cl-incf stage-calls)
(funcall stage candidate)))
((symbol-function 'tp--publish-one-surface)
(lambda (prepared)
(cl-incf writer-calls)
(funcall writer prepared))))
(tp-with-transaction
(tp-signal-set source 2)
(setq tp-transaction-execution-route 'v1))
(setq first-outcome tp--last-transaction-outcome)
(tp-signal-set source 3))
(should (tp-committed-success-outcome-p first-outcome))
(should-not tp--last-transaction-outcome)
(should (= stage-calls 1))
(should (= writer-calls 2))
(should (= (tp-signal-peek source) 3))
(should (= (tp-surface-revision surface) (+ revision 2)))
(with-current-buffer buffer
(should (equal (buffer-string) "3"))))))
(ert-deftest tp-transaction-test-batch-rejects-foreign-stage-capability () (ert-deftest tp-transaction-test-batch-rejects-foreign-stage-capability ()
"A publication batch accepts only the closed package-owned stage seam." "A publication batch accepts only the closed package-owned stage seam."
(should-error (should-error
@ -1411,7 +1256,9 @@
(stage (symbol-function 'tp--publication-batch-execute-stage))) (stage (symbol-function 'tp--publication-batch-execute-stage)))
(cl-letf (((symbol-function 'tp--publication-batch-execute-stage) (cl-letf (((symbol-function 'tp--publication-batch-execute-stage)
(lambda (candidate) (lambda (candidate)
(tp-transaction-participate 'late #'ignore #'ignore) (tp-transaction-participate-v2 :key 'late
:stage #'ignore
:rollback #'ignore)
(funcall stage candidate)))) (funcall stage candidate))))
(should-error (tp-signal-set source 2) (should-error (tp-signal-set source 2)
:type 'tp-publication-binding-error)) :type 'tp-publication-binding-error))
@ -1494,7 +1341,7 @@
(should (eq (aref overflow-target 0) 'old))))) (should (eq (aref overflow-target 0) 'old)))))
(ert-deftest tp-transaction-test-marker-restore-faults-exhaust-all-markers () (ert-deftest tp-transaction-test-marker-restore-faults-exhaust-all-markers ()
"Restore error, quit, and throw cannot skip markers or v1 rollback." "Restore error, quit, and throw cannot skip markers or rollback."
(dolist (kind '(error quit throw)) (dolist (kind '(error quit throw))
(tp-transaction-test--with-surface (buffer surface source) (tp-transaction-test--with-surface (buffer surface source)
(let* ((targets (let* ((targets
@ -1577,7 +1424,7 @@
'(tp-transaction-test-error :phase after-commit)))) '(tp-transaction-test-error :phase after-commit))))
tp--last-transaction-diagnostics)))) tp--last-transaction-diagnostics))))
(ert-deftest tp-transaction-test-marker-nonlocal-throw-restores-v1-state () (ert-deftest tp-transaction-test-marker-nonlocal-throw-restores-state ()
"Marker apply and accept throws reverse authority and live publication." "Marker apply and accept throws reverse authority and live publication."
(dolist (phase '(apply accept)) (dolist (phase '(apply accept))
(tp-transaction-test--with-surface (buffer surface source) (tp-transaction-test--with-surface (buffer surface source)
@ -1614,41 +1461,31 @@
(with-current-buffer buffer (with-current-buffer buffer
(should (equal (buffer-string) "1"))))))) (should (equal (buffer-string) "1")))))))
(ert-deftest tp-transaction-test-manifest-advertises-structured-cutover () (ert-deftest tp-transaction-test-manifest-advertises-v2-only-contract ()
"The manifest advertises structured authority and the retained v1 route." "The manifest advertises v2 without any legacy route capability."
(should (eq tp-transaction-protocol (should (eq tp-transaction-protocol 'tp-transaction-protocol-v2))
'tp-transaction-protocol-v1+v2))
(let ((manifest (tp-runtime-manifest))) (let ((manifest (tp-runtime-manifest)))
(should (equal (plist-get manifest :version) "1.0.1")) (should (equal (plist-get manifest :version) "2.0.0"))
(should (eq (plist-get manifest :transaction-protocol) (should (eq (plist-get manifest :transaction-protocol)
'tp-transaction-protocol-v1+v2)) 'tp-transaction-protocol-v2))
(should (plist-get manifest :batch-artifacts))
(should (eq (plist-get manifest :execution-route) 'structured))
(should (eq (plist-get manifest :execution-default) 'structured))
(should (equal (plist-get manifest :execution-routes)
'(structured v1)))
(should (eq (plist-get manifest :route-option)
'tp-transaction-execution-route))
(should (eq (plist-get manifest :batch-execution) 'structured))
(should (plist-get manifest :batch-execute))
(should (eq (plist-get manifest :structured-participant-api) (should (eq (plist-get manifest :structured-participant-api)
'tp-transaction-participate-v2)) 'tp-transaction-participate-v2))
(should (plist-get manifest :v1-adapter)) (should (plist-get manifest :batch-artifacts))
(should (plist-get manifest :v1-rollback-route)) (should (plist-get manifest :batch-execute))
(should (plist-get manifest :single-live-writer)) (should (plist-get manifest :single-live-writer))
(should (plist-get manifest :shadow-proof)) (dolist (property '(:execution-route :execution-default :execution-routes
(should (eq (plist-get manifest :final-marker-operation) :route-option :batch-execution :v1-adapter
'tp-vector-slots/v1)) :v1-rollback-route))
(setcar (plist-get manifest :execution-routes) 'mutated) (should-not (plist-member manifest property)))))
(setf (plist-get manifest :transaction-protocol) 'mutated
(plist-get manifest :execution-route) 'v1 (ert-deftest tp-transaction-test-v1-public-controls-are-absent ()
(plist-get manifest :batch-execute) nil) "TP 2.0 exposes no executable v1 facade or route switches."
(let ((fresh (tp-runtime-manifest))) (should-not (fboundp 'tp-transaction-participate))
(should (eq (plist-get fresh :transaction-protocol) (should-not (fboundp 'tp--publish-transaction-participants))
'tp-transaction-protocol-v1+v2)) (should-not (fboundp 'tp--surface-stage-v1-prepared))
(should (eq (plist-get fresh :execution-route) 'structured)) (should-not (fboundp 'tp--transaction-validate-execution-route))
(should (equal (plist-get fresh :execution-routes) '(structured v1))) (should-not (boundp 'tp-transaction-execution-route))
(should (plist-get fresh :batch-execute))))) (should-not (boundp 'tp--transaction-artifact-mode)))
(provide 'tp-transaction-tests) (provide 'tp-transaction-tests)

153
tp-reactive.el
View File

@ -11,7 +11,7 @@
;;; Commentary: ;;; Commentary:
;; TP 1.0's exact signal-to-binding dependency graph, transaction-local ;; TP 2.0's exact signal-to-binding dependency graph, transaction-local
;; scheduler, scoped variable adapters, and rollback state. ;; scheduler, scoped variable adapters, and rollback state.
;;; Code: ;;; Code:
@ -44,8 +44,8 @@
(cl-defstruct (tp--transaction-participant (cl-defstruct (tp--transaction-participant
(:constructor tp--make-transaction-participant)) (:constructor tp--make-transaction-participant))
"One structured participant shared by the v1 and v2 transaction views." "One structured transaction participant."
key publish rollback protocol order stage precommit after-commit journal state) key rollback protocol order stage precommit after-commit journal state)
(cl-defstruct (tp--signal-commit-entry (cl-defstruct (tp--signal-commit-entry
(:constructor tp--make-signal-commit-entry)) (:constructor tp--make-signal-commit-entry))
@ -95,7 +95,6 @@
(defvar tp--transaction-phase-timings nil) (defvar tp--transaction-phase-timings nil)
(defvar tp--transaction-publication-batch nil) (defvar tp--transaction-publication-batch nil)
(defvar tp--transaction-structured-participants nil) (defvar tp--transaction-structured-participants nil)
(defvar tp--transaction-frozen-execution-route nil)
(defvar tp--transaction-final-marker-registry nil) (defvar tp--transaction-final-marker-registry nil)
(defvar tp--transaction-final-marker-owner-keys nil) (defvar tp--transaction-final-marker-owner-keys nil)
(defvar tp--transaction-final-marker-count 0) (defvar tp--transaction-final-marker-count 0)
@ -128,18 +127,6 @@
(defvar tp--transaction-rollback-final-functions nil) (defvar tp--transaction-rollback-final-functions nil)
(defvar tp--transaction-committed-functions nil) (defvar tp--transaction-committed-functions nil)
(defvar tp--transaction-artifact-mode 'shadow
"Internal v1/shadow compatibility evidence mode.")
;;;###autoload
(defcustom tp-transaction-execution-route 'structured
"Live transaction execution authority.
`structured' executes package-owned batch and participant capabilities.
`v1' immediately restores the legacy prepared-list and participant-list loops."
:type '(choice (const :tag "Structured batch" structured)
(const :tag "Legacy v1" v1))
:group 'tp)
(defvar tp--transaction-participant-precommit-allowed-functions nil (defvar tp--transaction-participant-precommit-allowed-functions nil
"Declared internal structured-participant precommit validators.") "Declared internal structured-participant precommit validators.")
@ -671,7 +658,7 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
(fboundp function)))) (fboundp function))))
(defun tp--transaction-register-participant (participant) (defun tp--transaction-register-participant (participant)
"Register PARTICIPANT once for structured and legacy transaction views." "Register structured PARTICIPANT once in the active transaction."
(unless tp--transaction-active (unless tp--transaction-active
(signal 'tp-reactive-error (signal 'tp-reactive-error
(list :participant-outside-transaction (list :participant-outside-transaction
@ -686,12 +673,12 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
participant)) participant))
(defun tp--transaction-make-participant (defun tp--transaction-make-participant
(key publish rollback protocol precommit after-commit journal) (key stage rollback protocol precommit after-commit journal)
"Build a participant from KEY, PUBLISH, ROLLBACK, and PROTOCOL. "Build a participant from KEY, STAGE, ROLLBACK, and PROTOCOL.
PRECOMMIT and AFTER-COMMIT are optional internal callbacks; JOURNAL is opaque PRECOMMIT and AFTER-COMMIT are optional internal callbacks; JOURNAL is opaque
owner-local rollback state." owner-local rollback state."
(unless (functionp publish) (unless (functionp stage)
(signal 'wrong-type-argument (list 'functionp publish))) (signal 'wrong-type-argument (list 'functionp stage)))
(unless (functionp rollback) (unless (functionp rollback)
(signal 'wrong-type-argument (list 'functionp rollback))) (signal 'wrong-type-argument (list 'functionp rollback)))
(unless (tp--transaction-participant-precommit-function-p precommit) (unless (tp--transaction-participant-precommit-function-p precommit)
@ -701,36 +688,16 @@ owner-local rollback state."
(signal 'wrong-type-argument (list 'functionp after-commit))) (signal 'wrong-type-argument (list 'functionp after-commit)))
(tp--make-transaction-participant (tp--make-transaction-participant
:key (tp--copy-property-value key) :key (tp--copy-property-value key)
:publish publish
:rollback rollback :rollback rollback
:protocol protocol :protocol protocol
:order (prog1 tp--transaction-participant-order :order (prog1 tp--transaction-participant-order
(cl-incf tp--transaction-participant-order)) (cl-incf tp--transaction-participant-order))
:stage publish :stage stage
:precommit precommit :precommit precommit
:after-commit after-commit :after-commit after-commit
:journal journal :journal journal
:state 'prepared)) :state 'prepared))
;;;###autoload
(defun tp-transaction-participate (key publish rollback)
"Register rollback-capable PUBLISH work under transaction-local KEY.
PUBLISH runs after every affected surface has published its candidate buffer
and side state, but before the transaction commits its source values. If this
or any later publication step fails, ROLLBACK runs in reverse publication
order. Both functions take no arguments. KEY must be unique in the outer
transaction. The public v1 route is retained and receives an internal v2
structured view over the same participant object."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :participant-outside-transaction key)))
(unless key
(signal 'tp-reactive-error (list :participant-key key)))
(let ((participant
(tp--transaction-make-participant
key publish rollback 'v1-bridge nil nil nil)))
(tp--transaction-register-participant participant)
key))
(cl-defun tp--transaction-participate-v2 (cl-defun tp--transaction-participate-v2
(&key key stage rollback precommit after-commit journal) (&key key stage rollback precommit after-commit journal)
"Register internal KEY with structured STAGE and ROLLBACK capabilities. "Register internal KEY with structured STAGE and ROLLBACK capabilities.
@ -761,14 +728,6 @@ without exposing TP's internal participant object."
"Return the authoritative participants in deterministic declaration order." "Return the authoritative participants in deterministic declaration order."
(reverse tp--transaction-participants)) (reverse tp--transaction-participants))
(defun tp--publish-transaction-participants ()
"Publish registered transaction participants in declaration order."
(dolist (participant (tp--transaction-participants-in-registration-order))
(push participant tp--transaction-published-participants)
;; Mark first so a stage that mutates and then signals remains rollbackable.
(setf (tp--transaction-participant-state participant) 'staged)
(funcall (tp--transaction-participant-publish participant))))
(defun tp--transaction-validate-structured-participants () (defun tp--transaction-validate-structured-participants ()
"Return the frozen participant vector after exact identity validation." "Return the frozen participant vector after exact identity validation."
(let* ((participants tp--transaction-structured-participants) (let* ((participants tp--transaction-structured-participants)
@ -820,15 +779,6 @@ without exposing TP's internal participant object."
(setf (tp--transaction-participant-state participant) 'rolled-back))) (setf (tp--transaction-participant-state participant) 'rolled-back)))
(nreverse failures))) (nreverse failures)))
(defun tp--run-transaction-participant-precommits ()
"Run declared structured participant validators in registration order."
(dolist (participant (tp--transaction-participants-in-registration-order))
(when-let* ((function (tp--transaction-participant-precommit participant)))
(unless (tp--transaction-participant-precommit-function-p function)
(signal 'tp-reactive-error
(list :invalid-participant-precommit function)))
(funcall function))))
(defun tp--run-structured-transaction-participant-precommits () (defun tp--run-structured-transaction-participant-precommits ()
"Run validators from the frozen structured participant vector." "Run validators from the frozen structured participant vector."
(let ((participants (tp--transaction-validate-structured-participants))) (let ((participants (tp--transaction-validate-structured-participants)))
@ -841,15 +791,6 @@ without exposing TP's internal participant object."
(list :invalid-participant-precommit function))) (list :invalid-participant-precommit function)))
(funcall function))))) (funcall function)))))
(defun tp--commit-transaction-participants ()
"Commit participant states and queue their contained after-commit work."
(dolist (participant (tp--transaction-participants-in-registration-order))
(when (eq (tp--transaction-participant-state participant) 'staged)
(setf (tp--transaction-participant-state participant) 'committed)
(when-let* ((function
(tp--transaction-participant-after-commit participant)))
(tp--enqueue-after-commit function)))))
(defun tp--commit-structured-transaction-participants () (defun tp--commit-structured-transaction-participants ()
"Commit states from the frozen structured participant vector." "Commit states from the frozen structured participant vector."
(let ((participants (tp--transaction-validate-structured-participants))) (let ((participants (tp--transaction-validate-structured-participants)))
@ -947,34 +888,6 @@ without exposing TP's internal participant object."
tp--transaction-final-accept-function function))) tp--transaction-final-accept-function function)))
(setq tp--transaction-final-accept-function function)) (setq tp--transaction-final-accept-function function))
(defun tp--transaction-v2-artifacts-enabled-p ()
"Return non-nil when the additive v2 shadow artifacts are enabled."
(pcase tp--transaction-artifact-mode
('v1 nil)
((or 'shadow 'v1+v2-shadow) t)
(_ (signal 'tp-transaction-contract-error
(list :artifact-mode tp--transaction-artifact-mode)))))
(defun tp--transaction-validate-execution-route (route)
"Return supported execution ROUTE or signal before transaction mutation."
(unless (memq route '(structured v1))
(signal 'tp-transaction-contract-error (list :execution-route route)))
route)
(defun tp--transaction-current-execution-route ()
"Return the validated route frozen at outer transaction entry."
(tp--transaction-validate-execution-route
tp--transaction-frozen-execution-route))
(defun tp--transaction-structured-route-p ()
"Return non-nil when the frozen live route is `structured'."
(eq (tp--transaction-current-execution-route) 'structured))
(defun tp--transaction-publication-candidate-enabled-p ()
"Return non-nil when this transaction must build a publication candidate."
(or (tp--transaction-structured-route-p)
(tp--transaction-v2-artifacts-enabled-p)))
(defun tp--transaction-current-outcome-cell () (defun tp--transaction-current-outcome-cell ()
"Return the active transaction's caller-retainable one-slot outcome cell." "Return the active transaction's caller-retainable one-slot outcome cell."
(unless tp--transaction-active (unless tp--transaction-active
@ -1020,18 +933,17 @@ without exposing TP's internal participant object."
(when tp--transaction-publication-batch (when tp--transaction-publication-batch
(signal 'tp-publication-state-error (signal 'tp-publication-state-error
(list :duplicate-transaction-batch batch-id))) (list :duplicate-transaction-batch batch-id)))
(when (tp--transaction-publication-candidate-enabled-p) (setq tp--transaction-publication-batch
(setq tp--transaction-publication-batch (tp--publication-batch-prepare
(tp--publication-batch-prepare :transaction-id tp--transaction-id
:transaction-id tp--transaction-id :batch-id batch-id
:batch-id batch-id :entries entries
:entries entries :participants
:participants tp--transaction-structured-participants
tp--transaction-structured-participants :journals (tp--transaction-batch-journal-view surface-journals)
:journals (tp--transaction-batch-journal-view surface-journals) :stage-entries stage-entries
:stage-entries stage-entries :final-accept tp--transaction-final-accept-function
:final-accept tp--transaction-final-accept-function :diagnostics nil))
:diagnostics nil)))
tp--transaction-publication-batch) tp--transaction-publication-batch)
(defun tp--transaction-batch-transition (next) (defun tp--transaction-batch-transition (next)
@ -1247,8 +1159,7 @@ through TP's closed marker-operation whitelist."
(unwind-protect (unwind-protect
(progn (progn
(tp--transaction-apply-final-markers) (tp--transaction-apply-final-markers)
(if (and (tp--transaction-structured-route-p) (if tp--transaction-publication-batch
tp--transaction-publication-batch)
(let ((candidate-function (let ((candidate-function
(tp-publication-batch-candidate-final-accept (tp-publication-batch-candidate-final-accept
tp--transaction-publication-batch))) tp--transaction-publication-batch)))
@ -1281,8 +1192,7 @@ through TP's closed marker-operation whitelist."
(defun tp--transaction-run-shadow-proof (phase) (defun tp--transaction-run-shadow-proof (phase)
"Compare structured artifacts with the selected single live result for PHASE." "Compare structured artifacts with the selected single live result for PHASE."
(when (and tp--transaction-publication-batch (when tp--transaction-publication-batch
(tp--transaction-v2-artifacts-enabled-p))
(let ((ok t) results outcome-equivalent) (let ((ok t) results outcome-equivalent)
(dolist (entry (dolist (entry
(tp-publication-batch-candidate-entries (tp-publication-batch-candidate-entries
@ -1519,10 +1429,7 @@ the primary condition data."
"Call FUNCTION in one atomic signal and binding transaction." "Call FUNCTION in one atomic signal and binding transaction."
(if tp--transaction-active (if tp--transaction-active
(funcall function) (funcall function)
(let ((frozen-route (let (after-commit result
(tp--transaction-validate-execution-route
tp-transaction-execution-route))
after-commit result
(tp--transaction-contained-failures nil)) (tp--transaction-contained-failures nil))
(setq tp--last-transaction-outcome nil (setq tp--last-transaction-outcome nil
tp--last-shadow-proof nil) tp--last-shadow-proof nil)
@ -1551,7 +1458,6 @@ the primary condition data."
(tp--transaction-signal-commit-journal nil) (tp--transaction-signal-commit-journal nil)
(tp--transaction-publication-batch nil) (tp--transaction-publication-batch nil)
(tp--transaction-structured-participants nil) (tp--transaction-structured-participants nil)
(tp--transaction-frozen-execution-route frozen-route)
(tp--transaction-final-marker-registry (tp--transaction-final-marker-registry
(make-vector tp--final-marker-max-count nil)) (make-vector tp--final-marker-max-count nil))
(tp--transaction-final-marker-owner-keys (tp--transaction-final-marker-owner-keys
@ -1577,21 +1483,16 @@ the primary condition data."
(tp--transaction-enter-phase 'recompute) (tp--transaction-enter-phase 'recompute)
(tp--flush-dirty-bindings) (tp--flush-dirty-bindings)
(tp--transaction-enter-phase 'publication) (tp--transaction-enter-phase 'publication)
(tp--transaction-current-execution-route)
(setq tp--transaction-structured-participants (setq tp--transaction-structured-participants
(vconcat (vconcat
(tp--transaction-participants-in-registration-order))) (tp--transaction-participants-in-registration-order)))
(run-hooks 'tp--transaction-publish-functions) (run-hooks 'tp--transaction-publish-functions)
(tp--transaction-batch-transition 'participants) (tp--transaction-batch-transition 'participants)
(tp--transaction-enter-phase 'participants) (tp--transaction-enter-phase 'participants)
(if (tp--transaction-structured-route-p) (tp--stage-structured-transaction-participants)
(tp--stage-structured-transaction-participants)
(tp--publish-transaction-participants))
(tp--transaction-batch-transition 'precommit) (tp--transaction-batch-transition 'precommit)
(tp--transaction-enter-phase 'precommit) (tp--transaction-enter-phase 'precommit)
(if (tp--transaction-structured-route-p) (tp--run-structured-transaction-participant-precommits)
(tp--run-structured-transaction-participant-precommits)
(tp--run-transaction-participant-precommits))
(tp--run-transaction-precommit-functions) (tp--run-transaction-precommit-functions)
(tp--transaction-freeze-final-markers) (tp--transaction-freeze-final-markers)
(tp--transaction-sync-publication-batch) (tp--transaction-sync-publication-batch)
@ -1616,9 +1517,7 @@ the primary condition data."
tp--transaction-final-accept-function))) tp--transaction-final-accept-function)))
(tp--transaction-run-final-accept) (tp--transaction-run-final-accept)
(setq success t) (setq success t)
(if (tp--transaction-structured-route-p) (tp--commit-structured-transaction-participants)
(tp--commit-structured-transaction-participants)
(tp--commit-transaction-participants))
(tp--transaction-run-shadow-proof 'commit) (tp--transaction-run-shadow-proof 'commit)
(when quit-flag (when quit-flag
(setq pending-quit t (setq pending-quit t

30
tp-surface.el
View File

@ -3639,13 +3639,6 @@ JOURNALS and VIEWS are exact references to the shared rollback state."
(tp--publish-one-surface prepared) (tp--publish-one-surface prepared)
(tp--surface-record-publication-operation-counts prepared)))) (tp--surface-record-publication-operation-counts prepared))))
(defun tp--surface-stage-v1-prepared (prepared next-generation)
"Publish legacy PREPARED list after exposing NEXT-GENERATION."
(setq tp--surface-transaction-id next-generation)
(dolist (candidate prepared)
(tp--publish-one-surface candidate)
(tp--surface-record-publication-operation-counts candidate)))
(defun tp--surface-record-publication-operation-counts (prepared) (defun tp--surface-record-publication-operation-counts (prepared)
"Record PREPARED's actual live report counts into its exact batch entry." "Record PREPARED's actual live report counts into its exact batch entry."
(when tp--transaction-publication-batch (when tp--transaction-publication-batch
@ -3691,20 +3684,17 @@ JOURNALS and VIEWS are exact references to the shared rollback state."
(puthash 'change-group group state) (puthash 'change-group group state)
(puthash 'surface-transaction-id-before (puthash 'surface-transaction-id-before
tp--surface-transaction-id state) tp--surface-transaction-id state)
(when (tp--transaction-publication-candidate-enabled-p) (let* ((batch-id (tp--next-publication-batch-id))
(let* ((batch-id (tp--next-publication-batch-id)) (entries
(entries (tp--surface-shadow-target-entries
(tp--surface-shadow-target-entries prepared snapshots journals views batch-id
prepared snapshots journals views batch-id next-generation)))
next-generation))) (tp--transaction-begin-publication-batch
(tp--transaction-begin-publication-batch batch-id entries state 'tp--surface-stage-publication-entries)
batch-id entries state 'tp--surface-stage-publication-entries) (tp--transaction-batch-transition 'staged))
(tp--transaction-batch-transition 'staged)))
(let ((tp--surface-publishing t)) (let ((tp--surface-publishing t))
(if (tp--transaction-structured-route-p) (tp--publication-batch-execute-stage
(tp--publication-batch-execute-stage tp--transaction-publication-batch))))))
tp--transaction-publication-batch)
(tp--surface-stage-v1-prepared prepared next-generation)))))))
(defun tp--surface-precommit-step (step state) (defun tp--surface-precommit-step (step state)
"Report precommit STEP for transaction STATE." "Report precommit STEP for transaction STATE."

7
tp-transaction.el
View File

@ -12,9 +12,8 @@
;;; Commentary: ;;; Commentary:
;; Internal immutable artifacts and one-shot state machines for TP publication. ;; Internal immutable artifacts and one-shot state machines for TP publication.
;; The default structured route executes the package-owned entry-stage ;; The package-owned entry-stage capability stored in a batch candidate drives
;; capability stored in a batch candidate; the retained v1 route bypasses that ;; publication. This module never edits a buffer itself: `tp-reactive' drives
;; capability. This module never edits a buffer itself: `tp-reactive' drives
;; the state machine and `tp-surface' supplies and stages exact target entries ;; the state machine and `tp-surface' supplies and stages exact target entries
;; backed by the shared prepare journals and snapshots. ;; backed by the shared prepare journals and snapshots.
@ -35,7 +34,7 @@
"Invalid TP final-accept marker" "Invalid TP final-accept marker"
'tp-transaction-contract-error) 'tp-transaction-contract-error)
(defconst tp-transaction-protocol 'tp-transaction-protocol-v1+v2 (defconst tp-transaction-protocol 'tp-transaction-protocol-v2
"Transaction protocol implemented by this TP package version.") "Transaction protocol implemented by this TP package version.")
(defconst tp--publication-batch-transitions (defconst tp--publication-batch-transitions

14
tp.el
View File

@ -2,7 +2,7 @@
;; Copyright (C) 2024-2026 Geekinney ;; Copyright (C) 2024-2026 Geekinney
;; Version: 1.0.1 ;; Version: 2.0.0
;; Keywords: convenience text-properties ;; Keywords: convenience text-properties
;; Author: Geekinney (kinneyzhang666@gmail.com) ;; Author: Geekinney (kinneyzhang666@gmail.com)
;; Package-Requires: ((emacs "28.1")) ;; Package-Requires: ((emacs "28.1"))
@ -26,7 +26,7 @@
;; tp-style.el Native property policies, contribution composition, ;; tp-style.el Native property policies, contribution composition,
;; named declarations, and explicit computed values. ;; named declarations, and explicit computed values.
;; tp-transaction.el ;; tp-transaction.el
;; Additive publication batch, marker, and outcome contracts. ;; Structured publication batch, marker, and outcome contracts.
;; tp-reactive.el Exact signals, bindings, transactions, and scoped variable ;; tp-reactive.el Exact signals, bindings, transactions, and scoped variable
;; adapters. ;; adapters.
;; tp-surface.el Retained plans, objects, range anchors, mounts, indexes, ;; tp-surface.el Retained plans, objects, range anchors, mounts, indexes,
@ -66,20 +66,12 @@
(require 'tp-builtins) (require 'tp-builtins)
(defconst tp--runtime-manifest (defconst tp--runtime-manifest
`(:package tp :version "1.0.1" `(:package tp :version "2.0.0"
:transaction-protocol ,tp-transaction-protocol :transaction-protocol ,tp-transaction-protocol
:batch-artifacts t :batch-artifacts t
:execution-route structured
:execution-default structured
:execution-routes (structured v1)
:route-option tp-transaction-execution-route
:batch-execution structured
:batch-execute t :batch-execute t
:structured-participant-api tp-transaction-participate-v2 :structured-participant-api tp-transaction-participate-v2
:v1-adapter t
:v1-rollback-route t
:single-live-writer t :single-live-writer t
:shadow-proof t
:final-marker-operation tp-vector-slots/v1) :final-marker-operation tp-vector-slots/v1)
"Immutable package capability facts for cross-package compatibility checks.") "Immutable package capability facts for cross-package compatibility checks.")