Compare commits

...

9 Commits

Author SHA1 Message Date
Kinneyzhang
0a820bd0cb fix: preserve native interaction properties in incremental publication
Some checks are pending
CI / test (28.1) (push) Waiting to run
CI / test (29.4) (push) Waiting to run
CI / test (30.1) (push) Waiting to run
Preserve keymap ownership and hover grouping while applying minimal text patches. Reduce retained publication allocations without weakening policy comparisons or transactional rollback.

Validation: 451 ERT tests, README doctests, strict byte compilation and checkdoc passed.
2026-09-09 22:25:09 +08:00
Kinneyzhang
e28df6a5fb feat: compose property contributions in retained commit batches 2026-09-07 05:03:27 +08:00
Kinneyzhang
6ed8df3915 perf: match retained mount identities with ordered queues 2026-09-07 04:09:57 +08:00
Kinneyzhang
5bcc91d867 perf: check publication identity uniqueness with equal hashing 2026-09-06 21:04:44 +08:00
Kinneyzhang
47e8d8c256 perf: retain authoritative publication target state 2026-09-05 07:07:53 +08:00
Kinneyzhang
b2b9462269 perf: rebuild shadow patch output in one pass 2026-09-05 06:53:10 +08:00
Kinneyzhang
c05174ff9d refactor!: publish transactions exclusively through protocol v2 2026-09-05 05:25:29 +08:00
Kinneyzhang
25cb66c040 feat(transaction): expose structured participant registration 2026-09-01 15:52:05 +08:00
Kinneyzhang
469bdff17d feat(transaction): cut over to structured publication authority 2026-09-01 15:37:29 +08:00
19 changed files with 2716 additions and 498 deletions

View File

@ -2,15 +2,20 @@
All notable changes to the tp library are documented here.
## 1.0.1 (Unreleased)
## 2.0.0 (Unreleased)
### 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.
- 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.
- Additive 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 unchanged v1 live writer.
- `tp-runtime-manifest`, advertising `tp-transaction-protocol-v1+v2` without removing the v1 participant route.
- Transaction protocol v2: transaction-scoped publication batches, structured
participants, bounded opaque final-accept markers using the closed
`tp-vector-slots/v1` primitive, immutable tagged outcomes, and one live writer.
- `tp-runtime-manifest`, advertising `tp-transaction-protocol-v2` and package
version 2.0.0.
- Public `tp-transaction-participate-v2` registration for cross-package
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.
- `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.
@ -18,9 +23,9 @@ All notable changes to the tp library are documented here.
### Changed
- 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.
- Structured publication batches own the single live surface-entry loop,
participant stage/precommit/commit vector, and candidate-bound final accept.
- Package metadata now identifies the v2-only breaking transaction contract.
- `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.
- Function-valued properties are always literal. Only values wrapped by `tp-computed` execute and participate in dependency collection.
@ -29,6 +34,12 @@ All notable changes to the tp library are documented here.
### 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.
- 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.

View File

