diff --git a/CHANGELOG.md b/CHANGELOG.md index cdc6226..b329316 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,8 +9,10 @@ All notable changes to the tp library are documented here. - 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. +- Transaction protocol v2 artifacts: transaction-scoped publication batches, structured v1 participant bridges, bounded opaque final-accept markers using the closed `tp-vector-slots/v1` primitive, immutable tagged outcomes, and property/revision shadow proofs over the selected single live writer. - `tp-runtime-manifest`, advertising `tp-transaction-protocol-v1+v2` without removing the v1 participant route. +- Supported `tp-transaction-execution-route` kill switch with `structured` as + the default live authority and `v1` as the complete legacy rollback route. - 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,6 +20,15 @@ All notable changes to the tp library are documented here. ### Changed +- Structured publication batches now own the single live surface-entry loop, + participant stage/precommit/commit vector, and candidate-bound final accept. + The public `tp-transaction-participate` API remains a v1 adapter over the same + participant object; structured and v1 routes are mutually exclusive. +- Runtime manifest fields now report active structured batch execution and the + supported route list/option, single-writer invariant, and retained v1 + adapter/rollback route. The package version remains 1.0.1 because + this is the planned authority cutover within the unreleased 1.0.1 protocol, + with no public API removal or dependency change. - Package metadata now distinguishes builds that include `tp-transaction.el`; consumers can require TP 1.0.1 without an older 1.0.0 development snapshot being accepted as a complete transaction runtime. diff --git a/Makefile b/Makefile index 0e671f8..00f5517 100644 --- a/Makefile +++ b/Makefile @@ -55,6 +55,7 @@ test-m1a: test-v1: $(EMACS) -Q --batch $(LOADPATH) -l tp.el \ + --eval '(setq tp-transaction-execution-route (quote v1))' \ --eval '(setq tp--transaction-artifact-mode (quote v1))' \ $(patsubst %,-l %,$(V1_TESTS)) -f ert-run-tests-batch-and-exit diff --git a/README.md b/README.md index 3a8582f..fefcd13 100644 --- a/README.md +++ b/README.md @@ -146,12 +146,16 @@ 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's default `structured` route 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. Set `tp-transaction-execution-route` to +`v1` before an outer transaction to use the complete legacy writer; the route is +frozen for that transaction and the two writers are mutually exclusive. Shadow +mode remains read-only compatibility evidence over whichever single route was +selected; it never opens a second change group or writes a buffer twice. +Generic opaque authority markers are bounded and whitelist-validated before +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. diff --git a/README_CN.md b/README_CN.md index f19b94a..a5d8261 100644 --- a/README_CN.md +++ b/README_CN.md @@ -145,13 +145,16 @@ 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 默认由 `structured` route 从 transaction-scoped batch 的 exact entries、 +同一个冻结 participant vector 和 candidate-bound final accept 驱动唯一 live +publication;journal、surface snapshot 与 change group 仍只保留一份。outer +transaction 开始前把 `tp-transaction-execution-route` 设为 `v1`,即可使用完整 +legacy writer;route 会在该 transaction 内冻结,两条 writer 分支始终互斥。 +shadow mode 只对已选择的单一路径生成只读兼容证据,不会建立第二个 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。 ETAF 集成复用同一事务边界,只注册一个 opaque transaction participant。ETAF 先准备 immutable generation 和 Ebox candidate,再由 TP 按固定顺序完成 diff --git a/docs/API-REFERENCE.md b/docs/API-REFERENCE.md index a5ecaeb..51b355b 100644 --- a/docs/API-REFERENCE.md +++ b/docs/API-REFERENCE.md @@ -233,6 +233,8 @@ tp-binding-dispose 释放单个 binding。 (tp-transaction-active-p) +(setq tp-transaction-execution-route 'structured) ; structured 或 v1 + (tp-runtime-manifest) (tp-variable-signal 'my-variable) @@ -253,12 +255,23 @@ tp-transaction-active-p 是只读边界查询:只在当前 dynamic extent 已 对象、participant 或内部状态,调用方只能用它在 mutation 前拒绝不支持的 嵌套事务边界。 +`tp-transaction-execution-route` 是受支持的 live authority kill switch,默认 +为 `structured`,也可在 outer transaction 开始前设为 `v1`。outer transaction +会校验并冻结选择;中途修改 public option 不改变当前 transaction,只在下一次 +outer transaction 生效。`structured` 从 publication batch 的 exact entries、 +同一个 participant vector 和 candidate-bound final accept 执行;`v1` 恢复原 prepared-list、 +registration-list 与 transaction final-accept 循环。两条 route 互斥。 + tp-runtime-manifest 返回防御性 capability snapshot;本版本的 -`: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` 明确为 nil;structured-core execute owner -保留给后续受控 cutover,不在 M1a 伪造第二个 coordinator。 +`:transaction-protocol` 为 `tp-transaction-protocol-v1+v2`。structured core +现在是默认 live authority,因此 `:execution-default` 为 `structured`、 +`:execution-routes` 为 `(structured v1)`、`:route-option` 为 +`tp-transaction-execution-route`,兼容字段 `:execution-route` 与 +`:batch-execution` 也均为 `structured`,`:batch-execute` 为 non-nil。公开 +`tp-transaction-participate` 仍是 v1 adapter,manifest 以 `:v1-adapter` 和 +`:v1-rollback-route` 明确声明 adapter 与完整旧 route 均保留; +`:single-live-writer` 明确声明 route 不会双写; +`:batch-artifacts` 与 `:shadow-proof` 也保持 non-nil。 ETAF registers one opaque participant for its immutable generation and Ebox client state. Its publish is paired with rollback across TP final accept; the diff --git a/docs/API-SEMANTICS.md b/docs/API-SEMANTICS.md index bd6639e..5db443d 100644 --- a/docs/API-SEMANTICS.md +++ b/docs/API-SEMANTICS.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 group;marker 只能使用 closed `tp-vector-slots/v1` fixed-write primitive,不能注册 callback;partial 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` 允许 client side state 在 surfaces 发布后、source commit 前加入同一 rollback boundary。它保留公共 v1 调用形状,但在默认 structured route 中适配成同一个 participant record 的 `stage` capability,只执行一次。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 -result;success/failure outcome 只走内部 side channel。zero-surface 与 -output-equal operation 不创建 publication batch。 +publication batch、structured participant、final marker 与 tagged outcome 共享 +现有 journal/change-group,不复制第二份 live state。默认 `structured` route 是 +唯一 live writer:surface 从 candidate entries 执行,participant 从 candidate +绑定的同一 identity vector 执行,final accept 从 candidate binding 执行;任何 +binding/order 漂移都会 fail-fast 并回滚。把 +`tp-transaction-execution-route` 在 outer transaction 前设为 `v1` 会立即恢复 +完整 legacy prepared-list、registration-list 与 final-accept route。route 在 outer +transaction 入口冻结,中途修改 option 只影响下一次 outer transaction; +structured/v1 分支始终互斥,不双写 Buffer +或 participant state。`tp--transaction-artifact-mode` 只控制 v1/shadow 兼容证据, +不能关闭 structured candidate。`tp-with-transaction` 的返回值仍是 body result; +success/failure outcome 只走内部 side channel。zero-surface 与 output-equal +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 diff --git a/tests/tp-transaction-tests.el b/tests/tp-transaction-tests.el index 3c55e9f..fc7519c 100644 --- a/tests/tp-transaction-tests.el +++ b/tests/tp-transaction-tests.el @@ -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 v1+v2 transaction protocol and its +;; controlled structured-authority cutover. These tests deliberately exercise +;; the internal protocol: the public contract remains `tp-with-transaction' +;; body return and primary condition preservation. ;;; Code: @@ -22,8 +22,10 @@ (declare-function tp--transaction-participant-journal "tp-reactive" (value)) (declare-function tp--transaction-register-final-marker "tp-reactive" (&rest args)) +(declare-function tp-runtime-manifest "tp" ()) (defvar tp--transaction-artifact-mode) +(defvar tp-transaction-execution-route) (defvar tp--transaction-publication-batch) (defvar tp--transaction-outcome) (defvar tp--last-shadow-proof) @@ -454,7 +456,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) @@ -1145,7 +1147,8 @@ (shadow-writes 0)) (unwind-protect (progn - (let ((tp--transaction-artifact-mode 'v1)) + (let ((tp-transaction-execution-route 'v1) + (tp--transaction-artifact-mode 'v1)) (tp-surface-update v1-surface next)) (should-not tp--last-transaction-outcome) (should-not tp--last-shadow-proof) @@ -1154,7 +1157,8 @@ (cl-incf shadow-writes) (funcall writer prepared)))) (let ((tp--transaction-artifact-mode 'shadow)) - (tp-surface-update shadow-surface next))) + (let ((tp-transaction-execution-route 'v1)) + (tp-surface-update shadow-surface next)))) (should (= shadow-writes 1)) (should (tp-committed-success-outcome-p tp--last-transaction-outcome)) @@ -1172,6 +1176,223 @@ (when (buffer-live-p v1-buffer) (kill-buffer v1-buffer)) (when (buffer-live-p shadow-buffer) (kill-buffer shadow-buffer))))) +(ert-deftest tp-transaction-test-structured-and-v1-routes-are-equivalent () + "Structured and v1 authorities commit equivalent state with one write each." + (let* ((structured-buffer (generate-new-buffer " *tp-route-structured*")) + (v1-buffer (generate-new-buffer " *tp-route-v1*")) + (initial (tp-transaction-test--leaf "old")) + (next (tp-transaction-test--leaf "new")) + (structured (tp-surface-mount structured-buffer initial + '(:capability content))) + (v1 (tp-surface-mount v1-buffer initial '(:capability content))) + (writer (symbol-function 'tp--publish-one-surface)) + (writes (make-hash-table :test #'eq))) + (unwind-protect + (cl-letf (((symbol-function 'tp--publish-one-surface) + (lambda (prepared) + (let ((surface (tp--prepared-surface-surface prepared))) + (puthash surface (1+ (gethash surface writes 0)) writes)) + (funcall writer prepared)))) + (let ((tp-transaction-execution-route 'structured) + (tp--transaction-artifact-mode 'v1)) + (tp-surface-update structured next)) + (let ((tp-transaction-execution-route 'v1) + (tp--transaction-artifact-mode 'v1)) + (tp-surface-update v1 next)) + (should (= (gethash structured writes 0) 1)) + (should (= (gethash v1 writes 0) 1)) + (should (= (tp-surface-revision structured) (tp-surface-revision v1))) + (should (equal-including-properties + (with-current-buffer structured-buffer (buffer-string)) + (with-current-buffer v1-buffer (buffer-string))))) + (when (buffer-live-p structured-buffer) (kill-buffer structured-buffer)) + (when (buffer-live-p v1-buffer) (kill-buffer v1-buffer))))) + +(ert-deftest tp-transaction-test-final-accept-source-follows-route () + "Structured validates candidate final accept; v1 shadow uses legacy binding." + (let* ((structured-buffer (generate-new-buffer " *tp-final-structured*")) + (v1-buffer (generate-new-buffer " *tp-final-v1*")) + (initial (tp-transaction-test--leaf "old")) + (next (tp-transaction-test--leaf "new")) + (structured (tp-surface-mount structured-buffer initial + '(:capability content))) + (v1 (tp-surface-mount v1-buffer initial '(:capability content))) + (sync (symbol-function 'tp--transaction-sync-publication-batch))) + (unwind-protect + (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))))) + (let ((tp-transaction-execution-route 'structured)) + (should-error (tp-surface-update structured next) + :type 'tp-publication-binding-error)) + (with-current-buffer structured-buffer + (should (equal (buffer-string) "old"))) + (let ((tp-transaction-execution-route 'v1) + (tp--transaction-artifact-mode 'shadow)) + (tp-surface-update v1 next)) + (with-current-buffer v1-buffer + (should (equal (buffer-string) "new"))) + (should (tp-committed-success-outcome-p tp--last-transaction-outcome))) + (when (buffer-live-p structured-buffer) (kill-buffer structured-buffer)) + (when (buffer-live-p v1-buffer) (kill-buffer v1-buffer))))) + +(ert-deftest tp-transaction-test-default-execution-route-is-structured () + "The supported live execution route defaults to the structured core." + (should (eq (default-value 'tp-transaction-execution-route) 'structured))) + +(ert-deftest tp-transaction-test-structured-batch-owns-surface-stage-once () + "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)))) + (let ((tp-transaction-execution-route 'structured) + (tp--transaction-artifact-mode 'v1)) + (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-v1-adapter-stages-once-from-batch () + "The public v1 adapter 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 + 'public-v1 + (lambda () + (cl-incf stages) + (setq captured tp--transaction-publication-batch + participant + (aref (tp-publication-batch-candidate-participants + tp--transaction-publication-batch) + 0))) + #'ignore) + (tp-signal-set source 2)) + (should (= stages 1)) + (should (tp-publication-batch-candidate-p captured)) + (should (eq (tp--transaction-participant-protocol participant) + 'v1-bridge)) + (should (eq (tp--transaction-participant-state participant) 'committed))))) + +(ert-deftest tp-transaction-test-v1-kill-switch-preserves-legacy-authority () + "The v1 kill switch uses legacy loops without a structured batch writer." + (tp-transaction-test--with-surface (buffer _surface source) + (let ((tp-transaction-execution-route 'v1) + (tp--transaction-artifact-mode 'v1) + (stage-seam-calls 0) + (participant-calls 0) + (seam (symbol-function 'tp--publication-batch-execute-stage))) + (cl-letf (((symbol-function 'tp--publication-batch-execute-stage) + (lambda (candidate) + (cl-incf stage-seam-calls) + (funcall seam candidate)))) + (should + (eq (tp-with-transaction + (tp-transaction-participate + 'legacy (lambda () (cl-incf participant-calls)) #'ignore) + (tp-signal-set source 2) + 'legacy-result) + 'legacy-result))) + (should (= stage-seam-calls 0)) + (should (= participant-calls 1)) + (should-not tp--last-transaction-outcome)))) + +(ert-deftest tp-transaction-test-invalid-route-fails-before-body-mutation () + "An invalid route is rejected before the transaction body can mutate state." + (let ((tp-transaction-execution-route 'invalid) + (body-calls 0)) + (should-error + (tp-with-transaction (cl-incf body-calls)) + :type 'tp-transaction-contract-error) + (should (= body-calls 0)))) + +(ert-deftest tp-transaction-test-route-change-applies-to-next-outer-transaction () + "An active outer transaction keeps its snapshot; the next uses the new route." + (tp-transaction-test--with-surface (buffer surface source) + (let ((revision (tp-surface-revision surface)) + (tp-transaction-execution-route 'structured) + (tp--transaction-artifact-mode 'v1) + (stage (symbol-function 'tp--publication-batch-execute-stage)) + (writer (symbol-function 'tp--publish-one-surface)) + (stage-calls 0) + (writer-calls 0) + first-outcome) + (cl-letf (((symbol-function 'tp--publication-batch-execute-stage) + (lambda (candidate) + (cl-incf stage-calls) + (funcall stage candidate))) + ((symbol-function 'tp--publish-one-surface) + (lambda (prepared) + (cl-incf writer-calls) + (funcall writer prepared)))) + (tp-with-transaction + (tp-signal-set source 2) + (setq tp-transaction-execution-route 'v1)) + (setq first-outcome tp--last-transaction-outcome) + (tp-signal-set source 3)) + (should (tp-committed-success-outcome-p first-outcome)) + (should-not tp--last-transaction-outcome) + (should (= stage-calls 1)) + (should (= writer-calls 2)) + (should (= (tp-signal-peek source) 3)) + (should (= (tp-surface-revision surface) (+ revision 2))) + (with-current-buffer buffer + (should (equal (buffer-string) "3")))))) + +(ert-deftest tp-transaction-test-batch-rejects-foreign-stage-capability () + "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 'late #'ignore #'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." (tp-transaction-test--with-surface (buffer _surface source) @@ -1366,8 +1587,8 @@ (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." +(ert-deftest tp-transaction-test-manifest-advertises-structured-cutover () + "The manifest advertises structured authority and the retained v1 route." (should (eq tp-transaction-protocol 'tp-transaction-protocol-v1+v2)) (let ((manifest (tp-runtime-manifest))) @@ -1375,14 +1596,30 @@ (should (eq (plist-get manifest :transaction-protocol) 'tp-transaction-protocol-v1+v2)) (should (plist-get manifest :batch-artifacts)) - (should (eq (plist-get manifest :batch-execution) 'v1-bridge)) - (should-not (plist-get manifest :batch-execute)) + (should (eq (plist-get manifest :execution-route) 'structured)) + (should (eq (plist-get manifest :execution-default) 'structured)) + (should (equal (plist-get manifest :execution-routes) + '(structured v1))) + (should (eq (plist-get manifest :route-option) + 'tp-transaction-execution-route)) + (should (eq (plist-get manifest :batch-execution) 'structured)) + (should (plist-get manifest :batch-execute)) + (should (plist-get manifest :v1-adapter)) + (should (plist-get manifest :v1-rollback-route)) + (should (plist-get manifest :single-live-writer)) (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)))) + (setcar (plist-get manifest :execution-routes) 'mutated) + (setf (plist-get manifest :transaction-protocol) 'mutated + (plist-get manifest :execution-route) 'v1 + (plist-get manifest :batch-execute) nil) + (let ((fresh (tp-runtime-manifest))) + (should (eq (plist-get fresh :transaction-protocol) + 'tp-transaction-protocol-v1+v2)) + (should (eq (plist-get fresh :execution-route) 'structured)) + (should (equal (plist-get fresh :execution-routes) '(structured v1))) + (should (plist-get fresh :batch-execute))))) (provide 'tp-transaction-tests) diff --git a/tp-reactive.el b/tp-reactive.el index 49e5016..6127ee5 100644 --- a/tp-reactive.el +++ b/tp-reactive.el @@ -94,6 +94,8 @@ (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-frozen-execution-route nil) (defvar tp--transaction-final-marker-registry nil) (defvar tp--transaction-final-marker-owner-keys nil) (defvar tp--transaction-final-marker-count 0) @@ -127,7 +129,16 @@ (defvar tp--transaction-committed-functions nil) (defvar tp--transaction-artifact-mode 'shadow - "Internal artifact route; the live writer remains the v1 coordinator.") + "Internal v1/shadow compatibility evidence mode.") + +;;;###autoload +(defcustom tp-transaction-execution-route 'structured + "Live transaction execution authority. +`structured' executes package-owned batch and participant capabilities. +`v1' immediately restores the legacy prepared-list and participant-list loops." + :type '(choice (const :tag "Structured batch" structured) + (const :tag "Legacy v1" v1)) + :group 'tp) (defvar tp--transaction-participant-precommit-allowed-functions nil "Declared internal structured-participant precommit validators.") @@ -660,7 +671,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 PARTICIPANT once for structured and legacy transaction views." (unless tp--transaction-active (signal 'tp-reactive-error (list :participant-outside-transaction @@ -722,7 +733,7 @@ structured view over the same participant object." (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 @@ -745,6 +756,39 @@ participant's opaque owner-local state." (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." (let (failures) @@ -772,6 +816,18 @@ participant's opaque owner-local state." (list :invalid-participant-precommit function))) (funcall function)))) +(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-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-transaction-participants () "Commit participant states and queue their contained after-commit work." (dolist (participant (tp--transaction-participants-in-registration-order)) @@ -781,6 +837,17 @@ participant's opaque owner-local state." (tp--transaction-participant-after-commit participant))) (tp--enqueue-after-commit 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." (let (binding) @@ -875,6 +942,26 @@ participant's opaque owner-local state." (_ (signal 'tp-transaction-contract-error (list :artifact-mode tp--transaction-artifact-mode))))) +(defun tp--transaction-validate-execution-route (route) + "Return supported execution ROUTE or signal before transaction mutation." + (unless (memq route '(structured v1)) + (signal 'tp-transaction-contract-error (list :execution-route route))) + route) + +(defun tp--transaction-current-execution-route () + "Return the validated route frozen at outer transaction entry." + (tp--transaction-validate-execution-route + tp--transaction-frozen-execution-route)) + +(defun tp--transaction-structured-route-p () + "Return non-nil when the frozen live route is `structured'." + (eq (tp--transaction-current-execution-route) 'structured)) + +(defun tp--transaction-publication-candidate-enabled-p () + "Return non-nil when this transaction must build a publication candidate." + (or (tp--transaction-structured-route-p) + (tp--transaction-v2-artifacts-enabled-p))) + (defun tp--transaction-current-outcome-cell () "Return the active transaction's caller-retainable one-slot outcome cell." (unless tp--transaction-active @@ -913,22 +1000,23 @@ 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) + (when (tp--transaction-publication-candidate-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)) + 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) @@ -1146,7 +1234,18 @@ through TP's closed marker-operation whitelist." (unwind-protect (progn (tp--transaction-apply-final-markers) - (funcall tp--transaction-final-accept-function) + (if (and (tp--transaction-structured-route-p) + 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,7 +1267,7 @@ 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." + "Compare structured artifacts with the selected single live result for PHASE." (when (and tp--transaction-publication-batch (tp--transaction-v2-artifacts-enabled-p)) (let ((ok t) results outcome-equivalent) @@ -1407,7 +1506,10 @@ the primary condition data." "Call FUNCTION in one atomic signal and binding transaction." (if tp--transaction-active (funcall function) - (let (after-commit result + (let ((frozen-route + (tp--transaction-validate-execution-route + tp-transaction-execution-route)) + after-commit result (tp--transaction-contained-failures nil)) (setq tp--last-transaction-outcome nil tp--last-shadow-proof nil) @@ -1435,6 +1537,8 @@ 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-frozen-execution-route frozen-route) (tp--transaction-final-marker-registry (make-vector tp--final-marker-max-count nil)) (tp--transaction-final-marker-owner-keys @@ -1460,13 +1564,21 @@ the primary condition data." (tp--transaction-enter-phase 'recompute) (tp--flush-dirty-bindings) (tp--transaction-enter-phase 'publication) + (tp--transaction-current-execution-route) + (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) + (if (tp--transaction-structured-route-p) + (tp--stage-structured-transaction-participants) + (tp--publish-transaction-participants)) (tp--transaction-batch-transition 'precommit) (tp--transaction-enter-phase 'precommit) - (tp--run-transaction-participant-precommits) + (if (tp--transaction-structured-route-p) + (tp--run-structured-transaction-participant-precommits) + (tp--run-transaction-participant-precommits)) (tp--run-transaction-precommit-functions) (tp--transaction-freeze-final-markers) (tp--transaction-sync-publication-batch) @@ -1491,7 +1603,9 @@ the primary condition data." tp--transaction-final-accept-function))) (tp--transaction-run-final-accept) (setq success t) - (tp--commit-transaction-participants) + (if (tp--transaction-structured-route-p) + (tp--commit-structured-transaction-participants) + (tp--commit-transaction-participants)) (tp--transaction-run-shadow-proof 'commit) (when quit-flag (setq pending-quit t diff --git a/tp-surface.el b/tp-surface.el index 656f93f..9b3f6b8 100644 --- a/tp-surface.el +++ b/tp-surface.el @@ -3500,9 +3500,9 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback." :output (tp--shadow-surface-output surface))) (defun tp--surface-shadow-target-entry - (prepared snapshot journals views batch-id) + (prepared snapshot journals views batch-id mapping-generation) "Build a BATCH-ID target view over PREPARED and SNAPSHOT. -JOURNALS and VIEWS are exact references to the existing v1 rollback state." +JOURNALS and VIEWS are exact references to the shared rollback state." (let* ((prepared (tp--assign-prepared-mount-ids prepared)) (surface (tp--prepared-surface-surface prepared)) (buffer (tp--surface-buffer surface)) @@ -3561,7 +3561,7 @@ JOURNALS and VIEWS are exact references to the existing v1 rollback state." :client-state (tp--prepared-surface-client-state prepared) :rollback-snapshot (vector prepared snapshot journals views) :authority-token (make-symbol "tp-publication-entry-authority") - :mapping-generation tp--surface-transaction-id + :mapping-generation mapping-generation :shadow-expected expected :shadow-validator (lambda (_entry phase) @@ -3575,7 +3575,7 @@ JOURNALS and VIEWS are exact references to the existing v1 rollback state." :expected target :actual actual)))))) (defun tp--surface-shadow-target-entries - (prepared snapshots journals views batch-id) + (prepared snapshots journals views batch-id mapping-generation) "Return BATCH-ID entries for PREPARED using SNAPSHOTS, JOURNALS, and VIEWS." (mapcar (lambda (candidate) @@ -3583,11 +3583,71 @@ JOURNALS and VIEWS are exact references to the existing v1 rollback state." (unless snapshot (signal 'tp-surface-error (list :missing-shadow-snapshot candidate))) (tp--surface-shadow-target-entry - candidate snapshot journals views batch-id))) + candidate snapshot journals views batch-id mapping-generation))) prepared)) +(defun tp--surface-validate-publication-entry (candidate entry) + "Return ENTRY's exact prepared binding after validating CANDIDATE authority." + (let* ((rollback (tp-publication-target-entry-rollback-snapshot entry)) + (prepared (and (vectorp rollback) (= (length rollback) 4) + (aref rollback 0))) + (snapshot (and prepared (aref rollback 1))) + (surface (and (tp--prepared-surface-p prepared) + (tp--prepared-surface-surface prepared)))) + (unless + (and surface snapshot + (tp--publication-target-entry-bound-p + entry + (tp-publication-batch-candidate-transaction-id candidate) + (tp-publication-batch-candidate-id candidate)) + (equal (tp-publication-target-entry-surface-id entry) + (tp--surface-id surface)) + (eq (tp-publication-target-entry-buffer entry) + (tp--surface-buffer surface)) + (= (tp-publication-target-entry-old-revision entry) + (tp--surface-snapshot-revision snapshot)) + (= (tp-publication-target-entry-new-revision entry) + (1+ (tp--surface-snapshot-revision snapshot))) + (eq (tp-publication-target-entry-plan entry) + (tp--prepared-surface-plan prepared)) + (eq (tp-publication-target-entry-ledger entry) + (tp--prepared-surface-ledger-specs prepared)) + (eq (tp-publication-target-entry-objects entry) + (tp--prepared-surface-objects prepared)) + (eq (tp-publication-target-entry-ranges entry) + (tp--prepared-surface-mount-specs prepared)) + (equal (tp-publication-target-entry-client-state entry) + (tp--prepared-surface-client-state prepared)) + (= (tp-publication-target-entry-mapping-generation entry) + tp--surface-transaction-id)) + (signal 'tp-publication-binding-error + (list :prepared-entry entry prepared))) + prepared)) + +(defun tp--surface-stage-publication-entries (candidate) + "Publish exactly CANDIDATE's entry-bound prepared surfaces once each." + (let ((generation + (tp-publication-target-entry-mapping-generation + (car (tp-publication-batch-candidate-entries candidate))))) + (unless (= generation (1+ tp--surface-transaction-id)) + (signal 'tp-publication-binding-error + (list :mapping-generation generation + tp--surface-transaction-id))) + (setq tp--surface-transaction-id generation)) + (dolist (entry (tp-publication-batch-candidate-entries candidate)) + (let ((prepared (tp--surface-validate-publication-entry candidate entry))) + (tp--publish-one-surface prepared) + (tp--surface-record-publication-operation-counts prepared)))) + +(defun tp--surface-stage-v1-prepared (prepared next-generation) + "Publish legacy PREPARED list after exposing NEXT-GENERATION." + (setq tp--surface-transaction-id next-generation) + (dolist (candidate prepared) + (tp--publish-one-surface candidate) + (tp--surface-record-publication-operation-counts candidate))) + (defun tp--surface-record-publication-operation-counts (prepared) - "Record PREPARED's actual v1 report counts into its exact batch entry." + "Record PREPARED's actual live report counts into its exact batch entry." (when tp--transaction-publication-batch (let* ((surface (tp--prepared-surface-surface prepared)) (entry @@ -3620,7 +3680,8 @@ JOURNALS and VIEWS are exact references to the existing v1 rollback state." (let* ((buffers (tp--prepared-buffers prepared)) (journals (tp--capture-property-journals prepared)) (views (tp--capture-view-state buffers)) - snapshots group) + snapshots group + (next-generation (1+ tp--surface-transaction-id))) (puthash 'changed prepared state) (puthash 'journals journals state) (puthash 'views views state) @@ -3630,19 +3691,20 @@ JOURNALS and VIEWS are exact references to the existing v1 rollback state." (puthash 'change-group group state) (puthash 'surface-transaction-id-before tp--surface-transaction-id state) - (cl-incf tp--surface-transaction-id) - (when (tp--transaction-v2-artifacts-enabled-p) + (when (tp--transaction-publication-candidate-enabled-p) (let* ((batch-id (tp--next-publication-batch-id)) (entries (tp--surface-shadow-target-entries - prepared snapshots journals views batch-id))) + prepared snapshots journals views batch-id + next-generation))) (tp--transaction-begin-publication-batch - batch-id entries state) + batch-id entries state 'tp--surface-stage-publication-entries) (tp--transaction-batch-transition 'staged))) (let ((tp--surface-publishing t)) - (dolist (candidate prepared) - (tp--publish-one-surface candidate) - (tp--surface-record-publication-operation-counts candidate))))))) + (if (tp--transaction-structured-route-p) + (tp--publication-batch-execute-stage + tp--transaction-publication-batch) + (tp--surface-stage-v1-prepared prepared next-generation))))))) (defun tp--surface-precommit-step (step state) "Report precommit STEP for transaction STATE." diff --git a/tp-transaction.el b/tp-transaction.el index 05b8d0f..793395c 100644 --- a/tp-transaction.el +++ b/tp-transaction.el @@ -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,12 @@ ;;; 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 default structured route executes the package-owned entry-stage +;; capability stored in a batch candidate; the retained v1 route bypasses that +;; capability. 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: @@ -48,6 +50,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.") @@ -119,7 +125,7 @@ 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) @@ -222,7 +228,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 +236,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 +278,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 +304,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) diff --git a/tp.el b/tp.el index ec249b7..3885f15 100644 --- a/tp.el +++ b/tp.el @@ -69,8 +69,15 @@ `(:package tp :version "1.0.1" :transaction-protocol ,tp-transaction-protocol :batch-artifacts t - :batch-execution v1-bridge - :batch-execute nil + :execution-route structured + :execution-default structured + :execution-routes (structured v1) + :route-option tp-transaction-execution-route + :batch-execution structured + :batch-execute t + :v1-adapter t + :v1-rollback-route t + :single-live-writer t :shadow-proof t :final-marker-operation tp-vector-slots/v1) "Immutable package capability facts for cross-package compatibility checks.")