feat(tp): add rollback-capable transaction participants

Publish client-owned side state after retained surfaces and roll it back in reverse order on any transaction failure.\n\nVerified: 715 ERT tests, 92 doctests, WERROR compile-all, checkdoc, git diff --check.
This commit is contained in:
Kinneyzhang 2026-08-06 03:40:40 +08:00
parent 905d3523ac
commit 8d108403ad
7 changed files with 136 additions and 6 deletions

View File

@ -6,6 +6,7 @@ All notable changes to the tp library are documented here.
### Added ### Added
- `tp-transaction-participate` lets a client promote rollback-capable opaque side state after all affected surfaces publish but before source values commit. Participant keys are unique per outer transaction, failure rolls participants back in reverse publication order, and observers still run only after the transaction exits.
- `tp-propertize`, `tp-apply`, and `tp-watch` now provide simple one-shot string, one-shot buffer-range, and reactive existing-text entry points over the same schema/cascade/projector and retained properties-surface core. - `tp-propertize`, `tp-apply`, and `tp-watch` now provide simple one-shot string, one-shot buffer-range, and reactive existing-text entry points over the same schema/cascade/projector and retained properties-surface core.
- TP 1.0 retained surfaces now provide defensive pure plans, prepare-scoped object identity, keyed/positional reconciliation, `content` and `properties` capabilities, marker-backed range anchors, same-surface overlapping property contributions, compare-before-write conflicts and explicit rebase, common-prefix/suffix text edits, property-run diffs, side indexes, opaque client state, generic reports, lifecycle cleanup, and atomic multi-buffer publication with exact rollback. Pure materialization uses the same plan semantics without leaving live handles or subscriptions. - TP 1.0 retained surfaces now provide defensive pure plans, prepare-scoped object identity, keyed/positional reconciliation, `content` and `properties` capabilities, marker-backed range anchors, same-surface overlapping property contributions, compare-before-write conflicts and explicit rebase, common-prefix/suffix text edits, property-run diffs, side indexes, opaque client state, generic reports, lifecycle cleanup, and atomic multi-buffer publication with exact rollback. Pure materialization uses the same plan semantics without leaving live handles or subscriptions.
- TP 1.0 signals and bindings now form an exact source→binding and binding→binding dependency graph with conditional rewiring, memoized equality cutoffs, transaction-local candidate signal values, deduplicated topological flushing, nested-write stabilization, rollback, cycle paths, owner disposal, buffer-scoped sources, variable adapters, and public scheduler counters. The legacy layer scanner remains isolated only until the retained-surface cutover. - TP 1.0 signals and bindings now form an exact source→binding and binding→binding dependency graph with conditional rewiring, memoized equality cutoffs, transaction-local candidate signal values, deduplicated topological flushing, nested-write stabilization, rollback, cycle paths, owner disposal, buffer-scoped sources, variable adapters, and public scheduler counters. The legacy layer scanner remains isolated only until the retained-surface cutover.

View File