@ -5,7 +5,7 @@
# make test-shuffled # run the suite in a random order (SHUFFLE_SEED=n reproduces)
# make test-m0a # run current TP completion characterization
# 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 benchmark # run reproducible correctness-first benchmarks
# 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 \
tp-query.el tp-palette.el tp-builtins.el tp.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
EXAMPLES = $(wildcard examples/*.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:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \
@ -53,10 +52,13 @@ test-m1a:
-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")'
test-v1:
test-c1b:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el \
--eval '(setq tp--transaction-artifact-mode (quote v1))' \
$(patsubst %,-l %,$(V1_TESTS)) -f ert-run-tests-batch-and-exit
-l $(TEST_DIR)/tp-binding-tests.el \
-l $(TEST_DIR)/tp-surface-tests.el \
-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:
$(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \

View File

@ -1,13 +1,13 @@
# 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.
Chinese documentation: [README_CN.md](README_CN.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.
## Requirements
@ -146,12 +146,14 @@ 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.
TP also builds an internal transaction-scoped batch view over the same v1
participants, journals, surface snapshots, and single final accept. Shadow
mode compares canonical target artifacts and tagged outcomes with the one v1
writer; it never opens a second change group or writes a buffer twice. Generic
opaque authority markers are bounded and whitelist-validated before final
accept, then reverse-restored before ordinary rollback on partial apply or
TP 2.0 drives the single live publication from exact transaction-scoped batch
entries, one frozen participant vector, and the candidate-bound final accept.
The same journals, surface snapshots, and change group are shared rather than
copied. Transaction participants register through
`tp-transaction-participate-v2`; TP has no alternate transaction writer or
runtime route switch.
Generic opaque authority markers are bounded and whitelist-validated before
final accept, then reverse-restored before ordinary rollback on partial apply or
accept failure. `tp-with-transaction` still returns its body value, and
internal outcomes remain observational side-channel evidence.
@ -183,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` |
| 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 |
| Signals and bindings | signal create/read/peek/set/dispose, binding install/read/dispose, `tp-variable-signal`, `tp-with-transaction`, `tp-transaction-participate`, 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 |
| 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 |
@ -201,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 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.
## Examples

View File

@ -1,13 +1,13 @@
# 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。
英文文档:[README.md](README.md)。
完整公共 API 参考:[API-REFERENCE.md](docs/API-REFERENCE.md)。本文负责概念
和快速开始API 参考按当前 TP 1.0 源码列出入口、参数语义、返回值和用法。
和快速开始API 参考按当前 TP 2.0 源码列出入口、参数语义、返回值和用法。
## 运行要求
@ -145,13 +145,14 @@ TP 为每个 property interval 保存 host baseline 和各个 TP contribution。
observer 只在成功提交之后运行observer failure 只记录,不回滚已完成的 transaction。publication 过程中被 kill 的 buffer 保持死亡rollback 不会把它重新创建。
TP 还会在同一份 v1 participant、journal、surface snapshot 和 single final
accept 上建立内部 transaction-scoped batch view。shadow mode 只比较 canonical
target artifact 与 tagged outcome仍由唯一 v1 writer 写入;不会建立第二个
change group也不会双写 Buffer。generic opaque authority marker 在 final
accept 前完成固定上界与 whitelist 校验partial apply 或 accept failure 时先
逆序恢复 marker再执行普通 rollback。`tp-with-transaction` 仍返回 body
result内部 outcome 仅作为只读 side-channel evidence。
TP 2.0 从 transaction-scoped batch 的 exact entries、同一个冻结 participant
vector 和 candidate-bound final accept 驱动唯一 live publicationjournal、
surface snapshot 与 change group 仍只保留一份。transaction participant 统一通过
`tp-transaction-participate-v2` 注册,不再提供备用 transaction writer 或 runtime
route switch。generic opaque authority marker 在 final accept 前
完成固定上界与 whitelist 校验partial apply 或 accept failure 时先逆序恢复
marker再执行普通 rollback。`tp-with-transaction` 仍返回 body result内部
outcome 仅作为只读 side-channel evidence。
ETAF 集成复用同一事务边界,只注册一个 opaque transaction participant。ETAF
先准备 immutable generation 和 Ebox candidate再由 TP 按固定顺序完成
@ -179,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` |
| 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 |
| Signal 与 binding | signal create/read/peek/set/dispose、binding install/read/dispose、`tp-variable-signal`、`tp-with-transaction`、`tp-transaction-participate`、只读 `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 |
| 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 |
@ -196,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 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。
## 示例

View File

@ -1,4 +1,4 @@
# TP 1.0 公共 API 与用法参考
# TP 2.0 公共 API 与用法参考
本文是 TP 当前实现的完整公共入口索引。它以 tp.el 加载的模块为准;带
tp-- 前缀的函数、变量和结构体是内部实现,不属于本文的稳定 API。
@ -226,10 +226,11 @@ tp-binding-dispose 释放单个 binding。
(tp-signal-dispose left)
(tp-signal-dispose right))
(tp-transaction-participate
'my-external-state
(lambda () (my-publish))
(lambda () (my-rollback)))
(tp-with-transaction
(tp-transaction-participate-v2
:key 'my-structured-state
:stage (lambda () (my-stage))
:rollback (lambda () (my-rollback))))
(tp-transaction-active-p)
@ -244,8 +245,10 @@ tp-binding-dispose 释放单个 binding。
tp-with-transaction 将 signal、binding、surface 和注册的 transaction
participant 一起原子处理。participant 必须在 active transaction 内注册;
publish 在 surface publication 后、source commit 前运行,失败时按逆序
rollback。tp-variable-signal 用 Emacs variable watcher 适配全局或指定
stage 在 surface publication 后、source commit 前运行,失败时按逆序
rollback。consumer 使用 `tp-transaction-participate-v2`;它
返回 key不暴露内部 participant 对象。tp-variable-signal 用 Emacs variable
watcher 适配全局或指定
Buffer 的变量,不是旧的 $variable API。
tp-transaction-active-p 是只读边界查询:只在当前 dynamic extent 已进入
@ -254,11 +257,16 @@ tp-transaction-active-p 是只读边界查询:只在当前 dynamic extent 已
嵌套事务边界。
tp-runtime-manifest 返回防御性 capability snapshot本版本的
`:transaction-protocol``tp-transaction-protocol-v1+v2`。该声明是 additive
`tp-transaction-participate` façade 与 live writer 都仍保留。
`:batch-artifacts``:shadow-proof` 为 non-nil`:batch-execution` 为
`v1-bridge`,而 `:batch-execute` 明确为 nilstructured-core execute owner
保留给后续受控 cutover不在 M1a 伪造第二个 coordinator。
`:transaction-protocol``tp-transaction-protocol-v2``:version` 为
`"2.0.0"`。`:structured-participant-api` 指向
`tp-transaction-participate-v2``:batch-execute`、`:batch-artifacts` 和
`:single-live-writer` 均为 non-nil。manifest 不再发布 execution route、
v1 adapter 或 v1 rollback route。
从 TP 1.x 迁移时,把 `(tp-transaction-participate KEY PUBLISH ROLLBACK)`
精确替换为 `(tp-transaction-participate-v2 :key KEY :stage PUBLISH
:rollback ROLLBACK)`。删除所有对 `tp-transaction-execution-route`
`tp--transaction-artifact-mode` 的设置。
ETAF registers one opaque participant for its immutable generation and Ebox
client state. Its publish is paired with rollback across TP final accept; the
@ -382,6 +390,19 @@ Report 的常用字段包括:
:scope-fallback、:property-conflicts、:rolled-back、:failure、
:observer-errors、:timing。
已经精确计算出变更区间的 producer 可以使用 `tp-commit-batch-create` 构造
批次,再由 `tp-commit-batch-result-create` 绑定当前 prepare context发布和
回滚仍使用相同 surface 事务。批次绑定前后 revision、extent 和坐标映射。
每个 patch 的 `:replacement` 是完整属性文本,也可以携带局部
`:property-contributions`:其中 `:start`/`:end` 相对于该 replacement按列表
顺序使用已注册的 property merge policy 合成。策略在**构造批次时**求值;
批次只保留合成后的文本快照,不保留贡献列表,之后的调用方修改或策略替换
不会重新计算这份批次。函数、record 等 opaque 属性身份按既有 snapshot 规则保留。
producer 只有在证明整个挂载拓扑、tags 和坐标均与已提交版本相同时,才能向
`tp-commit-batch-result-create``:reuse-mount-projection t`。它不能与显式
`:mount-specs` 同时使用;数量相同或对象没有增删都不能替代完整的不变证明。
### 6.3 Host range 和 tp-watch
~~~elisp
@ -610,7 +631,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-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-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-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 |

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)。
@ -196,10 +196,11 @@ TP 为每个 interval 保存:
3. 运行 binding graph 与 producers
4. 校验 object、plan、capability、range、conflict 与 lifecycle
5. 为所有 surfaces 准备 text/property operations 与 inverse journals
6. 按稳定 surface id publish
7. 按声明顺序 stage participant再执行 declared precommit
6. 默认从 publication batch 的 exact entry bindings 按稳定 surface id publish
7. 从 batch 绑定的同一 participant vector 按声明顺序 stage participant再执行
declared precommit
8. commit signal journal
9. 在 single final accept 内按顺序 apply bounded opaque markers再 accept
9. 在 candidate 绑定的 single final accept 内按顺序 apply bounded opaque markers再 accept
change groupmarker 只能使用 closed `tp-vector-slots/v1` fixed-write
primitive不能注册 callbackpartial apply 或 accept failure 先逆序
restore markers
@ -208,14 +209,21 @@ TP 为每个 interval 保存:
嵌套 transaction 加入最外层。一个 global signal 可以原子触达多个 buffers任一 surface 失败时,已发布 surfaces 和 source/binding state 全部回滚。
`tp-transaction-participate` 允许 client side state 在 surfaces 发布后、source commit 前加入同一 rollback boundary。participant key 在一个 outer transaction 中必须唯一。它不是 observer失败会回滚 transaction。Observer failure 只记录,不回滚已提交结果。
`tp-transaction-participate-v2` 允许 client side state 在 surfaces 发布后、
source commit 前加入同一 rollback boundary。调用方通过 `:key`、`:stage` 和
`:rollback` 注册 structured participant返回值仍是 key内部 participant
identity、state 与 journal 不暴露。participant key 在一个 outer transaction
中必须唯一。它不是 observer失败会回滚 transaction。Observer failure 只记录,
不回滚已提交结果。
M1a 的 publication batch、structured participant、final marker 与 tagged
outcome 都是现有 v1 dynamic transaction state 的内部结构化 view不复制第二份
participant/journal/change-group也不切换 live writer。shadow proof 只比较 v1/v2
artifact 与 outcome不双写 Buffer。`tp-with-transaction` 的返回值仍是 body
resultsuccess/failure outcome 只走内部 side channel。zero-surface 与
output-equal operation 不创建 publication batch。
publication batch、structured participant、final marker 与 tagged outcome 共享
现有 journal/change-group不复制第二份 live state。publication batch 是唯一
live writersurface 从 candidate entries 执行participant 从 candidate
绑定的同一 identity vector 执行final accept 从 candidate binding 执行;任何
binding/order 漂移都会 fail-fast 并回滚。TP 2.0 不再提供 alternate writer、
execution route 或 artifact-mode switch。`tp-with-transaction` 的返回值仍是 body result
success/failure outcome 只走内部 side channel。zero-surface 与 output-equal
operation 不创建 publication batch。
ETAF uses this API with one opaque participant for its immutable generation and
Ebox client state. The participant is published only after candidate

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)。
@ -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-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-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 |
@ -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 additive v2 contract is a structured view over those exact owners. It does
not copy participant, scheduler, snapshot, journal, or change-group state. The
public v1 participant façade and the v1 surface writer remain authoritative;
shadow mode constructs canonical entries and compares property-for-property and
revision-for-revision after commit or rollback.
The v2 contract uses those exact owners. It does not copy participant,
scheduler, snapshot, journal, or change-group state. The publication batch is
the sole writer and validates its canonical entries against the committed
property and revision state after commit or rollback.
```text
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.
`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,
registration order, stage, rollback, optional declared precommit, contained
after-commit work, owner journal, and one-shot state. Final markers are not
Each structured participant has one stable key, registration order, stage,
rollback, optional declared precommit, contained after-commit work, owner
journal, and one-shot state. Final markers are not
participants. TP treats their values as opaque and accepts only predeclared,
fixed-bound operations. M1a's closed `tp-vector-slots/v1` primitive accepts
only prebuilt vector-slot expectations and writes; marker registration cannot

View File

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

View File

@ -161,6 +161,49 @@
(should (equal (nth 0 copy) "value"))
(should (equal (nth 1 copy) ["nested"])))))
(ert-deftest tp-core-test-property-value-copy-isolates-full-keymaps ()
"Full keymaps, parent maps and self-references retain an isolated graph."
(let* ((map (make-keymap))
(parent (make-keymap))
(callback (lambda () "callback")))
(define-key map (kbd "RET") callback)
(define-key parent (kbd "x") #'ignore)
(define-key map [prefix] map)
(set-keymap-parent map parent)
(let ((copy (tp-property-value-copy map)))
(should-not (eq copy map))
(should-not (eq (keymap-parent copy) parent))
(should (eq (lookup-key copy [prefix]) copy))
(should (eq (lookup-key copy (kbd "RET")) callback))
(define-key map (kbd "RET") #'forward-char)
(define-key parent (kbd "x") #'backward-char)
(should (eq (lookup-key copy (kbd "RET")) callback))
(should (eq (lookup-key copy (kbd "x")) #'ignore)))))
(ert-deftest tp-core-test-property-value-copy-preserves-character-table-structure ()
"Local ranges, defaults, parents, extra slots and cycles are copied faithfully."
(let ((purpose (make-symbol "tp-copy-table")))
(put purpose 'char-table-extra-slots 1)
(let* ((parent (make-char-table purpose))
(table (make-char-table purpose))
(value (list 'value)))
(set-char-table-range parent ?p value)
(set-char-table-range table ?x value)
(set-char-table-range table ?s table)
(set-char-table-extra-slot table 0 value)
(set-char-table-parent table parent)
(let ((copy (tp-property-value-copy table)))
(should (eq (char-table-range copy ?s) copy))
(should (eq (char-table-range copy ?x) (char-table-extra-slot copy 0)))
(should (eq (char-table-range copy ?x)
(char-table-range (char-table-parent copy) ?p)))
(set-char-table-range (char-table-parent copy) ?p 'new)
(should (eq (char-table-range copy ?p) 'new))
(set-char-table-range copy nil 'default)
(should (eq (char-table-range copy ?z) 'default))
(setcar value 'mutated)
(should (equal (char-table-range copy ?x) '(value)))))))
(ert-deftest tp-core-test-property-value-copy-keeps-list-functions-opaque ()
"Property copies keep list-shaped function values opaque."
(let ((function-value '(lambda () 1)))

View File

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

View File

@ -14,6 +14,46 @@
(require 'tp-style)
(require 'tp-layer)
(ert-deftest tp-style-test-native-keymaps-preserve-all-binding-facts ()
"Snapshots compare by prompts, menu order, parents and literal commands."
(let* ((factory (eval '(lambda ()
(let ((n 0))
(lambda () (setq n (1+ n))))) t))
(first (funcall factory)) (second (funcall factory))
(map (make-keymap "Root"))
(prefix (make-sparse-keymap "Prefix"))
(parent (make-sparse-keymap "Parent")))
(define-key map (kbd "RET") first)
(define-key map [t] #'ignore)
(define-key prefix [self] prefix)
(define-key prefix [one] '(menu-item "One" ignore))
(define-key prefix [two] '(menu-item "Two" forward-char))
(define-key map [prefix] prefix)
(define-key parent [inherited] #'backward-char)
(set-keymap-parent map parent)
(should (equal first second))
(should (tp--native-property-value-equal-p map (tp-property-value-copy map)))
(dolist (kind '(root-prompt prefix-prompt parent-prompt menu-order
callback default inherited))
(let ((copy (tp-property-value-copy map)))
(pcase kind
((or 'root-prompt 'prefix-prompt 'parent-prompt)
(let* ((target (pcase kind
('root-prompt copy)
('prefix-prompt (lookup-key copy [prefix]))
('parent-prompt (keymap-parent copy))))
(cell (memq (keymap-prompt target) target)))
(setcar cell "Changed")))
('menu-order
(let* ((target (lookup-key copy [prefix]))
(one (lookup-key target [one])))
(define-key target [one] nil t)
(define-key target [one] one)))
('callback (define-key copy (kbd "RET") second))
('default (define-key copy [t] #'forward-char))
('inherited (define-key (keymap-parent copy) [inherited] #'ignore)))
(should-not (tp--native-property-value-equal-p map copy))))))
(defmacro tp-style-test--isolated (&rest body)
"Run BODY with isolated TP property and named-style registries."
(declare (indent 0) (debug t))

File diff suppressed because it is too large Load Diff

View File

@ -1,13 +1,13 @@
;;; tp-transaction-tests.el --- TP additive transaction contract -*- lexical-binding: t; -*-
;;; tp-transaction-tests.el --- TP structured transaction contract -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Geekinney
;;; Commentary:
;; Characterization and fault tests for the additive v1+v2 transaction
;; protocol. These tests deliberately exercise the internal protocol: the
;; public contract remains `tp-with-transaction' body return and primary
;; condition preservation.
;; Characterization and fault tests for the v2 transaction protocol. These
;; tests deliberately exercise
;; the internal protocol: the public contract remains `tp-with-transaction'
;; body return and primary condition preservation.
;;; Code:
@ -17,13 +17,12 @@
(require 'tp-surface)
(declare-function tp--transaction-participate-v2 "tp-reactive" (&rest args))
(declare-function tp-transaction-participate-v2 "tp-reactive" (&rest args))
(declare-function tp--transaction-participant-protocol "tp-reactive" (value))
(declare-function tp--transaction-participant-state "tp-reactive" (value))
(declare-function tp--transaction-participant-journal "tp-reactive" (value))
(declare-function tp--transaction-register-final-marker
"tp-reactive" (&rest args))
(defvar tp--transaction-artifact-mode)
(defvar tp--transaction-publication-batch)
(defvar tp--transaction-outcome)
(defvar tp--last-shadow-proof)
@ -100,6 +99,30 @@
:final-accept #'ignore
:diagnostics nil))
(ert-deftest tp-transaction-test-unique-identities-use-equal-semantics ()
"Distinct identity values stay distinct; equal values remain duplicates."
(dolist (items (list nil '(nil) '(1 1.0) '(nil mount-a "mount-a")
(number-sequence 1 2000)))
(let ((before (copy-tree items)))
(should (tp--proper-unique-list-p items))
(should (equal items before))))
(dolist (items (list '(nil nil) '(mount-a mount-a)
(list (copy-sequence "mount") (copy-sequence "mount"))
(list (list 'owner 1) (list 'owner 1))
(list (vector 'owner 1) (vector 'owner 1))))
(should-not (tp--proper-unique-list-p items))
(should-error (tp-transaction-test--entry :mount-ids items)
:type 'tp-publication-binding-error)))
(ert-deftest tp-transaction-test-unique-identities-reject-improper-lists ()
"Malformed identity sequences cannot enter publication authority bindings."
(let ((cycle (list 'mount-a 'mount-b)))
(setcdr (last cycle) cycle)
(dolist (items (list 'mount-a [mount-a] '(mount-a . mount-b) cycle))
(should-not (tp--proper-unique-list-p items))
(should-error (tp-transaction-test--entry :mount-ids items)
:type 'tp-publication-binding-error))))
(defun tp-transaction-test--slot-writes (target values)
"Return fixed slot writes assigning VALUES into TARGET from index zero."
(vconcat
@ -234,8 +257,8 @@
(when (tp-signal-live-p ,source)
(tp-signal-dispose ,source)))))
(ert-deftest tp-transaction-test-v1-body-return-and-phase-order ()
"The v1 facade returns BODY and retains its established phase order."
(ert-deftest tp-transaction-test-v2-body-return-and-phase-order ()
"The v2 facade returns BODY and retains its established phase order."
(let ((tp-transaction-test--trace nil)
(tp--transaction-precommit-functions
'(tp--transaction-test-precommit-inject))
@ -244,10 +267,10 @@
(should
(equal
(tp-with-transaction
(tp-transaction-participate
'v1
(lambda () (push 'participant tp-transaction-test--trace))
(lambda () (push 'rollback tp-transaction-test--trace)))
(tp-transaction-participate-v2
:key 'v2
:stage (lambda () (push 'participant tp-transaction-test--trace))
:rollback (lambda () (push 'rollback tp-transaction-test--trace)))
(tp--enqueue-after-commit
(lambda () (push 'after-commit tp-transaction-test--trace)))
(push 'body tp-transaction-test--trace)
@ -256,8 +279,8 @@
(should (equal (nreverse tp-transaction-test--trace)
'(body participant precommit after-commit)))))
(ert-deftest tp-transaction-test-v1-participant-and-precommit-fault-order ()
"A late v1 fault rolls staged participants back in reverse order."
(ert-deftest tp-transaction-test-v2-participant-and-precommit-fault-order ()
"A late v2 fault rolls staged participants back in reverse order."
(let* ((injected '(tp-transaction-test-error :phase precommit :raw (1 2)))
(tp-transaction-test--trace nil)
(tp-transaction-test--precommit-condition injected)
@ -269,14 +292,14 @@
(tp-transaction-test--capture
(lambda ()
(tp-with-transaction
(tp-transaction-participate
'first
(lambda () (push 'stage-first tp-transaction-test--trace))
(lambda () (push 'rollback-first tp-transaction-test--trace)))
(tp-transaction-participate
'second
(lambda () (push 'stage-second tp-transaction-test--trace))
(lambda () (push 'rollback-second tp-transaction-test--trace))))))))
(tp-transaction-participate-v2
:key 'first
:stage (lambda () (push 'stage-first tp-transaction-test--trace))
:rollback (lambda () (push 'rollback-first tp-transaction-test--trace)))
(tp-transaction-participate-v2
:key 'second
:stage (lambda () (push 'stage-second tp-transaction-test--trace))
:rollback (lambda () (push 'rollback-second tp-transaction-test--trace))))))))
(should (equal failure injected))
(should (equal (nreverse tp-transaction-test--trace)
'(stage-first stage-second precommit
@ -313,10 +336,17 @@
:type 'tp-publication-binding-error)
(with-temp-buffer
(let* ((mount-ids (list 'mount-a))
(entry (tp-transaction-test--entry :mount-ids mount-ids))
(diff (list :replace (list 1 2)))
(client-state (list :client (list 'candidate)))
(entry (tp-transaction-test--entry
:mount-ids mount-ids
:diff diff
:client-state client-state))
(entries (list entry))
(batch (tp-transaction-test--batch entries)))
(setcar mount-ids 'mutated-after-create)
(setcar (plist-get diff :replace) 'mutated-after-create)
(setcar (plist-get client-state :client) 'mutated-after-create)
(setcar entries (tp-transaction-test--entry
:candidate-id 'replacement
:surface-id 'replacement-surface
@ -327,6 +357,10 @@
(should (equal (tp-publication-target-entry-mount-ids
(car (tp-publication-batch-candidate-entries batch)))
'(mount-a)))
(should (equal (tp-publication-target-entry-diff entry)
'(:replace (1 2))))
(should (equal (tp-publication-target-entry-client-state entry)
'(:client (candidate))))
(should (eq (car (tp-publication-batch-candidate-entries batch)) entry))
(should-error
(tp-transaction-test--batch (list entry entry))
@ -353,14 +387,15 @@
(should-error (tp--publication-batch-transition discarded 'staged)
:type 'tp-publication-state-error))))
(ert-deftest tp-transaction-test-v1-bridge-is-the-structured-participant ()
"The v1 facade installs one v2 record, not parallel participant state."
(ert-deftest tp-transaction-test-v2-participant-is-single-structured-record ()
"The v2 facade installs one structured record with no legacy bridge."
(let (saved)
(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))
(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) 'committed))))
@ -386,6 +421,30 @@
'(:owner old-state)))
(should (eq (tp--transaction-participant-state participant) 'committed))))
(ert-deftest tp-transaction-test-public-v2-participant-api-registers-v2-record ()
"The public v2 API registers one v2 object on the sole live route."
(let ((tp-transaction-test--trace nil)
participant)
(should
(eq
(tp-with-transaction
(should
(eq
(tp-transaction-participate-v2
:key 'public-v2
:stage (lambda () (push 'stage tp-transaction-test--trace))
:rollback (lambda () (push 'rollback tp-transaction-test--trace))
:journal '(:owner public))
'public-v2))
(setq participant (car tp--transaction-participants))
'body-result)
'body-result))
(should (equal tp-transaction-test--trace '(stage)))
(should (eq (tp--transaction-participant-protocol participant) 'v2))
(should (equal (tp--transaction-participant-journal participant)
'(:owner public)))
(should (eq (tp--transaction-participant-state participant) 'committed))))
(ert-deftest tp-transaction-test-v2-participant-stage-fault-rolls-back-prior-only ()
"A structured stage fault reverses only participants that entered staged."
(let ((tp-transaction-test--trace nil)
@ -454,7 +513,7 @@
(ert-deftest tp-transaction-test-public-final-marker-wrappers-share-contract ()
"Public marker constructors and registration retain the bounded core rules."
(tp-transaction-test--with-surface (_buffer _surface source)
(tp-transaction-test--with-surface (buffer _surface source)
(let ((target (vector 'detached 'token 0)))
(tp-with-transaction
(tp-signal-set source 2)
@ -577,6 +636,10 @@
tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts
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
(tp--committed-success-outcome-snapshot
tp--last-transaction-outcome)
@ -762,8 +825,7 @@
(dolist (id before)
(should (memq id outcome-ids)))
(tp-transaction-test--should-match-outcome-counts
tp--last-transaction-outcome (list surface))
(should (plist-get tp--last-shadow-proof :equivalent))))
tp--last-transaction-outcome (list surface))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest tp-transaction-test-candidates-remain-invisible-until-staged ()
@ -782,8 +844,8 @@
(with-current-buffer buffer
(should (equal (buffer-string) text))))))
(ert-deftest tp-transaction-test-shadow-is-multisurface-and-single-writer ()
"Shadow artifacts cover all surfaces while each live writer runs once."
(ert-deftest tp-transaction-test-v2-is-multisurface-and-single-writer ()
"The v2 artifacts cover all surfaces while each live writer runs once."
(let* ((source (tp-signal-create 1))
(producer (tp-transaction-test--producer source))
(first-buffer (generate-new-buffer " *tp-transaction-first*"))
@ -799,16 +861,17 @@
(let ((surface (tp--prepared-surface-surface prepared)))
(puthash surface (1+ (gethash surface calls 0)) calls))
(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 second calls 0) 1))
(should (tp-committed-success-outcome-p
tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts
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 :outcome-equivalent))
(should (= (plist-get tp--last-shadow-proof :entry-count) 2))
(should (integerp
(tp-committed-success-outcome-mapping-generation
tp--last-transaction-outcome)))
@ -826,6 +889,31 @@
(when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(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 ()
"Pure, semantic and external-only transactions stay outside batch API."
(let ((tp--last-transaction-outcome 'sentinel)
@ -839,7 +927,8 @@
(should-not captured-outcome)
(should-not tp--last-transaction-outcome)
(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)))
(ert-deftest tp-transaction-test-unobserved-signal-excludes-publication-batch ()
@ -856,8 +945,7 @@
(should (= (tp-signal-peek signal) 2))
(should (= (tp-signal-revision signal) 1))
(should (= batch-calls 0))
(should-not tp--last-transaction-outcome)
(should-not tp--last-shadow-proof))
(should-not tp--last-transaction-outcome))
(when (tp-signal-live-p signal) (tp-signal-dispose signal)))))
(ert-deftest tp-transaction-test-surface-unmount-excludes-publication-batch ()
@ -871,8 +959,7 @@
(batch-calls 0))
(unwind-protect
(progn
(setq tp--last-transaction-outcome nil
tp--last-shadow-proof nil)
(setq tp--last-transaction-outcome nil)
(cl-letf
(((symbol-function 'tp--transaction-begin-publication-batch)
(lambda (&rest arguments)
@ -881,7 +968,6 @@
(tp-surface-unmount surface))
(should (= batch-calls 0))
(should-not tp--last-transaction-outcome)
(should-not tp--last-shadow-proof)
(should-not (tp-surface-live-p surface))
(with-current-buffer buffer
(should (equal (buffer-string) ""))))
@ -937,13 +1023,11 @@
(should (= (length outcome-cell) 1))
(should (tp-committed-success-outcome-p (aref outcome-cell 0)))
(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)))
(with-current-buffer buffer
(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."
(let ((buffer (generate-new-buffer " *tp-transaction-scoped*"))
(middle "B")
@ -976,9 +1060,8 @@
(revision (tp-surface-revision surface)))
(setq middle "LONG"
middle-face 'italic)
(let ((tp--transaction-artifact-mode 'shadow))
(tp-surface-update-scoped
surface (list middle-object) producer))
(tp-surface-update-scoped
surface (list middle-object) producer)
(should (= (tp-surface-revision surface) (1+ revision)))
(with-current-buffer buffer
(should (equal (buffer-string) "ALONGC"))
@ -986,14 +1069,10 @@
(should (tp-committed-success-outcome-p
tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts
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)))
tp--last-transaction-outcome (list surface)))
(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."
(let ((buffer (generate-new-buffer " *tp-transaction-properties*"))
(value 'bold))
@ -1014,19 +1093,14 @@
buffer producer '(:capability properties)))
(revision (tp-surface-revision surface)))
(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 (eq (get-text-property 2 'face) 'italic))
(should (= (tp-surface-revision surface) (1+ revision)))
(should (tp-committed-success-outcome-p
tp--last-transaction-outcome))
(tp-transaction-test--should-match-outcome-counts
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))))
tp--last-transaction-outcome (list surface))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest tp-transaction-test-property-surface-fault-matrix-restores-exact-state ()
@ -1097,11 +1171,11 @@
(lambda ()
(tp-with-transaction
(when (eq phase 'participant)
(tp-transaction-participate
'property-fault-participant
(lambda ()
(signal (car injected) (cdr injected)))
#'ignore))
(tp-transaction-participate-v2
:key 'property-fault-participant
:stage (lambda ()
(signal (car injected) (cdr injected)))
:rollback #'ignore))
(tp-signal-set source 2)))))
injected)))
(should (= (tp-signal-peek source) 1))
@ -1115,62 +1189,118 @@
(with-current-buffer second-buffer
(should (eq (get-text-property 2 'face) 'bold)))
(should (tp-publication-failure-outcome-p
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)))
tp--last-transaction-outcome)))
(when (buffer-live-p first-buffer) (kill-buffer first-buffer))
(when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(when (tp-signal-live-p source) (tp-signal-dispose source))))))
(ert-deftest tp-transaction-test-v1-and-shadow-artifact-modes-are-equivalent ()
"Independent v1 and shadow surfaces commit identical live artifacts."
(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))
(ert-deftest tp-transaction-test-final-accept-source-uses-v2-binding ()
"V2 validates the candidate final accept binding before publication."
(let* ((structured-buffer (generate-new-buffer " *tp-final-structured*"))
(initial (tp-transaction-test--leaf "old"))
(next (tp-transaction-test--leaf "new"))
(structured (tp-surface-mount structured-buffer initial
'(:capability content)))
(sync (symbol-function 'tp--transaction-sync-publication-batch)))
(unwind-protect
(progn
(let ((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))
(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)))))
(cl-letf (((symbol-function 'tp--transaction-sync-publication-batch)
(lambda ()
(funcall sync)
(when tp--transaction-publication-batch
(setf (tp-publication-batch-candidate-final-accept
tp--transaction-publication-batch)
#'ignore)))))
(should-error (tp-surface-update structured next)
:type 'tp-publication-binding-error)
(with-current-buffer structured-buffer
(should (equal (buffer-string) "old")))
(should (tp-publication-failure-outcome-p
tp--last-transaction-outcome)))
(when (buffer-live-p structured-buffer) (kill-buffer structured-buffer))
)))
(ert-deftest tp-transaction-test-structured-batch-owns-surface-stage-once ()
"Structured execution enters the candidate seam and writes each entry once."
(let* ((source (tp-signal-create 1))
(producer (tp-transaction-test--producer source))
(first-buffer (generate-new-buffer " *tp-structured-first*"))
(second-buffer (generate-new-buffer " *tp-structured-second*"))
(first (tp-surface-mount first-buffer producer '(:capability content)))
(second (tp-surface-mount second-buffer producer '(:capability content)))
(execute (symbol-function 'tp--publication-batch-execute-stage))
(writer (symbol-function 'tp--publish-one-surface))
(calls (make-hash-table :test #'eq))
(stage-calls 0))
(unwind-protect
(cl-letf (((symbol-function 'tp--publication-batch-execute-stage)
(lambda (candidate)
(cl-incf stage-calls)
(funcall execute candidate)))
((symbol-function 'tp--publish-one-surface)
(lambda (prepared)
(let ((surface (tp--prepared-surface-surface prepared)))
(puthash surface (1+ (gethash surface calls 0)) calls))
(funcall writer prepared))))
(tp-signal-set source 2)
(should (= stage-calls 1))
(should (= (gethash first calls 0) 1))
(should (= (gethash second calls 0) 1))
(should (tp-committed-success-outcome-p tp--last-transaction-outcome)))
(when (buffer-live-p first-buffer) (kill-buffer first-buffer))
(when (buffer-live-p second-buffer) (kill-buffer second-buffer))
(when (tp-signal-live-p source) (tp-signal-dispose source)))))
(ert-deftest tp-transaction-test-public-v2-participant-stages-once-from-batch ()
"The public v2 participant is one structured participant in the batch vector."
(tp-transaction-test--with-surface (buffer _surface source)
(let ((stages 0) captured participant)
(tp-with-transaction
(tp-transaction-participate-v2
:key 'public-v2
:stage (lambda ()
(cl-incf stages)
(setq captured tp--transaction-publication-batch
participant
(aref (tp-publication-batch-candidate-participants
tp--transaction-publication-batch)
0)))
:rollback #'ignore)
(tp-signal-set source 2))
(should (= stages 1))
(should (tp-publication-batch-candidate-p captured))
(should (eq (tp--transaction-participant-protocol participant) 'v2))
(should (eq (tp--transaction-participant-state participant) 'committed)))))
(ert-deftest tp-transaction-test-batch-rejects-foreign-stage-capability ()
"A publication batch accepts only the closed package-owned stage seam."
(should-error
(tp--publication-batch-prepare
:transaction-id 'transaction-a
:batch-id 'batch-a
:entries (list (tp-transaction-test--entry))
:participants []
:journals nil
:stage-entries #'ignore
:final-accept #'ignore)
:type 'tp-publication-binding-error))
(ert-deftest tp-transaction-test-participant-vector-drift-rolls-back-surfaces ()
"Registration drift after batch binding fails fast and restores live state."
(tp-transaction-test--with-surface (buffer surface source)
(let ((revision (tp-surface-revision surface))
(stage (symbol-function 'tp--publication-batch-execute-stage)))
(cl-letf (((symbol-function 'tp--publication-batch-execute-stage)
(lambda (candidate)
(tp-transaction-participate-v2 :key 'late
:stage #'ignore
:rollback #'ignore)
(funcall stage candidate))))
(should-error (tp-signal-set source 2)
:type 'tp-publication-binding-error))
(should (= (tp-signal-peek source) 1))
(should (= (tp-surface-revision surface) revision))
(with-current-buffer buffer
(should (equal (buffer-string) "1"))))))
(ert-deftest tp-transaction-test-ordinary-update-success-has-zero-markers ()
"An ordinary publication records zero final authority markers."
@ -1246,7 +1376,7 @@
(should (eq (aref overflow-target 0) 'old)))))
(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))
(tp-transaction-test--with-surface (buffer surface source)
(let* ((targets
@ -1329,7 +1459,7 @@
'(tp-transaction-test-error :phase after-commit))))
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."
(dolist (phase '(apply accept))
(tp-transaction-test--with-surface (buffer surface source)
@ -1366,23 +1496,31 @@
(with-current-buffer buffer
(should (equal (buffer-string) "1")))))))
(ert-deftest tp-transaction-test-manifest-advertises-v1-plus-v2 ()
"The TP manifest retains v1 while advertising the additive protocol."
(should (eq tp-transaction-protocol
'tp-transaction-protocol-v1+v2))
(ert-deftest tp-transaction-test-manifest-advertises-v2-only-contract ()
"The manifest advertises v2 without any legacy route capability."
(should (eq tp-transaction-protocol 'tp-transaction-protocol-v2))
(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)
'tp-transaction-protocol-v1+v2))
'tp-transaction-protocol-v2))
(should (eq (plist-get manifest :structured-participant-api)
'tp-transaction-participate-v2))
(should (plist-get manifest :batch-artifacts))
(should (eq (plist-get manifest :batch-execution) 'v1-bridge))
(should-not (plist-get manifest :batch-execute))
(should (plist-get manifest :shadow-proof))
(should (eq (plist-get manifest :final-marker-operation)
'tp-vector-slots/v1))
(setf (plist-get manifest :transaction-protocol) 'mutated)
(should (eq (plist-get (tp-runtime-manifest) :transaction-protocol)
'tp-transaction-protocol-v1+v2))))
(should (plist-get manifest :batch-execute))
(should (plist-get manifest :single-live-writer))
(dolist (property '(:execution-route :execution-default :execution-routes
:route-option :batch-execution :v1-adapter
:v1-rollback-route))
(should-not (plist-member manifest property)))))
(ert-deftest tp-transaction-test-v1-public-controls-are-absent ()
"TP 2.0 exposes no executable v1 facade or route switches."
(should-not (fboundp 'tp-transaction-participate))
(should-not (fboundp 'tp--publish-transaction-participants))
(should-not (fboundp 'tp--surface-stage-v1-prepared))
(should-not (fboundp 'tp--transaction-validate-execution-route))
(should-not (boundp 'tp-transaction-execution-route))
(should-not (boundp 'tp--transaction-artifact-mode)))
(provide 'tp-transaction-tests)

View File

@ -279,6 +279,7 @@ Otherwise, START-OR-STRING and END define the range."
(and (not (functionp value))
(or (consp value)
(stringp value)
(char-table-p value)
(and (vectorp value) (not (recordp value))))))
(defun tp--copy-cons-spine (value cache)
@ -309,6 +310,7 @@ so dotted tails, shared suffixes, and cycles retain their source topology."
(if (and (not (functionp item))
(or (consp item)
(stringp item)
(char-table-p item)
(and (vectorp item) (not (recordp item)))))
(tp--copy-property-value item cache)
item)))
@ -344,6 +346,7 @@ back-references from cars while `copy-sequence' supplies the spine cheaply."
(when (and (not (functionp item))
(or (consp item)
(stringp item)
(char-table-p item)
(and (vectorp item) (not (recordp item)))))
(setcar target (tp--copy-property-value item cache))))
(setq source (cdr source)
@ -406,7 +409,8 @@ values are recursively isolated."
(defun tp--copy-property-value (value &optional cache)
"Return a defensive copy of mutable containers in property VALUE.
Optional CACHE preserves sharing and cycles across recursive copies.
Cons cells, strings, and vectors are copied recursively. Functions, records,
Cons cells, strings, vectors and character tables are copied recursively.
Functions, records,
and other opaque objects keep their identity; functions are never executed."
(if (not (tp--copy-mutable-property-value-p value))
value
@ -420,6 +424,29 @@ and other opaque objects keep their identity; functions are never executed."
(tp--copy-proper-cons-list value cache)
(tp--copy-cons-spine value cache)))
((stringp value) (tp--copy-string-with-properties value cache))
((char-table-p value)
(let ((copy (copy-sequence value))
(default (char-table-range value nil))
entries)
(puthash value copy cache)
;; Enumerate only local assignments, without inherited/default
;; ranges becoming explicit assignments in the copied table.
(set-char-table-parent copy nil)
(set-char-table-range copy nil nil)
(map-char-table (lambda (range item) (push (cons range item) entries))
copy)
(dolist (entry entries)
(set-char-table-range
copy (car entry) (tp--copy-property-value (cdr entry) cache)))
(set-char-table-range copy nil (tp--copy-property-value default cache))
(set-char-table-parent
copy (tp--copy-property-value (char-table-parent value) cache))
(dotimes (index (or (get (char-table-subtype value)
'char-table-extra-slots) 0))
(set-char-table-extra-slot
copy index (tp--copy-property-value
(char-table-extra-slot value index) cache)))
copy))
((vectorp value)
(let ((copy (copy-sequence value)))
(puthash value copy cache)
@ -431,7 +458,8 @@ and other opaque objects keep their identity; functions are never executed."
(defun tp-property-value-copy (value)
"Return a defensive copy of mutable text-property VALUE.
Functions, records, and other opaque identities are retained; mutable cons,
string, and non-record vector graphs are copied with sharing and cycles intact."
string, character-table and non-record vector graphs are copied with sharing
and cycles intact."
(tp--copy-property-value value (make-hash-table :test #'eq)))
(defun tp--deep-merge-plist (base new)

View File

@ -11,7 +11,7 @@
;;; 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.
;;; Code:
@ -44,8 +44,8 @@
(cl-defstruct (tp--transaction-participant
(:constructor tp--make-transaction-participant))
"One structured participant shared by the v1 and v2 transaction views."
key publish rollback protocol order stage precommit after-commit journal state)
"One structured transaction participant."
key rollback protocol order stage precommit after-commit journal state)
(cl-defstruct (tp--signal-commit-entry
(:constructor tp--make-signal-commit-entry))
@ -94,6 +94,7 @@
(defvar tp--transaction-phase-start nil)
(defvar tp--transaction-phase-timings nil)
(defvar tp--transaction-publication-batch nil)
(defvar tp--transaction-structured-participants nil)
(defvar tp--transaction-final-marker-registry nil)
(defvar tp--transaction-final-marker-owner-keys nil)
(defvar tp--transaction-final-marker-count 0)
@ -126,9 +127,6 @@
(defvar tp--transaction-rollback-final-functions nil)
(defvar tp--transaction-committed-functions nil)
(defvar tp--transaction-artifact-mode 'shadow
"Internal artifact route; the live writer remains the v1 coordinator.")
(defvar tp--transaction-participant-precommit-allowed-functions nil
"Declared internal structured-participant precommit validators.")
@ -660,7 +658,7 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
(fboundp function))))
(defun tp--transaction-register-participant (participant)
"Register structured PARTICIPANT in the authoritative v1 participant list."
"Register structured PARTICIPANT once in the active transaction."
(unless tp--transaction-active
(signal 'tp-reactive-error
(list :participant-outside-transaction
@ -675,12 +673,12 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
participant))
(defun tp--transaction-make-participant
(key publish rollback protocol precommit after-commit journal)
"Build a participant from KEY, PUBLISH, ROLLBACK, and PROTOCOL.
(key stage rollback protocol precommit after-commit journal)
"Build a participant from KEY, STAGE, ROLLBACK, and PROTOCOL.
PRECOMMIT and AFTER-COMMIT are optional internal callbacks; JOURNAL is opaque
owner-local rollback state."
(unless (functionp publish)
(signal 'wrong-type-argument (list 'functionp publish)))
(unless (functionp stage)
(signal 'wrong-type-argument (list 'functionp stage)))
(unless (functionp rollback)
(signal 'wrong-type-argument (list 'functionp rollback)))
(unless (tp--transaction-participant-precommit-function-p precommit)
@ -690,39 +688,19 @@ owner-local rollback state."
(signal 'wrong-type-argument (list 'functionp after-commit)))
(tp--make-transaction-participant
:key (tp--copy-property-value key)
:publish publish
:rollback rollback
:protocol protocol
:order (prog1 tp--transaction-participant-order
(cl-incf tp--transaction-participant-order))
:stage publish
:stage stage
:precommit precommit
:after-commit after-commit
:journal journal
: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
(&key key stage rollback precommit after-commit journal)
"Register internal KEY with STAGE and ROLLBACK through the v1 coordinator.
"Register internal KEY with structured STAGE and ROLLBACK capabilities.
PRECOMMIT and AFTER-COMMIT are optional declared callbacks. JOURNAL is the
participant's opaque owner-local state."
(unless tp--transaction-active
@ -733,17 +711,55 @@ participant's opaque owner-local state."
(tp--transaction-make-participant
key stage rollback 'v2 precommit after-commit journal)))
;;;###autoload
(cl-defun tp-transaction-participate-v2
(&key key stage rollback precommit after-commit journal)
"Register a structured rollback-capable participant under KEY.
STAGE and ROLLBACK are required no-argument functions. PRECOMMIT may be one
declared package-owned validator; AFTER-COMMIT is contained work queued only
after final accept. JOURNAL is opaque owner-local rollback state. Return KEY
without exposing TP's internal participant object."
(tp--transaction-participate-v2
:key key :stage stage :rollback rollback :precommit precommit
:after-commit after-commit :journal journal)
key)
(defun tp--transaction-participants-in-registration-order ()
"Return the authoritative participants in deterministic declaration order."
(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 ()
"Return the frozen participant vector after exact identity validation."
(let* ((participants tp--transaction-structured-participants)
(registered (tp--transaction-participants-in-registration-order))
(count (length registered)))
(unless (and (vectorp participants) (= (length participants) count))
(signal 'tp-publication-binding-error
(list :participant-count participants registered)))
(cl-loop for participant in registered
for index from 0
unless (eq participant (aref participants index))
do (signal 'tp-publication-binding-error
(list :participant-order index participant
(aref participants index))))
(when tp--transaction-publication-batch
(let ((candidate-participants
(tp-publication-batch-candidate-participants
tp--transaction-publication-batch)))
(unless (eq candidate-participants participants)
(signal 'tp-publication-binding-error
(list :participant-vector candidate-participants
participants)))))
participants))
(defun tp--stage-structured-transaction-participants ()
"Stage the frozen structured participant vector in declaration order."
(let ((participants (tp--transaction-validate-structured-participants)))
(dotimes (index (length participants))
(let ((participant (aref participants index)))
(push participant tp--transaction-published-participants)
(setf (tp--transaction-participant-state participant) 'staged)
(funcall (tp--transaction-participant-stage participant))))))
(defun tp--rollback-transaction-participants ()
"Rollback published participants and return any failures."
@ -763,23 +779,28 @@ participant's opaque owner-local state."
(setf (tp--transaction-participant-state participant) 'rolled-back)))
(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--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)
(defun tp--run-structured-transaction-participant-precommits ()
"Run validators from the frozen structured participant vector."
(let ((participants (tp--transaction-validate-structured-participants)))
(dotimes (index (length participants))
(when-let* ((function
(tp--transaction-participant-after-commit participant)))
(tp--enqueue-after-commit function)))))
(tp--transaction-participant-precommit
(aref participants index))))
(unless (tp--transaction-participant-precommit-function-p function)
(signal 'tp-reactive-error
(list :invalid-participant-precommit function)))
(funcall function)))))
(defun tp--commit-structured-transaction-participants ()
"Commit states from the frozen structured participant vector."
(let ((participants (tp--transaction-validate-structured-participants)))
(dotimes (index (length participants))
(let ((participant (aref participants index)))
(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--dequeue-dirty-binding ()
"Return and remove the next queued dirty binding."
@ -867,14 +888,6 @@ participant's opaque owner-local state."
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-current-outcome-cell ()
"Return the active transaction's caller-retainable one-slot outcome cell."
(unless tp--transaction-active
@ -913,24 +926,24 @@ participant's opaque owner-local state."
surface-journals))
(defun tp--transaction-begin-publication-batch
(batch-id entries surface-journals)
"Install BATCH-ID as the candidate for ENTRIES and SURFACE-JOURNALS."
(batch-id entries surface-journals stage-entries)
"Install BATCH-ID for ENTRIES, SURFACE-JOURNALS, and STAGE-ENTRIES."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :batch-outside-transaction batch-id)))
(when tp--transaction-publication-batch
(signal 'tp-publication-state-error
(list :duplicate-transaction-batch batch-id)))
(when (tp--transaction-v2-artifacts-enabled-p)
(setq tp--transaction-publication-batch
(tp--publication-batch-prepare
:transaction-id tp--transaction-id
:batch-id batch-id
:entries entries
:participants
(vconcat (tp--transaction-participants-in-registration-order))
:journals (tp--transaction-batch-journal-view surface-journals)
:final-accept tp--transaction-final-accept-function
:diagnostics nil)))
(setq tp--transaction-publication-batch
(tp--publication-batch-prepare
:transaction-id tp--transaction-id
:batch-id batch-id
:entries entries
:participants
tp--transaction-structured-participants
:journals (tp--transaction-batch-journal-view surface-journals)
:stage-entries stage-entries
:final-accept tp--transaction-final-accept-function
:diagnostics nil))
tp--transaction-publication-batch)
(defun tp--transaction-batch-transition (next)
@ -1146,7 +1159,17 @@ through TP's closed marker-operation whitelist."
(unwind-protect
(progn
(tp--transaction-apply-final-markers)
(funcall tp--transaction-final-accept-function)
(if tp--transaction-publication-batch
(let ((candidate-function
(tp-publication-batch-candidate-final-accept
tp--transaction-publication-batch)))
(unless (eq candidate-function
tp--transaction-final-accept-function)
(signal 'tp-publication-binding-error
(list :final-accept candidate-function
tp--transaction-final-accept-function)))
(funcall candidate-function))
(funcall tp--transaction-final-accept-function))
(setq accepted t))
(unless accepted
(setq tp--transaction-marker-restore-failures
@ -1168,9 +1191,8 @@ through TP's closed marker-operation whitelist."
(tp--transaction-publish-outcome outcome))))))
(defun tp--transaction-run-shadow-proof (phase)
"Compare v2 artifacts with the single v1 live result for PHASE."
(when (and tp--transaction-publication-batch
(tp--transaction-v2-artifacts-enabled-p))
"Compare structured artifacts with the selected single live result for PHASE."
(when tp--transaction-publication-batch
(let ((ok t) results outcome-equivalent)
(dolist (entry
(tp-publication-batch-candidate-entries
@ -1435,6 +1457,7 @@ the primary condition data."
(tp--transaction-published-participants nil)
(tp--transaction-signal-commit-journal nil)
(tp--transaction-publication-batch nil)
(tp--transaction-structured-participants nil)
(tp--transaction-final-marker-registry
(make-vector tp--final-marker-max-count nil))
(tp--transaction-final-marker-owner-keys
@ -1460,13 +1483,16 @@ the primary condition data."
(tp--transaction-enter-phase 'recompute)
(tp--flush-dirty-bindings)
(tp--transaction-enter-phase 'publication)
(setq tp--transaction-structured-participants
(vconcat
(tp--transaction-participants-in-registration-order)))
(run-hooks 'tp--transaction-publish-functions)
(tp--transaction-batch-transition 'participants)
(tp--transaction-enter-phase 'participants)
(tp--publish-transaction-participants)
(tp--stage-structured-transaction-participants)
(tp--transaction-batch-transition 'precommit)
(tp--transaction-enter-phase 'precommit)
(tp--run-transaction-participant-precommits)
(tp--run-structured-transaction-participant-precommits)
(tp--run-transaction-precommit-functions)
(tp--transaction-freeze-final-markers)
(tp--transaction-sync-publication-batch)
@ -1491,7 +1517,7 @@ the primary condition data."
tp--transaction-final-accept-function)))
(tp--transaction-run-final-accept)
(setq success t)
(tp--commit-transaction-participants)
(tp--commit-structured-transaction-participants)
(tp--transaction-run-shadow-proof 'commit)
(when quit-flag
(setq pending-quit t

View File

@ -205,12 +205,51 @@ OPTIONS support :normalizer, :validator, :equality, :merge, and :projector."
#'tp--merge-face-values
(lambda (_old new) new)))
(defun tp--native-keymap-equal-p (left right)
"Compare native snapshots LEFT and RIGHT, retaining commands and menu order."
(let ((seen (make-hash-table :test #'eq)))
(cl-labels
((bindings (map)
(let ((local (copy-sequence (if (symbolp map)
(indirect-function map) map)))
entries)
(set-keymap-parent local nil)
(map-keymap (lambda (key value) (push (cons key value) entries)) local)
entries))
(same (old new)
(cond
((eq old new) t)
((memq new (gethash old seen)) t)
((and (keymapp old) (keymapp new))
(puthash old (cons new (gethash old seen)) seen)
(and (equal-including-properties (keymap-prompt old)
(keymap-prompt new))
(same (bindings old) (bindings new))
(same (keymap-parent old) (keymap-parent new))))
((or (functionp old) (functionp new)) nil)
((and (consp old) (consp new))
(puthash old (cons new (gethash old seen)) seen)
(and (same (car old) (car new)) (same (cdr old) (cdr new))))
((and (vectorp old) (vectorp new) (= (length old) (length new)))
(puthash old (cons new (gethash old seen)) seen)
(cl-loop for index below (length old)
always (same (aref old index) (aref new index))))
(t (equal old new)))))
(same left right))))
(defun tp--native-property-value-equal-p (left right)
"Compare native values LEFT and RIGHT while preserving callable identity."
(cond
((and (keymapp left) (keymapp right)) (tp--native-keymap-equal-p left right))
((or (functionp left) (functionp right)) (eq left right))
(t (equal left right))))
(defun tp-register-text-property (property)
"Register and return a direct policy for Emacs PROPERTY."
(let ((id (tp-text-property-id property)))
(or (tp-property-policy id)
(tp-define-property-policy
id :equality #'equal
id :equality #'tp--native-property-value-equal-p
:merge (tp--text-property-merge-function property)
:projector (lambda (value) (list property value))))))

File diff suppressed because it is too large Load Diff

View File

@ -1,4 +1,4 @@
;;; tp-transaction.el --- Additive publication transaction contracts -*- lexical-binding: t; -*-
;;; tp-transaction.el --- Structured publication transaction contracts -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Geekinney
@ -11,10 +11,11 @@
;;; Commentary:
;; Internal immutable artifacts and one-shot state machines used to shadow TP's
;; v1 publication coordinator. This module owns no live writer and never edits
;; a buffer. `tp-reactive' drives the state machine, while `tp-surface' supplies
;; exact target entries backed by the v1 prepare journals and snapshots.
;; Internal immutable artifacts and one-shot state machines for TP publication.
;; The package-owned entry-stage capability stored in a batch candidate drives
;; publication. This module never edits a buffer itself: `tp-reactive' drives
;; the state machine and `tp-surface' supplies and stages exact target entries
;; backed by the shared prepare journals and snapshots.
;;; Code:
@ -33,7 +34,7 @@
"Invalid TP final-accept marker"
'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.")
(defconst tp--publication-batch-transitions
@ -48,6 +49,10 @@
'(committed rolled-back discarded)
"Terminal publication batch candidate states.")
(defconst tp--publication-batch-stage-entry-functions
'(tp--surface-stage-publication-entries)
"Closed package-owned publication entry stage capabilities.")
(defconst tp--final-marker-max-count 8
"Maximum number of opaque final markers in one transaction.")
@ -78,11 +83,12 @@
(defun tp--proper-unique-list-p (items)
"Return non-nil when ITEMS is a proper list with no equal duplicates."
(and (proper-list-p items)
(let (seen (unique t))
(let ((seen (make-hash-table :test #'equal))
(unique t))
(dolist (item items unique)
(if (member item seen)
(if (gethash item seen)
(setq unique nil)
(push item seen))))))
(puthash item t seen))))))
(cl-defstruct (tp-publication-target-entry
(:constructor tp--make-publication-target-entry)
@ -110,6 +116,20 @@
(shadow-validator nil :read-only t)
rollback-result post-rollback-state shadow-actual shadow-proven-p)
(defun tp--publication-target-entry-arguments-valid-p
(transaction-id batch-id candidate-id surface-id mount-ids buffer
old-revision new-revision authority-token shadow-validator)
"Return non-nil when target arguments bind TRANSACTION-ID and BATCH-ID.
CANDIDATE-ID, SURFACE-ID, MOUNT-IDS, BUFFER, OLD-REVISION, NEW-REVISION,
AUTHORITY-TOKEN, and SHADOW-VALIDATOR must have valid publication shapes."
(and transaction-id batch-id candidate-id surface-id
(bufferp buffer) (buffer-live-p buffer)
(integerp old-revision) (>= old-revision 0)
(integerp new-revision) (= new-revision (1+ old-revision))
(tp--proper-unique-list-p mount-ids)
authority-token
(or (null shadow-validator) (functionp shadow-validator))))
(cl-defun tp--publication-target-entry-create
(&key transaction-id batch-id candidate-id surface-id mount-ids buffer
old-revision new-revision plan diff ledger objects ranges client-state
@ -119,15 +139,11 @@
CANDIDATE-ID, SURFACE-ID, MOUNT-IDS, BUFFER, OLD-REVISION, NEW-REVISION, PLAN,
DIFF, LEDGER, OBJECTS, RANGES, CLIENT-STATE, ROLLBACK-SNAPSHOT, and
AUTHORITY-TOKEN describe the target. MAPPING-GENERATION is optional.
OPERATION-COUNTS is filled from the v1 report. SHADOW-EXPECTED and
OPERATION-COUNTS is filled from the live report. SHADOW-EXPECTED and
SHADOW-VALIDATOR are private comparison artifacts."
(unless (and transaction-id batch-id candidate-id surface-id
(bufferp buffer) (buffer-live-p buffer)
(integerp old-revision) (>= old-revision 0)
(integerp new-revision) (= new-revision (1+ old-revision))
(tp--proper-unique-list-p mount-ids)
authority-token
(or (null shadow-validator) (functionp shadow-validator)))
(unless (tp--publication-target-entry-arguments-valid-p
transaction-id batch-id candidate-id surface-id mount-ids buffer
old-revision new-revision authority-token shadow-validator)
(signal 'tp-publication-binding-error
(list :target-entry transaction-id batch-id candidate-id surface-id
buffer old-revision new-revision mount-ids authority-token)))
@ -222,7 +238,7 @@ SHADOW-VALIDATOR are private comparison artifacts."
(cl-defstruct (tp-publication-batch-candidate
(:constructor tp--make-publication-batch-candidate)
(:copier nil))
"A one-shot structured view over the existing v1 transaction state."
"A one-shot structured publication authority over shared rollback state."
(transaction-id nil :read-only t)
(id nil :read-only t)
state
@ -230,6 +246,7 @@ SHADOW-VALIDATOR are private comparison artifacts."
(entries nil :read-only t)
(participants nil :read-only t)
(journals nil :read-only t)
(stage-entries nil :read-only t)
final-accept
(final-accept-id nil :read-only t)
diagnostics
@ -271,16 +288,22 @@ SHADOW-VALIDATOR are private comparison artifacts."
entries))))
(cl-defun tp--publication-batch-prepare
(&key transaction-id batch-id entries participants journals final-accept
diagnostics)
(&key transaction-id batch-id entries participants journals stage-entries
final-accept diagnostics)
"Prepare TRANSACTION-ID and BATCH-ID over exact ENTRIES.
PARTICIPANTS is an ordered reference vector, JOURNALS is the existing v1 state
view, FINAL-ACCEPT is the single coordinator function, and DIAGNOSTICS contains
known preaccept observations."
PARTICIPANTS is an ordered reference vector, JOURNALS is the shared rollback
view, STAGE-ENTRIES is an optional package-owned execution capability,
FINAL-ACCEPT is the single coordinator function, and DIAGNOSTICS contains known
preaccept observations."
(unless (and transaction-id batch-id
(tp--publication-batch-entries-valid-p
entries transaction-id batch-id)
(vectorp participants)
(or (null stage-entries)
(and (symbolp stage-entries)
(memq stage-entries
tp--publication-batch-stage-entry-functions)
(fboundp stage-entries)))
(functionp final-accept))
(signal 'tp-publication-binding-error
(list :batch transaction-id batch-id entries participants)))
@ -291,10 +314,21 @@ known preaccept observations."
:entries (copy-sequence entries)
:participants participants
:journals journals
:stage-entries stage-entries
:final-accept final-accept
:final-accept-id (tp--next-final-accept-id)
:diagnostics (tp--copy-property-value diagnostics)))
(defun tp--publication-batch-execute-stage (candidate)
"Execute CANDIDATE's package-owned entry stage capability exactly once."
(unless (and (tp-publication-batch-candidate-p candidate)
(eq (tp-publication-batch-candidate-state candidate) 'staged)
(memq (tp-publication-batch-candidate-stage-entries candidate)
tp--publication-batch-stage-entry-functions))
(signal 'tp-publication-state-error
(list :batch-stage candidate)))
(funcall (tp-publication-batch-candidate-stage-entries candidate) candidate))
(defun tp--publication-batch-terminal-p (candidate)
"Return non-nil when CANDIDATE has one terminal disposition."
(and (tp-publication-batch-candidate-p candidate)

12
tp.el
View File

@ -2,7 +2,7 @@
;; Copyright (C) 2024-2026 Geekinney
;; Version: 1.0.1
;; Version: 2.0.0
;; Keywords: convenience text-properties
;; Author: Geekinney (kinneyzhang666@gmail.com)
;; Package-Requires: ((emacs "28.1"))
@ -26,7 +26,7 @@
;; tp-style.el Native property policies, contribution composition,
;; named declarations, and explicit computed values.
;; 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
;; adapters.
;; tp-surface.el Retained plans, objects, range anchors, mounts, indexes,
@ -66,12 +66,12 @@
(require 'tp-builtins)
(defconst tp--runtime-manifest
`(:package tp :version "1.0.1"
`(:package tp :version "2.0.0"
:transaction-protocol ,tp-transaction-protocol
:batch-artifacts t
:batch-execution v1-bridge
:batch-execute nil
:shadow-proof t
:batch-execute t
:structured-participant-api tp-transaction-participate-v2
:single-live-writer t
:final-marker-operation tp-vector-slots/v1)
"Immutable package capability facts for cross-package compatibility checks.")