@ -176,7 +176,7 @@ Since 0.2.0 the library is organized as a family of layered modules (`tp-core`,
The TP 1.0 migration has begun with a pure schema-driven cascade kernel. `tp-style.el` adds namespaced property schemas, structured selectors, origin/importance/layer/specificity/scope/source-order precedence, property-specific inheritance, tagged CSS-wide values, inherited custom properties, explicit `tp-computed` sources, projection to Emacs properties, and read-only winner provenance. It deliberately owns no buffers, markers, mounts, or reactive subscriptions; retained surfaces will build on this kernel in later migration phases. The TP 1.0 migration has begun with a pure schema-driven cascade kernel. `tp-style.el` adds namespaced property schemas, structured selectors, origin/importance/layer/specificity/scope/source-order precedence, property-specific inheritance, tagged CSS-wide values, inherited custom properties, explicit `tp-computed` sources, projection to Emacs properties, and read-only winner provenance. It deliberately owns no buffers, markers, mounts, or reactive subscriptions; retained surfaces will build on this kernel in later migration phases.
`tp-reactive.el` now also provides the TP 1.0 exact dependency runtime: signals invalidate only their subscribed bindings, binding reads form memoized binding→binding edges, conditional computations replace obsolete dependencies, and the outermost `tp-with-transaction` flushes each dirty binding once. Candidate signal writes and binding values/dependencies commit together; compute or cycle failures roll them back. Global and buffer-local variable adapters reuse this graph without making text properties or buffer scans the runtime database. `tp-reactive.el` now also provides the TP 1.0 exact dependency runtime: signals invalidate only their subscribed bindings, binding reads form memoized binding→binding edges, conditional computations replace obsolete dependencies, and the outermost `tp-with-transaction` flushes each dirty binding once. Candidate signal writes and binding values/dependencies commit together; compute, cycle, publication, or transaction-participant failures roll them back. `tp-transaction-participate` lets a client promote opaque side state after surfaces publish while supplying its inverse for the same rollback boundary. Global and buffer-local variable adapters reuse this graph without making text properties or buffer scans the runtime database.
`tp-surface.el` completes the retained publication path from object identity to marker-backed mounts and buffers. A producer receives a short-lived prepare context, ensures candidate objects before computing output, and returns a defensive pure plan plus optional opaque client state. TP validates the whole candidate before publication, applies common-prefix/suffix text edits and property-run diffs, swaps plans/indexes/client state at one revision, and rolls every affected buffer and signal back together on failure. `content` owns a disjoint text span; `properties` decorates attached host ranges, detects external property conflicts, and requires explicit rebase. Overlap is composable inside one surface and rejected across independent surfaces so ownership cannot silently split. `tp-surface.el` completes the retained publication path from object identity to marker-backed mounts and buffers. A producer receives a short-lived prepare context, ensures candidate objects before computing output, and returns a defensive pure plan plus optional opaque client state. TP validates the whole candidate before publication, applies common-prefix/suffix text edits and property-run diffs, swaps plans/indexes/client state at one revision, and rolls every affected buffer and signal back together on failure. `content` owns a disjoint text span; `properties` decorates attached host ranges, detects external property conflicts, and requires explicit rebase. Overlap is composable inside one surface and rejected across independent surfaces so ownership cannot silently split.
@ -532,6 +532,7 @@ A complete overview of all tp.el functions organized by category:
| `tp-binding-live-p` / `tp-binding-dependency-count` / `tp-binding-subscriber-count` | Inspect binding lifecycle and exact graph degree | | `tp-binding-live-p` / `tp-binding-dependency-count` / `tp-binding-subscriber-count` | Inspect binding lifecycle and exact graph degree |
| `tp-binding-dispose-owner` | Remove an owner's bindings and all graph edges | | `tp-binding-dispose-owner` | Remove an owner's bindings and all graph edges |
| `tp-with-transaction` | Batch candidate writes and publish one deduplicated dirty closure atomically | | `tp-with-transaction` | Batch candidate writes and publish one deduplicated dirty closure atomically |
| `tp-transaction-participate` | Promote client side state inside the publication boundary with an explicit rollback action |
| `tp-variable-signal` | Adapt a global or buffer-local Elisp variable into a scoped signal | | `tp-variable-signal` | Adapt a global or buffer-local Elisp variable into a scoped signal |
| `tp-reactive-counters` / `tp-reactive-reset-counters` | Read or reset public scheduler work counters | | `tp-reactive-counters` / `tp-reactive-reset-counters` | Read or reset public scheduler work counters |

View File

@ -175,7 +175,7 @@
TP 1.0 迁移已经从纯 schema-driven cascade kernel 开始。`tp-style.el` 新增 namespaced property schema、结构化 selector、origin/importance/layer/specificity/scope/source-order 优先级、逐属性继承、带 tag 的 CSS-wide 值、可继承 custom property、显式 `tp-computed` source、Emacs 属性投影和只读 winner provenance。这个模块刻意不拥有 buffer、marker、mount 或响应式订阅;后续 retained surface 会建立在同一个 kernel 上。 TP 1.0 迁移已经从纯 schema-driven cascade kernel 开始。`tp-style.el` 新增 namespaced property schema、结构化 selector、origin/importance/layer/specificity/scope/source-order 优先级、逐属性继承、带 tag 的 CSS-wide 值、可继承 custom property、显式 `tp-computed` source、Emacs 属性投影和只读 winner provenance。这个模块刻意不拥有 buffer、marker、mount 或响应式订阅;后续 retained surface 会建立在同一个 kernel 上。
`tp-reactive.el` 现在也提供 TP 1.0 的精确依赖 runtimesignal 只 invalidates 真实订阅的 bindingbinding read 建立 memoized binding→binding edge条件计算会替换已经失效的旧依赖最外层 `tp-with-transaction` 对每个 dirty binding 最多 flush 一次。candidate signal write 与 binding value/dependencies 一起提交compute 或 cycle 失败时一起回滚。global 和 buffer-local variable adapter 复用同一 graph不再把文本属性或 buffer scan 当作新 runtime database。 `tp-reactive.el` 现在也提供 TP 1.0 的精确依赖 runtimesignal 只 invalidates 真实订阅的 bindingbinding read 建立 memoized binding→binding edge条件计算会替换已经失效的旧依赖最外层 `tp-with-transaction` 对每个 dirty binding 最多 flush 一次。candidate signal write 与 binding value/dependencies 一起提交compute、cycle、publication 或 transaction participant 失败时一起回滚。`tp-transaction-participate` 允许 client 在 surface 发布后晋升 opaque side state同时为同一 rollback boundary 提供逆操作。global 和 buffer-local variable adapter 复用同一 graph不再把文本属性或 buffer scan 当作新 runtime database。
`tp-surface.el` 补全了从 object identity 到 marker-backed mount 和 buffer 的 retained publication 路径。producer 获得短生命周期 prepare context在计算输出前确保 candidate object并返回防御性 pure plan 与可选 opaque client state。TP 在 publication 前验证整个 candidate执行 common-prefix/suffix text edit 与 property-run diff并以同一个 revision 切换 plan/index/client state失败时把所有受影响 buffer 与 signal 一起回滚。`content` 拥有一个不重叠的文本 span`properties` 装饰 attached host range检测外部 property conflict并要求显式 rebase。同一 surface 内的 overlap 可以合成;独立 surface 之间的 overlap 会被拒绝,避免所有权静默分裂。 `tp-surface.el` 补全了从 object identity 到 marker-backed mount 和 buffer 的 retained publication 路径。producer 获得短生命周期 prepare context在计算输出前确保 candidate object并返回防御性 pure plan 与可选 opaque client state。TP 在 publication 前验证整个 candidate执行 common-prefix/suffix text edit 与 property-run diff并以同一个 revision 切换 plan/index/client state失败时把所有受影响 buffer 与 signal 一起回滚。`content` 拥有一个不重叠的文本 span`properties` 装饰 attached host range检测外部 property conflict并要求显式 rebase。同一 surface 内的 overlap 可以合成;独立 surface 之间的 overlap 会被拒绝,避免所有权静默分裂。
@ -527,6 +527,7 @@ tp.el 所有函数按类别组织的完整概览:
| `tp-binding-live-p` / `tp-binding-dependency-count` / `tp-binding-subscriber-count` | 检查 binding lifecycle 与精确 graph degree | | `tp-binding-live-p` / `tp-binding-dependency-count` / `tp-binding-subscriber-count` | 检查 binding lifecycle 与精确 graph degree |
| `tp-binding-dispose-owner` | 删除 owner 的 bindings 及全部 graph edges | | `tp-binding-dispose-owner` | 删除 owner 的 bindings 及全部 graph edges |
| `tp-with-transaction` | 批量冻结 candidate write并原子发布一次去重后的 dirty closure | | `tp-with-transaction` | 批量冻结 candidate write并原子发布一次去重后的 dirty closure |
| `tp-transaction-participate` | 在 publication boundary 内晋升 client side state并提供显式 rollback action |
| `tp-variable-signal` | 把 global 或 buffer-local Elisp variable 适配为 scoped signal | | `tp-variable-signal` | 把 global 或 buffer-local Elisp variable 适配为 scoped signal |
| `tp-reactive-counters` / `tp-reactive-reset-counters` | 读取或重置 public scheduler work counters | | `tp-reactive-counters` / `tp-reactive-reset-counters` | 读取或重置 public scheduler work counters |

View File

@ -189,6 +189,7 @@ tp 不会把外部属性收编成新的匿名层,也不会静默覆盖它。
- `tp-bind` 的 identity 是 owner object identity 加 caller-namespaced key重复安装复用同一 bindingcompute definition 变化才使它 dirty。`tp-binding-read` 读取 memoized value 并建立 binding→binding edge。 - `tp-bind` 的 identity 是 owner object identity 加 caller-namespaced key重复安装复用同一 bindingcompute definition 变化才使它 dirty。`tp-binding-read` 读取 memoized value 并建立 binding→binding edge。
- 每次成功 compute 以本次实际读取的依赖替换旧依赖;条件分支切换后旧 signal 不再触发。binding value 经其 equality comparator 判等,相等结果不 invalidates downstream。 - 每次成功 compute 以本次实际读取的依赖替换旧依赖;条件分支切换后旧 signal 不再触发。binding value 经其 equality comparator 判等,相等结果不 invalidates downstream。
- signal write 先写入 transaction-local candidate state。最外层 `tp-with-transaction` 只遍历 exact dirty closure去重并按 binding dependency 拓扑惰性求值compute 内嵌 write 排队稳定,不递归执行。 - signal write 先写入 transaction-local candidate state。最外层 `tp-with-transaction` 只遍历 exact dirty closure去重并按 binding dependency 拓扑惰性求值compute 内嵌 write 排队稳定,不递归执行。
- `tp-transaction-participate KEY PUBLISH ROLLBACK` 只允许在 outer transaction 内登记。所有 surface candidate 发布并切换 client state 后participant 按登记顺序执行 `PUBLISH`;任一后续步骤失败时,已经进入 publication 的 participant 按逆序执行 `ROLLBACK`。KEY 在同一 transaction 内唯一两个函数均不得接收参数rollback 必须能够撤销 publish 已经开始后的部分副作用。
- 任一 compute 或 cycle 失败会恢复 committed signal values、last successful binding values、dependencies、dirty state、owner registry 和 scheduler counters。cycle condition 携带 namespaced binding-key path。 - 任一 compute 或 cycle 失败会恢复 committed signal values、last successful binding values、dependencies、dirty state、owner registry 和 scheduler counters。cycle condition 携带 namespaced binding-key path。
- `tp-variable-signal` 是 global/buffer-local Elisp variable包括后续 `$var` compiler的 source adapter它只转发精确 scope 的 write不调用 legacy layer renderer。 - `tp-variable-signal` 是 global/buffer-local Elisp variable包括后续 `$var` compiler的 source adapter它只转发精确 scope 的 write不调用 legacy layer renderer。
- `tp-reactive-counters` 只公开 invalidated、recomputed、skipped、subscription-added、subscription-removed 五个工作量计数,不暴露 internal hash shape。 - `tp-reactive-counters` 只公开 invalidated、recomputed、skipped、subscription-added、subscription-removed 五个工作量计数,不暴露 internal hash shape。
@ -200,7 +201,7 @@ tp 不会把外部属性收编成新的匿名层,也不会静默覆盖它。
- `content` capability 拥有一个 disjoint text span使用 character common-prefix/suffix 与 direct-property run diff外部字符编辑使其 stale。`properties` capability 不能携带 text只能通过 `tp-object-attach-range` 写 attached anchor。host edit 位于 anchor 前方时 marker 正常移动;跨入 owned range 时按 boundary policy shorten/remove/stale。 - `content` capability 拥有一个 disjoint text span使用 character common-prefix/suffix 与 direct-property run diff外部字符编辑使其 stale。`properties` capability 不能携带 text只能通过 `tp-object-attach-range` 写 attached anchor。host edit 位于 anchor 前方时 marker 正常移动;跨入 owned range 时按 boundary policy shorten/remove/stale。
- properties ledger 保存 baseline、last-published value 与 contribution anchors。prepare compare-before-write外部 property override 触发 `tp-property-conflict` 且保持旧 revision。`tp-range-rebase` 显式接受当前 host runs 为新 baselineunmount 只恢复仍等于 TP last-published value 的子区间,冲突子区间保持外部值并进入 report。 - properties ledger 保存 baseline、last-published value 与 contribution anchors。prepare compare-before-write外部 property override 触发 `tp-property-conflict` 且保持旧 revision。`tp-range-rebase` 显式接受当前 host runs 为新 baselineunmount 只恢复仍等于 TP last-published value 的子区间,冲突子区间保持外部值并进入 report。
- 同一 surface 的 overlapping properties contributions 按 plan order 和 native property schema merge独立 surfaces 当前不得重叠字符 ownership。这个限制把 journal owner 保持为唯一 surface避免两套 baseline 静默覆盖。 - 同一 surface 的 overlapping properties contributions 按 plan order 和 native property schema merge独立 surfaces 当前不得重叠字符 ownership。这个限制把 journal owner 保持为唯一 surface避免两套 baseline 静默覆盖。
- 最外层 transaction 先完成所有 producer/plan/conflict validation再按 surface id publish。multi-buffer change group 负责 text rollbackTP 的精确 property journal 覆盖 `with-silent-modifications`;失败恢复 buffer direct properties、markers/index、objects、plan、client state、revision、bindings 与 signal values。publish 中 killed buffer 不复活,其他 surfaces 与 sources 回滚。 - 最外层 transaction 先完成所有 producer/plan/conflict validation再按 surface id publish,随后执行 transaction participants最后提交 source values。multi-buffer change group 负责 text rollbackTP 的精确 property journal 覆盖 `with-silent-modifications`;失败先逆序撤销已经进入 publication 的 participants恢复 buffer direct properties、markers/index、objects、plan、client state、revision、bindings 与 signal values。publish 中 killed buffer 不复活,其他 surfaces 与 sources 回滚。
- `tp-surface-report` 的字段只使用 transaction/surface/source/binding/object/text/property/conflict/observer/timing 通用词汇。observer 在成功 commit 且 publishing transaction 的动态范围退出后执行,因此 observer 中的 signal write 会开启新 transactionobserver error 只写入 report不回滚。 - `tp-surface-report` 的字段只使用 transaction/surface/source/binding/object/text/property/conflict/observer/timing 通用词汇。observer 在成功 commit 且 publishing transaction 的动态范围退出后执行,因此 observer 中的 signal write 会开启新 transactionobserver error 只写入 report不回滚。
## 15. 简单与响应式便利入口 ## 15. 简单与响应式便利入口

View File

@ -177,7 +177,7 @@ Stage 2 canonical façade 是内部模型,不改变公开入口和历史返回
### tp-reactive.el响应式基础设施 ### tp-reactive.el响应式基础设施
只依赖 tp-core。文件上半部是 TP 1.0 的唯一新响应式执行语义global/buffer-scoped signal、owner+key binding identity、dynamic dependency collection、binding→binding graph、transaction-local candidate signal values、dirty dedupe/topological lazy flush、nested write stabilization、rollback、cycle path、owner disposal、variable adapter 和 public counters。正常新热路径只从 source subscriber set 到 dirty binding不读取 `buffer-list`、文本上的 `tp-name`/`tp-layers` 或 layer→buffer registry。 只依赖 tp-core。文件上半部是 TP 1.0 的唯一新响应式执行语义global/buffer-scoped signal、owner+key binding identity、dynamic dependency collection、binding→binding graph、transaction-local candidate signal values、dirty dedupe/topological lazy flush、nested write stabilization、rollback-capable transaction participant、cycle path、owner disposal、variable adapter 和 public counters。participant 在全部 surface side state 发布后、source commit 前晋升 client-owned opaque state失败时按逆序撤销它不解释 client state。正常新热路径只从 source subscriber set 到 dirty binding不读取 `buffer-list`、文本上的 `tp-name`/`tp-layers` 或 layer→buffer registry。
文件下半部仍暂存 0.3 façade 所需的变量→layer watcher、batch queue 和 layer→buffer registry以保持旧测试在 retained surface 建成前可运行;它们没有被新 graph 调用,并将在最终 cutover phase 与 `tp-render.el` 扫描路径一起删除。这个暂存区不是第二套长期 public runtime。 文件下半部仍暂存 0.3 façade 所需的变量→layer watcher、batch queue 和 layer→buffer registry以保持旧测试在 retained surface 建成前可运行;它们没有被新 graph 调用,并将在最终 cutover phase 与 `tp-render.el` 扫描路径一起删除。这个暂存区不是第二套长期 public runtime。

View File

@ -395,6 +395,72 @@
(should (equal (buffer-string) "2")) (should (equal (buffer-string) "2"))
(should (= (tp-surface-revision surface) 2))))) (should (= (tp-surface-revision surface) 2)))))
(ert-deftest tp-surface-test-transaction-participant-sees-published-state ()
"A participant promotes side state before observers run."
(tp-surface-test--with-buffer
(let (surface events)
(setq surface
(tp-surface-mount
buffer (tp-surface-test--leaf 'root "old")
(list :capability 'content
:observers
(list (lambda (_surface _report)
(push (list 'observer (buffer-string)) events))))))
(setq events nil)
(tp-with-transaction
(tp-transaction-participate
'(test . promotion)
(lambda ()
(push (list 'participant
(buffer-string)
(tp-surface-client-state surface))
events))
(lambda () (push '(rollback) events)))
(tp-surface-update
surface
(lambda (context)
(tp-object-ensure context nil 'root 'text)
(tp-surface-result-create
(tp-surface-test--leaf 'root "new") '(:generation 2)))))
(should (equal (nreverse events)
'((participant "new" (:generation 2))
(observer "new")))))))
(ert-deftest tp-surface-test-failing-participant-rolls-back-every-owner ()
"A participant failure restores surface, source, and external state."
(tp-surface-test--with-buffer
(let* ((signal (tp-signal-create 1))
(producer (tp-surface-test--producer signal))
(surface (tp-surface-mount
buffer producer '(:capability content)))
(revision (tp-surface-revision surface))
(external 'old)
rollback-ran)
(should-error
(tp-with-transaction
(tp-transaction-participate
'(test . failure)
(lambda ()
(setq external 'candidate)
(error "Participant failure"))
(lambda ()
(setq external 'old
rollback-ran t)))
(tp-signal-set signal 2)))
(should rollback-ran)
(should (eq external 'old))
(should (= (tp-signal-peek signal) 1))
(should (= (tp-surface-revision surface) revision))
(should (equal (buffer-string) "1")))))
(ert-deftest tp-surface-test-transaction-participant-key-is-unique ()
"Participant keys are unique within the outer transaction."
(should-error
(tp-with-transaction
(tp-transaction-participate 'same #'ignore #'ignore)
(tp-transaction-participate 'same #'ignore #'ignore))
: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 ()
"An equal producer result leaves the surface revision unchanged." "An equal producer result leaves the surface revision unchanged."
(tp-surface-test--with-buffer (tp-surface-test--with-buffer

View File

@ -43,6 +43,11 @@
compute equality last-value initialized-p dependencies dirty state compute equality last-value initialized-p dependencies dirty state
revision lifecycle disposed) revision lifecycle disposed)
(cl-defstruct (tp--transaction-participant
(:constructor tp--make-transaction-participant))
"One rollback-capable side-state participant in a TP transaction."
key publish rollback)
(defconst tp--reactive-absent (make-symbol "tp-reactive-absent")) (defconst tp--reactive-absent (make-symbol "tp-reactive-absent"))
(defvar tp--signal-id-counter 0) (defvar tp--signal-id-counter 0)
@ -70,6 +75,9 @@
(defvar tp--transaction-extensions nil) (defvar tp--transaction-extensions nil)
(defvar tp--transaction-counter-start nil) (defvar tp--transaction-counter-start nil)
(defvar tp--transaction-after-commit-callbacks nil) (defvar tp--transaction-after-commit-callbacks nil)
(defvar tp--transaction-participants nil)
(defvar tp--transaction-participant-keys nil)
(defvar tp--transaction-published-participants nil)
(defvar tp--current-binding nil) (defvar tp--current-binding nil)
(defvar tp--binding-compute-stack nil) (defvar tp--binding-compute-stack nil)
(defvar tp--collected-dependency-set nil) (defvar tp--collected-dependency-set nil)
@ -543,6 +551,48 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
(signal 'tp-reactive-error (list :outside-transaction function))) (signal 'tp-reactive-error (list :outside-transaction function)))
(push function tp--transaction-after-commit-callbacks)) (push function tp--transaction-after-commit-callbacks))
;;;###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."
(unless tp--transaction-active
(signal 'tp-reactive-error (list :participant-outside-transaction key)))
(unless key
(signal 'tp-reactive-error (list :participant-key key)))
(unless (functionp publish)
(signal 'wrong-type-argument (list 'functionp publish)))
(unless (functionp rollback)
(signal 'wrong-type-argument (list 'functionp rollback)))
(when (member key tp--transaction-participant-keys)
(signal 'tp-reactive-error (list :duplicate-participant-key key)))
(push (copy-tree key) tp--transaction-participant-keys)
(push (tp--make-transaction-participant
:key (copy-tree key) :publish publish :rollback rollback)
tp--transaction-participants)
key)
(defun tp--publish-transaction-participants ()
"Publish registered transaction participants in declaration order."
(dolist (participant (nreverse tp--transaction-participants))
(push participant tp--transaction-published-participants)
(funcall (tp--transaction-participant-publish participant))))
(defun tp--rollback-transaction-participants ()
"Rollback published participants and return any failures."
(let (failures)
(dolist (participant tp--transaction-published-participants)
(condition-case failure
(funcall (tp--transaction-participant-rollback participant))
(error
(push (list :key (tp--transaction-participant-key participant)
:error failure)
failures))))
(nreverse failures)))
(defun tp--dequeue-dirty-binding () (defun tp--dequeue-dirty-binding ()
"Return and remove the next queued dirty binding." "Return and remove the next queued dirty binding."
(let (binding) (let (binding)
@ -622,24 +672,34 @@ When CREATE is non-nil, install and return a fresh hash table when absent."
(make-hash-table :test #'eq)) (make-hash-table :test #'eq))
(tp--transaction-extensions (make-hash-table :test #'eq)) (tp--transaction-extensions (make-hash-table :test #'eq))
(tp--transaction-after-commit-callbacks nil) (tp--transaction-after-commit-callbacks nil)
(tp--transaction-participants nil)
(tp--transaction-participant-keys nil)
(tp--transaction-published-participants nil)
(counter-snapshot (copy-sequence tp--reactive-counters)) (counter-snapshot (copy-sequence tp--reactive-counters))
(tp--transaction-counter-start nil) (tp--transaction-counter-start nil)
success transaction-result) success transaction-result rollback-failures)
(setq tp--transaction-counter-start counter-snapshot) (setq tp--transaction-counter-start counter-snapshot)
(unwind-protect (unwind-protect
(progn (progn
(setq transaction-result (funcall function)) (setq transaction-result (funcall function))
(tp--flush-dirty-bindings) (tp--flush-dirty-bindings)
(run-hooks 'tp--transaction-publish-functions) (run-hooks 'tp--transaction-publish-functions)
(tp--publish-transaction-participants)
(tp--commit-signal-values) (tp--commit-signal-values)
(setq success t) (setq success t)
transaction-result) transaction-result)
(unless success (unless success
(let ((inhibit-quit t)) (let ((inhibit-quit t))
(setq rollback-failures
(tp--rollback-transaction-participants))
(run-hooks 'tp--transaction-rollback-functions) (run-hooks 'tp--transaction-rollback-functions)
(tp--rollback-bindings) (tp--rollback-bindings)
(setq tp--reactive-counters counter-snapshot) (setq tp--reactive-counters counter-snapshot)
(run-hooks 'tp--transaction-rollback-final-functions)))) (run-hooks 'tp--transaction-rollback-final-functions)
(when rollback-failures
(signal 'tp-reactive-error
(list :participant-rollback-failed
rollback-failures))))))
(when success (when success
(run-hooks 'tp--transaction-committed-functions) (run-hooks 'tp--transaction-committed-functions)
(setq after-commit (setq after-commit