geekinney/etaf
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b631ffa9f1
etaf/etaf-runtime.el
Kinneyzhang b631ffa9f1 fix(runtime): close postcommit fault gaps
2026-09-01 03:56:37 +08:00

6637 lines
317 KiB
EmacsLisp
Raw Blame History

;;; etaf-runtime.el --- ETAF retained runtime and publication loop -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Runtime is the owner of mounted lifetime, retained Component instances,
;; reactive render effects, and the Ebox commit boundary. It does not know
;; Ebox's private tree representation; Renderer is the only lowering port.
;;; Code:
(require 'cl-lib)
(require 'ebox)
(require 'etaf-view)
(require 'etaf-component)
(require 'etaf-scheduler)
(require 'etaf-reactive)
(require 'etaf-generation)
(require 'etaf-host)
(require 'etaf-retirement)
(require 'etaf-render-port)
(require 'etaf-renderer)
(require 'etaf-context)
(require 'etaf-behavior)
(require 'etaf-observer)
(declare-function etaf--render-value-list "etaf-renderer" (value path))
(declare-function etaf--apply-inline-style-rules "etaf-renderer" (node styles &optional root-p))
(declare-function etaf--generated-host-ref
"etaf-renderer" (props path &optional site-token))
(declare-function etaf--ebox-properties
"etaf-renderer" (props path &optional site-token))
(declare-function etaf--lower-resolved-semantic-host
"etaf-renderer" (name props content children range-child-p))
(declare-function etaf--ebox-forest-root
"etaf-renderer" (nodes source-identity))
(declare-function etaf--ebox-import-input "etaf-renderer" (input))
(declare-function etaf--ebox-input-for-nodes "etaf-renderer" (nodes))
(declare-function etaf-events-enable-input "etaf-events" (buffer))
(declare-function etaf-events-disable-input "etaf-events" (buffer))
(declare-function ebox-range-ref-present-p "ebox" (buffer-or-name range-ref))
(declare-function ebox-call-with-render-burst
"ebox-buffer-backend" (function &rest arguments))
(declare-function tp-paint-slot-create "tp-style" (spec))
(declare-function tp-paint-slot-installed-p "tp-style" (slot))
(declare-function tp-paint-slot-spec "tp-style" (slot))
(declare-function tp-paint-slot-apply-updates "tp-style" (buffer updates))
(declare-function tp-paint-slot-rollback-updates "tp-style" (journal))
(defvar etaf--render-runtime)
(defvar etaf--render-style-stack)
(defvar etaf--render-parent-style-stack)
(defvar etaf--current-context)
(defvar gcs-done)
(defvar gc-elapsed)
(define-error 'etaf-runtime-error "ETAF runtime error")
(cl-defstruct (etaf--component-instance
(:constructor etaf--component-instance-create))
"Retained state and lifecycle for one logical Component call."
spec
identity
scope
state
(setup-complete-p nil)
context
mounted-hooks
updated-hooks
unmounted-hooks
resource-key
(mounted-p nil))
(cl-defstruct (etaf--semantic-component
(:constructor etaf--semantic-component-create))
semantic-id identity input-effect-id effect-id resource-key props attrs slots
input-props input-attrs input-slots output-signature artifact-key
path caller-style-stack input-deps deps
parent-id caller-component-id child-ids raw-slot-reader-p
publication-kind output-range-id
context-frame context-deps
(composition-version 0))
(cl-defstruct (etaf--host-property-binding
(:constructor etaf--host-property-binding-create))
"One independently reactive, identity-neutral Host property."
property expression)
(cl-defstruct (etaf--semantic-host (:constructor etaf--semantic-host-create))
semantic-id identity parent-id component-id child-ids host-ref key name effect-id
property-bindings theme-bindings deps context-deps
base-props props-signature content content-parts path site-token style-identity
(composition-version 0))
(cl-defstruct (etaf--semantic-range (:constructor etaf--semantic-range-create))
semantic-id identity effect-id kind parent-id component-id token range-ref
path caller-style-stack output-signature deps artifact-key item-root-ids
item-identity-index context-deps
keyed-context-signature keyed-item-signatures keyed-item-root-id-index
keyed-item-node-span-index keyed-key-order
(composition-version 0))
(cl-defstruct (etaf--semantic-inline-range
(:constructor etaf--semantic-inline-range-create))
semantic-id identity effect-id parent-id component-id token path
surface-properties output deps context-deps (composition-version 0))
(cl-defstruct (etaf--semantic-slot-range
(:constructor etaf--semantic-slot-range-create))
semantic-id identity effect-id parent-id owner-component-id
consumer-component-id token name range-ref path style-stack
output-signature deps artifact-key item-root-ids item-identity-index
context-deps
(composition-version 0))
(cl-defstruct (etaf--semantic-root (:constructor etaf--semantic-root-create))
"Immutable semantic Root owner stored at generation node zero."
semantic-id effect-id input-signature deps child-ids)
(cl-defstruct (etaf--generation-effect
(:constructor etaf--generation-effect-create))
"Immutable generation scheduling target."
effect-id kind semantic-id deps target)
(cl-defstruct (etaf--contribution-index
(:constructor etaf--contribution-index-create))
"Persistent generation contribution delta rooted at BASE."
base handlers host-props contexts themes behaviors context-consumers lifecycle
host-removals semantic-removals (depth 1))
(defcustom etaf-generation-index-max-depth 16
"Maximum contribution-delta depth retained by one Runtime generation.
Local publications keep point-sized deltas, but an unbounded base chain makes
handler, Context, Theme, Behavior, and lifecycle reads progressively slower.
ETAF periodically flattens the effective contribution snapshot at this depth;
the operation preserves committed values and removal semantics."
:type 'positive-integer
:group 'etaf)
(cl-defstruct (etaf--generation-participant
(:constructor etaf--generation-participant-create))
runtime semantic-candidate paint-journal (state 'unpublished))
(cl-defstruct (etaf-generation
(:constructor etaf--generation-create))
generation-id root-semantic-id semantic-nodes effect-map
source-effects effect-sources parent-table children-table
resource-membership identity-index indexes)
(defun etaf--semantic-parent-id (semantic)
"Return SEMANTIC's retained parent id, or nil for Root."
(cond
((etaf--semantic-component-p semantic)
(etaf--semantic-component-parent-id semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-parent-id semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-parent-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-parent-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-parent-id semantic))))
(defun etaf--semantic-child-ids (semantic)
"Return SEMANTIC's immutable direct child ids."
(cond
((etaf--semantic-root-p semantic)
(etaf--semantic-root-child-ids semantic))
((etaf--semantic-component-p semantic)
(etaf--semantic-component-child-ids semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-child-ids semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-item-root-ids semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-item-root-ids semantic))))
(defun etaf--generation-parent-id (generation semantic-id)
"Return SEMANTIC-ID's parent directly from GENERATION's semantic node."
(etaf--semantic-parent-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation) semantic-id)))
(defun etaf--generation-child-ids (generation semantic-id)
"Return SEMANTIC-ID's children directly from GENERATION's semantic node."
(etaf--semantic-child-ids
(etaf--pvec-get (etaf-generation-semantic-nodes generation) semantic-id)))
(cl-defstruct (etaf--pvec-node (:constructor etaf--pvec-node-create))
"One sparse immutable 32-way generation index node."
children value)
(cl-defstruct (etaf--generation-metrics
(:constructor etaf--generation-metrics-create))
(node-visits 0) (node-copies 0) (effect-visits 0) (source-visits 0))
(defun etaf--pvec-get (root id &optional metrics kind)
"Return integer ID value from sparse ROOT, recording METRICS KIND visits."
(let ((node root) (level 6))
(while (and node (>= level 0))
(when metrics
(cl-incf (etaf--generation-metrics-node-visits metrics))
(pcase kind
('effect (cl-incf (etaf--generation-metrics-effect-visits metrics)))
('source (cl-incf (etaf--generation-metrics-source-visits metrics)))))
(setq node (and (etaf--pvec-node-children node)
(aref (etaf--pvec-node-children node)
(logand 31 (ash id (* -5 level)))))
level (1- level)))
(and node (etaf--pvec-node-value node))))
(defun etaf--pvec-put (root id value &optional metrics)
"Return sparse ROOT with ID set to VALUE, recording copies in METRICS."
(cl-labels
((put (node level)
(when metrics
(cl-incf (etaf--generation-metrics-node-visits metrics))
(cl-incf (etaf--generation-metrics-node-copies metrics)))
(if (< level 0)
(etaf--pvec-node-create :value value)
(let* ((children (copy-sequence
(or (and node (etaf--pvec-node-children node))
(make-vector 32 nil))))
(slot (logand 31 (ash id (* -5 level)))))
(aset children slot (put (aref children slot) (1- level)))
(etaf--pvec-node-create :children children)))))
(put root 6)))
(defun etaf--pvec-put-many (root entries &optional metrics)
"Return sparse ROOT after applying ENTRIES in one persistent batch.
ENTRIES is a list of cons cells `(ID . VALUE)'. METRICS, when non-nil, records
physical trie node visits/copies. Updates sharing a trie path
are grouped before copying, so each touched vector node is copied once per
batch rather than once per entry. Later entries for the same ID win, matching
the sequential `etaf--pvec-put' contract."
(if (null entries)
root
(let ((values (make-hash-table :test #'eql))
(ids nil)
(missing (make-symbol "etaf-pvec-missing")))
(dolist (entry entries)
(let ((id (car entry)))
(when (eq (gethash id values missing) missing)
(push id ids))
(puthash id (cdr entry) values)))
(setq ids (nreverse ids))
(cl-labels
((put-batch (node level batch)
(when metrics
(cl-incf (etaf--generation-metrics-node-visits metrics))
(cl-incf (etaf--generation-metrics-node-copies metrics)))
(if (< level 0)
(etaf--pvec-node-create
:value (gethash (car batch) values))
(let ((children
(copy-sequence
(or (and node (etaf--pvec-node-children node))
(make-vector 32 nil))))
(groups (make-hash-table :test #'eql)))
(dolist (id batch)
(let ((slot (logand 31 (ash id (* -5 level)))))
(puthash slot (cons id (gethash slot groups)) groups)))
(maphash
(lambda (slot group)
(aset children slot
(put-batch
(aref children slot)
(1- level)
group)))
groups)
(etaf--pvec-node-create :children children)))))
(put-batch root 6 ids)))))
(cl-defstruct (etaf-runtime
(:constructor etaf--runtime-create))
"Mounted ETAF application runtime."
buffer
root-view
root-node
scope
scheduler-context
root-effect-id
root-range-id
candidate-root-deps
root-view-cache
root-dirty-p
instances
resource-registry
mount-epoch
host-authority
next-resource-id
next-effect-id
next-semantic-id
generation-authority
artifact-registry
candidate-artifacts
candidate-effects
candidate-source-deltas
route-token
route-sources
dirty-effect-ids
dirty-effect-queue
handlers
host-props
theme-paint-slots
candidate-theme-paint-updates
focus-ref
behaviors
candidate-live
candidate-semantic-nodes
candidate-component-envs
candidate-graph-nodes
candidate-identity-entries
candidate-graph-children
candidate-graph-child-tails
candidate-removed-semantic-ids
candidate-removed-effect-ids
candidate-removed-host-refs
candidate-rendered-identities
candidate-updated-component-identities
candidate-generation-metrics
candidate-full-rebuild-p
range-artifact-registry
candidate-range-artifacts
candidate-invalidated-artifact-keys
candidate-inline-host-ids
candidate-eager-range-changes
candidate-handlers
candidate-host-props
candidate-behaviors
behavior-resource-keys
candidate-behavior-resource-keys
candidate-created
candidate-old-instances
(mounted-p t)
flushing-p
pending-p
diagnostics
retirement-journals
observer
(next-operation-id 0)
(next-semantic-candidate-id 0)
(event-depth 0)
dirty-effect-queue-tail)
(defcustom etaf-generation-mirror-route 'project
"Compatibility mirror route used after a committed generation changes.
`legacy' preserves incremental Runtime table updates, `project' rebuilds exact
mirrors from the committed generation, and `shadow' runs legacy updates before
checking them against a fresh generation projection."
:type '(choice (const legacy) (const project) (const shadow))
:group 'etaf)
(defun etaf--runtime-generation-authority (runtime)
"Return RUNTIME's generation authority, creating its empty owner if needed."
(or (etaf-runtime-generation-authority runtime)
(setf (etaf-runtime-generation-authority runtime)
(etaf-generation-authority-create))))
(defun etaf-runtime-current-generation (runtime)
"Return RUNTIME's uniquely authoritative committed generation."
(let ((authority (etaf--runtime-generation-authority runtime)))
(unless (and (integerp (etaf-generation-authority-token authority))
(>= (etaf-generation-authority-token authority) 0)
(etaf-generation-store-versions-p
(etaf-generation-authority-store-versions authority)))
(signal 'etaf-generation-error
(list :invalid-committed-authority authority)))
(etaf-generation-authority-current authority)))
(defun etaf-runtime-generation-token (runtime)
"Return RUNTIME's committed semantic generation token."
(etaf-generation-authority-token
(etaf--runtime-generation-authority runtime)))
(defun etaf-runtime-store-versions (runtime)
"Return RUNTIME's immutable committed store-version snapshot."
(etaf-generation-authority-store-versions
(etaf--runtime-generation-authority runtime)))
(defun etaf-runtime--set-current-generation (runtime generation)
"Set RUNTIME's compatibility generation pointer to GENERATION."
(etaf-generation-authority-set-current
(etaf--runtime-generation-authority runtime) generation))
(gv-define-simple-setter etaf-runtime-current-generation
etaf-runtime--set-current-generation)
(defun etaf--theme-paint-face-spec (property value)
"Return PROPERTY's TP face spec for resolved paint VALUE, or nil."
(pcase property
(:color (and value (list :foreground value)))
((or :bgcolor :background-color)
(and value (list :background value)))
(:border-top-color (list :overline (or value t)))
(:border-bottom-color
(list :underline
(append (list :position t) (and value (list :color value)))))
((or :border-left-color :border-right-color)
(if value (list :background value) (list :inverse-video t)))
(:border-color
(if value
(list :background value :overline value
:underline (list :position t :color value))
(list :inverse-video t :overline t
:underline (list :position t))))
(_ nil)))
(defun etaf--runtime-theme-paint-property-p (property)
"Return non-nil when PROPERTY has a geometry-neutral TP paint slot."
(memq property '(:color :bgcolor :background-color
:border :border-color
:border-top-color :border-bottom-color
:border-left-color :border-right-color)))
(defun etaf--theme-border-paint-parts (value)
"Return `(SHAPE COLOR)' for a stable color-only Ebox border VALUE."
(condition-case nil
(let* ((declarations
(ebox-style-compile-declarations (list :border value) t))
(width (plist-get declarations 'ebox/border-top-width))
(style (plist-get declarations 'ebox/border-top-style))
(color (plist-get declarations 'ebox/border-top-color)))
(if (stringp value)
(list 'implicit color)
(list (list width style) color)))
(error nil)))
(defun etaf--runtime-theme-paint-value
(runtime property token source resolved)
"Return RUNTIME's stable paint slot for PROPERTY TOKEN from SOURCE.
RESOLVED is the current projected paint value."
(if (not (and runtime
(etaf--runtime-theme-paint-property-p property)
(or (etaf-ref-p source) (etaf-computed-p source))))
resolved
(let* ((sources (etaf-runtime-theme-paint-slots runtime))
(slots (or (gethash source sources)
(let ((created (make-hash-table :test #'equal)))
(puthash source created sources)
created)))
(key (list property (copy-tree token)))
(updates (etaf-runtime-candidate-theme-paint-updates runtime)))
(unless (hash-table-p updates)
(error "ETAF Theme paint update requires an active candidate"))
(if (eq property :border)
(if-let* ((parts (etaf--theme-border-paint-parts resolved)))
(let* ((shape (car parts))
(color (cadr parts))
(spec (etaf--theme-paint-face-spec
:border-color color))
(entry (gethash key slots))
(entry
(cond
((and entry (equal shape (plist-get entry :shape)))
entry)
((null entry)
(let* ((slot (tp-paint-slot-create spec))
(created
(list :shape shape :slot slot
:value
(if (eq shape 'implicit)
slot
(list (car shape) (cadr shape)
slot)))))
(puthash key created slots)
created)))))
(if (null entry)
resolved
(let ((slot (plist-get entry :slot)))
(unless (and (tp-paint-slot-installed-p slot)
(equal spec (tp-paint-slot-spec slot)))
(puthash slot spec updates)))
(plist-get entry :value)))
resolved)
(let* ((spec (etaf--theme-paint-face-spec property resolved))
(entry (or (gethash key slots)
(let* ((slot (tp-paint-slot-create spec))
(created (list :slot slot :value slot)))
(puthash key created slots)
created))))
(let ((slot (plist-get entry :slot)))
(unless (and (tp-paint-slot-installed-p slot)
(equal spec (tp-paint-slot-spec slot)))
(puthash slot spec updates)))
(plist-get entry :value))))))
(defvar etaf--mount-epoch-counter 0)
(defvar etaf--current-component-identity nil)
(defvar etaf--current-component-semantic-id nil)
(defvar etaf--current-semantic-parent-id 0)
(defvar etaf--current-range-item-index nil)
(defvar etaf--rendering-range-p nil)
(defvar etaf--rendering-component-effect-p nil)
(defvar etaf--rendered-range-container-nodes nil)
(defvar etaf--runtime-force-full-component-render-p nil
"Non-nil only while a failed local anchor proof rebuilds all Components.")
(defvar etaf--runtime-fixed-point-stamps nil
"Dynamic Runtime flush table of evaluated effect input/version tuples.")
(defvar etaf--runtime-fixed-point-steps 0
"Number of effect evaluations recorded in the current Runtime flush.")
(defvar etaf--runtime-fixed-point-step-bound nil
"Graph-derived safety bound for one Runtime fixed-point flush.")
(defvar etaf--runtime-fixed-point-history nil
"Ordered fixed-point effect/edge trace for the current Runtime flush.")
(defun etaf--contribution-index-values (index slot)
"Return INDEX delta values for SLOT."
(pcase slot
('handlers (etaf--contribution-index-handlers index))
('host-props (etaf--contribution-index-host-props index))
('contexts (etaf--contribution-index-contexts index))
('themes (etaf--contribution-index-themes index))
('behaviors (etaf--contribution-index-behaviors index))
('context-consumers (etaf--contribution-index-context-consumers index))
('lifecycle (etaf--contribution-index-lifecycle index))))
(defun etaf--generation-index-lookup (generation slot key)
"Return committed KEY contribution in GENERATION SLOT."
(let ((index (and generation (etaf-generation-indexes generation))) found)
(while (and index (not found))
(if (member key (if (memq slot '(handlers host-props))
(etaf--contribution-index-host-removals index)
(etaf--contribution-index-semantic-removals index)))
(setq index nil)
(if-let* ((entry (assoc key
(etaf--contribution-index-values index slot))))
(setq found entry)
(setq index (etaf--contribution-index-base index)))))
(cdr found)))
(defun etaf--contribution-index-entries (index slot)
"Return effective committed entries for contribution INDEX SLOT."
(let ((index index)
(seen (make-hash-table :test #'equal)) result)
(while index
(dolist (key (if (memq slot '(handlers host-props))
(etaf--contribution-index-host-removals index)
(etaf--contribution-index-semantic-removals index)))
(puthash key t seen))
(dolist (entry (etaf--contribution-index-values index slot))
(unless (gethash (car entry) seen)
(puthash (car entry) t seen)
(push entry result)))
(setq index (unless (eq slot 'lifecycle)
(etaf--contribution-index-base index))))
(nreverse result)))
(defun etaf--generation-index-entries (generation slot)
"Return effective committed entries for GENERATION SLOT."
(etaf--contribution-index-entries
(and generation (etaf-generation-indexes generation)) slot))
(defun etaf--contribution-index-compact (index)
"Return one base-free effective snapshot of contribution INDEX."
(etaf--contribution-index-create
:handlers (copy-tree (etaf--contribution-index-entries index 'handlers))
:host-props (copy-tree
(etaf--contribution-index-entries index 'host-props))
:contexts (copy-tree (etaf--contribution-index-entries index 'contexts))
:themes (copy-tree (etaf--contribution-index-entries index 'themes))
:behaviors (copy-tree (etaf--contribution-index-entries index 'behaviors))
:context-consumers
(copy-tree (etaf--contribution-index-entries index 'context-consumers))
:lifecycle (copy-tree
(etaf--contribution-index-entries index 'lifecycle))
:depth 1))
(defun etaf--contribution-index-bound-depth (index)
"Compact contribution INDEX when it exceeds the configured depth."
(if (> (etaf--contribution-index-depth index)
(max 1 etaf-generation-index-max-depth))
(etaf--contribution-index-compact index)
index))
(defun etaf--generation-validate-context-acyclic (generation)
"Reject Context provider/consumer cycles in GENERATION."
(let ((edges (make-hash-table :test #'eql))
(visiting (make-hash-table :test #'eql))
(visited (make-hash-table :test #'eql)))
(dolist (entry (etaf--generation-index-entries
generation 'context-consumers))
(let ((provider-id (caar entry)))
(dolist (effect-id (cdr entry))
(when-let* ((effect (etaf--generation-effect generation effect-id)))
(let ((consumer-id (etaf--generation-effect-semantic-id effect)))
(unless (= provider-id consumer-id)
(cl-pushnew consumer-id
(gethash provider-id edges) :test #'eql)))))))
(cl-labels
((visit
(node path)
(when (gethash node visiting)
(signal 'etaf-context-error
(list "Context provider/consumer cycle"
(nreverse (cons node path)))))
(unless (gethash node visited)
(puthash node t visiting)
(dolist (next (gethash node edges))
(visit next (cons node path)))
(remhash node visiting)
(puthash node t visited))))
(maphash (lambda (node _) (visit node nil)) edges)))
generation)
(defun etaf-runtime-handler-for (runtime host-ref)
"Return committed handler entries for HOST-REF in RUNTIME."
(etaf--generation-index-lookup
(etaf-runtime-current-generation runtime) 'handlers host-ref))
(defun etaf-runtime-handler-entries (runtime)
"Return committed handler contribution entries for RUNTIME."
(copy-tree (etaf--generation-index-entries
(etaf-runtime-current-generation runtime) 'handlers)))
(defun etaf-runtime-host-props-for (runtime host-ref)
"Return committed semantic Host props for HOST-REF in RUNTIME."
(etaf--generation-index-lookup
(etaf-runtime-current-generation runtime) 'host-props host-ref))
(defun etaf-runtime-host-props-entries (runtime)
"Return committed Host contribution entries for RUNTIME."
(copy-tree (etaf--generation-index-entries
(etaf-runtime-current-generation runtime) 'host-props)))
(defun etaf--runtime-generation-mirror-projection (generation)
"Return exact compatibility mirrors projected from GENERATION."
(etaf-generation-project-mirrors
(etaf--generation-index-entries generation 'handlers)
(etaf--generation-index-entries generation 'host-props)))
(defun etaf--runtime-install-legacy-generation-mirrors (runtime full-p)
"Install RUNTIME candidate mirrors through the legacy FULL-P route."
(if full-p
(setf (etaf-runtime-handlers runtime)
(etaf-runtime-candidate-handlers runtime)
(etaf-runtime-host-props runtime)
(etaf-runtime-candidate-host-props runtime))
(unless (hash-table-p (etaf-runtime-handlers runtime))
(setf (etaf-runtime-handlers runtime) (make-hash-table :test #'equal)))
(unless (hash-table-p (etaf-runtime-host-props runtime))
(setf (etaf-runtime-host-props runtime)
(make-hash-table :test #'equal)))
(maphash
(lambda (host-ref handlers)
(puthash host-ref handlers (etaf-runtime-handlers runtime)))
(etaf-runtime-candidate-handlers runtime))
(maphash
(lambda (host-ref props)
(puthash host-ref props (etaf-runtime-host-props runtime)))
(etaf-runtime-candidate-host-props runtime))))
(defun etaf--runtime-install-projected-generation-mirrors
(runtime projection)
"Install detached generation mirror PROJECTION into RUNTIME."
(setf (etaf-runtime-handlers runtime) (plist-get projection :handlers)
(etaf-runtime-host-props runtime) (plist-get projection :host-props)))
(defun etaf-runtime-generation-mirrors-consistent-p (runtime)
"Return non-nil when RUNTIME mirrors equal its committed generation."
(let ((projection
(etaf--runtime-generation-mirror-projection
(etaf-runtime-current-generation runtime))))
(and
(etaf-generation-mirror-equal-p
(or (etaf-runtime-handlers runtime) (make-hash-table :test #'equal))
(plist-get projection :handlers))
(etaf-generation-mirror-equal-p
(or (etaf-runtime-host-props runtime) (make-hash-table :test #'equal))
(plist-get projection :host-props)))))
(defun etaf--runtime-install-generation-mirrors
(runtime generation full-p)
"Install RUNTIME compatibility mirrors for committed GENERATION.
FULL-P preserves the old route's full-root replacement distinction."
(let ((projection (etaf--runtime-generation-mirror-projection generation)))
(pcase etaf-generation-mirror-route
('legacy
(etaf--runtime-install-legacy-generation-mirrors runtime full-p))
('project
(etaf--runtime-install-projected-generation-mirrors runtime projection))
('shadow
(etaf--runtime-install-legacy-generation-mirrors runtime full-p)
(unless (and
(etaf-generation-mirror-equal-p
(etaf-runtime-handlers runtime)
(plist-get projection :handlers))
(etaf-generation-mirror-equal-p
(etaf-runtime-host-props runtime)
(plist-get projection :host-props)))
(signal 'etaf-generation-error
(list :compatibility-mirror-drift
:generation
(and generation
(etaf-generation-generation-id generation))))))
(_
(signal 'etaf-generation-error
(list :unknown-mirror-route etaf-generation-mirror-route))))
runtime))
(defun etaf--runtime-build-contribution-indexes (runtime base full-p)
"Build RUNTIME immutable generation contributions over BASE.
FULL-P means candidate tables describe the complete mounted tree."
(let (handler-additions prop-additions context-additions theme-additions
behavior-membership context-consumer-additions lifecycle-membership
changed-component-ids)
(maphash (lambda (key value)
(push (cons (copy-tree key) (copy-tree value))
handler-additions))
(etaf-runtime-candidate-handlers runtime))
(maphash (lambda (key value)
(push (cons (copy-tree key) (copy-tree value)) prop-additions))
(etaf-runtime-candidate-host-props runtime))
(maphash
(lambda (_identity semantic)
(let* ((semantic-id (etaf--semantic-component-semantic-id semantic))
(effect-id (etaf--semantic-component-effect-id semantic))
(old-semantic
(and base
(etaf--pvec-get (etaf-generation-semantic-nodes base)
semantic-id)))
(frame (etaf--semantic-component-context-frame semantic))
(theme (and frame
(gethash 'theme (etaf-context-values frame)
etaf--context-missing))))
(push semantic-id changed-component-ids)
(push (cons semantic-id frame) context-additions)
(dolist (dependency
(cl-delete-duplicates
(append (copy-sequence
(and old-semantic
(etaf--semantic-component-context-deps
old-semantic)))
(copy-sequence
(etaf--semantic-component-context-deps semantic)))
:test #'equal))
(let ((consumers
(delq effect-id
(copy-sequence
(etaf--generation-index-lookup
base 'context-consumers dependency)))))
(when (member dependency
(etaf--semantic-component-context-deps semantic))
(push effect-id consumers))
(push (cons (copy-tree dependency)
(sort consumers #'<))
context-consumer-additions)))
(unless (eq theme etaf--context-missing)
(push (cons semantic-id theme) theme-additions))))
(etaf-runtime-candidate-semantic-nodes runtime))
(maphash
(lambda (semantic-id semantic)
(let* ((effect-id
(cond ((etaf--semantic-host-p semantic)
(etaf--semantic-host-effect-id semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-effect-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-effect-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-effect-id semantic))))
(new-deps
(cond ((etaf--semantic-host-p semantic)
(etaf--semantic-host-context-deps semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-context-deps semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-context-deps semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-context-deps semantic))))
(old (and base effect-id
(etaf--pvec-get (etaf-generation-semantic-nodes base)
semantic-id)))
(old-deps
(cond ((etaf--semantic-host-p old)
(etaf--semantic-host-context-deps old))
((etaf--semantic-range-p old)
(etaf--semantic-range-context-deps old))
((etaf--semantic-inline-range-p old)
(etaf--semantic-inline-range-context-deps old))
((etaf--semantic-slot-range-p old)
(etaf--semantic-slot-range-context-deps old)))))
(when effect-id
(dolist (dependency
(cl-delete-duplicates
(append (copy-sequence old-deps)
(copy-sequence new-deps))
:test #'equal))
(let ((consumers
(delq effect-id
(copy-sequence
(etaf--generation-index-lookup
base 'context-consumers dependency)))))
(when (member dependency new-deps)
(push effect-id consumers))
(push (cons (copy-tree dependency) (sort consumers #'<))
context-consumer-additions))))))
(etaf-runtime-candidate-graph-nodes runtime))
(maphash
(lambda (identity state)
(push
(cons (copy-tree identity)
(copy-tree
(or (gethash identity
(etaf-runtime-candidate-behavior-resource-keys
runtime))
(etaf-behavior-spec-name (car state)))))
behavior-membership))
(etaf-runtime-candidate-behaviors runtime))
(dolist (identity
(cl-delete-duplicates
(append (copy-sequence
(etaf-runtime-candidate-rendered-identities runtime))
(copy-sequence
(etaf-runtime-candidate-updated-component-identities
runtime)))
:test #'equal))
(push (cons (copy-tree identity) 'updated) lifecycle-membership))
(let ((base-index (and (not full-p) base
(etaf-generation-indexes base))))
(etaf--contribution-index-bound-depth
(etaf--contribution-index-create
:base base-index
:handlers (nreverse handler-additions)
:host-props (nreverse prop-additions)
:contexts (nreverse context-additions)
:themes (nreverse theme-additions)
:behaviors (nreverse behavior-membership)
:context-consumers (nreverse context-consumer-additions)
:lifecycle (nreverse lifecycle-membership)
:host-removals
(cl-remove-if
(lambda (host-ref)
(gethash host-ref (etaf-runtime-candidate-host-props runtime)))
(copy-sequence (etaf-runtime-candidate-removed-host-refs runtime)))
:semantic-removals
(append changed-component-ids
(copy-sequence
(etaf-runtime-candidate-removed-semantic-ids runtime)))
:depth (1+ (if base-index
(etaf--contribution-index-depth base-index)
0)))))))
(defun etaf-runtime-generation (runtime)
"Return RUNTIME's committed generation id."
(if-let* ((generation (etaf-runtime-current-generation runtime)))
(etaf-generation-generation-id generation)
0))
(defun etaf--semantic-backend-range-artifact-key (semantic)
"Return external artifact key for direct or slot Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-artifact-key semantic)
(etaf--semantic-slot-range-artifact-key semantic)))
(defun etaf--semantic-backend-range-ref (semantic)
"Return Ebox range ref for direct or slot Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-range-ref semantic)
(etaf--semantic-slot-range-range-ref semantic)))
(defun etaf--semantic-backend-range-semantic-id (semantic)
"Return retained semantic id for direct or slot Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-semantic-id semantic)
(etaf--semantic-slot-range-semantic-id semantic)))
(defun etaf--semantic-backend-range-container-component-id (semantic)
"Return the Component containing backend Range SEMANTIC's artifact."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-component-id semantic)
(etaf--semantic-slot-range-consumer-component-id semantic)))
(defun etaf--semantic-backend-range-item-root-ids (semantic)
"Return direct material root ids owned by backend Range SEMANTIC."
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-item-root-ids semantic)
(etaf--semantic-slot-range-item-root-ids semantic)))
(defun etaf--generation-component-output-range (generation component)
"Return COMPONENT's transparent output Range from GENERATION."
(let* ((range-id (etaf--semantic-component-output-range-id component))
(range (and range-id
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id))))
(unless (etaf--semantic-range-p range)
(signal 'etaf-runtime-error
(list "Transparent Component has no output Range")))
range))
(defun etaf--runtime-committed-range-input (runtime semantic)
"Return RUNTIME's committed canonical input for SEMANTIC Range."
(let ((artifact
(gethash (etaf--semantic-backend-range-artifact-key semantic)
(etaf-runtime-range-artifact-registry runtime))))
(unless (ebox-canonical-input-p artifact)
(signal 'etaf-runtime-error
(list "Range artifact has no canonical input")))
artifact))
(defun etaf--runtime-range-input (runtime semantic)
"Return RUNTIME's candidate-aware canonical input for SEMANTIC Range."
(let ((artifact
(gethash
(if (etaf--semantic-range-p semantic)
(etaf--semantic-range-effect-id semantic)
(etaf--semantic-slot-range-effect-id semantic))
(etaf-runtime-candidate-range-artifacts runtime))))
(if artifact
(progn
(unless (ebox-canonical-input-p artifact)
(signal 'etaf-runtime-error
(list "Candidate Range artifact is not canonical input")))
artifact)
(etaf--runtime-committed-range-input runtime semantic))))
(defun etaf--runtime-range-nodes (runtime semantic)
"Import SEMANTIC Range's canonical input from RUNTIME and return its nodes."
(etaf--ebox-import-input (etaf--runtime-range-input runtime semantic)))
(defun etaf--generation-semantic (generation identity)
"Return IDENTITY semantic node from GENERATION."
(when-let* ((id (gethash identity (etaf-generation-identity-index generation))))
(etaf--pvec-get (etaf-generation-semantic-nodes generation) id)))
(defun etaf--generation-effect-semantic (generation effect-id)
"Return EFFECT-ID semantic node from GENERATION."
(when-let* ((effect (etaf--pvec-get
(etaf-generation-effect-map generation) effect-id)))
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
(etaf--generation-effect-semantic-id effect))))
(defun etaf--generation-effect (generation effect-id)
"Return immutable EFFECT-ID scheduling record from GENERATION."
(etaf--pvec-get (etaf-generation-effect-map generation) effect-id))
(defun etaf--runtime-scheduled-semantic-live-p (generation effect semantic)
"Return whether scheduled EFFECT still has a live owner in GENERATION.
The source index is persistent across local generations, so a removed
semantic node must not be allowed to run merely because an old effect record
is still present during the current overlay. Root-level ranges/inline ranges
may legitimately have no Component owner; non-root ranges must retain their
owning Component node."
(and effect semantic
(let ((nodes (etaf-generation-semantic-nodes generation)))
(cond
((etaf--semantic-component-p semantic)
(etaf--pvec-get nodes
(etaf--semantic-component-semantic-id semantic)))
((etaf--semantic-host-p semantic)
(etaf--pvec-get nodes
(etaf--semantic-host-semantic-id semantic)))
((etaf--semantic-range-p semantic)
(or (null (etaf--semantic-range-component-id semantic))
(etaf--pvec-get nodes
(etaf--semantic-range-component-id semantic))))
((etaf--semantic-slot-range-p semantic)
(or (null (etaf--semantic-slot-range-consumer-component-id semantic))
(etaf--pvec-get
nodes
(etaf--semantic-slot-range-consumer-component-id semantic))))
((etaf--semantic-inline-range-p semantic)
(or (null (etaf--semantic-inline-range-component-id semantic))
(etaf--pvec-get
nodes
(etaf--semantic-inline-range-component-id semantic))))
(t nil)))))
(defun etaf--runtime-range-owned-by-rendered-component-p
(runtime generation semantic)
"Return non-nil when SEMANTIC is subsumed by a rendered Component.
RUNTIME's candidate already contains the Component's freshly lowered output
from committed GENERATION in that case, so evaluating the old descendant Range
again would duplicate work and later be discarded before publication.
Root-owned Ranges intentionally return nil because they have no material
Component owner to absorb them."
(let* ((component-id
(cond
((etaf--semantic-range-p semantic)
(etaf--semantic-range-component-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-consumer-component-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-component-id semantic))))
(component (and component-id
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
component-id)))
(effect-id (cond
((etaf--semantic-range-p semantic)
(etaf--semantic-range-effect-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-effect-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-effect-id semantic))))
(semantic-id (cond
((etaf--semantic-range-p semantic)
(etaf--semantic-range-semantic-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-semantic-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-semantic-id semantic))))
(candidate-effects (etaf-runtime-candidate-effects runtime))
(candidate-nodes (etaf-runtime-candidate-graph-nodes runtime)))
(and (etaf--semantic-component-p component)
(member (etaf--semantic-component-identity component)
(etaf-runtime-candidate-rendered-identities runtime))
;; A Component render only subsumes the old Range once it actually
;; staged the replacement Range/effect. Context-owned direct Ranges
;; can remain outside the Component render and must still evaluate
;; to refresh their Context dependency edges.
(gethash effect-id candidate-effects)
(gethash semantic-id candidate-nodes))))
(defun etaf--generation-source-effects (generation source)
"Return current effect ids for SOURCE in GENERATION."
(etaf--pvec-get (etaf-generation-source-effects generation)
(etaf-reactive-source-id source)))
(defvar etaf--runtime-table (make-hash-table :test #'eq)
"Buffer -> mounted ETAF Runtime table.")
(defvar etaf--runtime-route-registry
(make-hash-table :test #'eql :weakness 'value)
"Mount epoch -> live Runtime weak-value registry.")
(defun etaf--runtime-kill-buffer ()
"Unmount the ETAF Runtime owned by the current buffer before it dies."
(when-let* ((runtime (gethash (current-buffer) etaf--runtime-table)))
(condition-case condition
(etaf-runtime-call-operation
runtime 'unmount "buffer kill"
(lambda () (etaf--runtime-unmount-now runtime 'buffer-kill)))
((error quit)
(etaf--runtime-record-observer-diagnostic
runtime (list :kind 'buffer-kill-retirement
:condition condition))))))
(defun etaf--runtime-enqueue-effect (runtime effect-id)
"Append EFFECT-ID once to RUNTIME's stable FIFO work queue."
(unless (gethash effect-id (etaf-runtime-dirty-effect-ids runtime))
(puthash effect-id t (etaf-runtime-dirty-effect-ids runtime))
(let ((cell (list effect-id)))
(if (etaf-runtime-dirty-effect-queue-tail runtime)
(setcdr (etaf-runtime-dirty-effect-queue-tail runtime) cell)
(setf (etaf-runtime-dirty-effect-queue runtime) cell))
(setf (etaf-runtime-dirty-effect-queue-tail runtime) cell))))
(defun etaf--runtime-pop-effect (runtime)
"Pop and return RUNTIME's next dirty effect id."
(let ((effect-id (pop (etaf-runtime-dirty-effect-queue runtime))))
(unless (etaf-runtime-dirty-effect-queue runtime)
(setf (etaf-runtime-dirty-effect-queue-tail runtime) nil))
effect-id))
(defun etaf--runtime-clear-dirty-effects (runtime)
"Clear RUNTIME's dirty effect membership and FIFO."
(clrhash (etaf-runtime-dirty-effect-ids runtime))
(setf (etaf-runtime-dirty-effect-queue runtime) nil
(etaf-runtime-dirty-effect-queue-tail runtime) nil))
(defun etaf--runtime-mark-root-dirty (runtime)
"Mark RUNTIME for an exact Root-owned rebuild."
(setf (etaf-runtime-root-dirty-p runtime) t))
(defun etaf--runtime-effect-priority (effect)
"Return fixed scheduling priority for generation EFFECT."
(pcase (etaf--generation-effect-kind effect)
('root 0)
('component-input 1)
((or 'range 'fragment 'slot 'inline) 2)
(_ 3)))
(defun etaf--runtime-sort-dirty-effects (generation effect-ids)
"Return EFFECT-IDS in stable priority/id order for GENERATION.
Each immutable generation effect is resolved once instead of on every sort
comparison."
(mapcar
#'cdr
(sort
(mapcar
(lambda (effect-id)
(cons (etaf--runtime-effect-priority
(etaf--generation-effect generation effect-id))
effect-id))
effect-ids)
(lambda (left right)
(if (= (car left) (car right))
(< (cdr left) (cdr right))
(< (car left) (car right)))))))
(defun etaf--runtime-fixed-point-safe-hash (value)
"Return a stable hash for immutable fixed-point VALUE, or nil.
Candidate semantic output is diagnostic evidence, not authority; malformed or
cyclic diagnostic payloads therefore fail closed without preventing the normal
transaction from deciding whether the value changed."
(condition-case _err
(sxhash-equal value)
(error nil)))
(defun etaf--runtime-candidate-effect (runtime effect-id)
"Return candidate EFFECT-ID staged in RUNTIME's overlay."
(let ((table (etaf-runtime-candidate-effects runtime)))
(and (hash-table-p table) (gethash effect-id table))))
(defun etaf--runtime-effect-semantic-stamp (runtime generation effect)
"Return candidate-aware semantic facts for EFFECT in GENERATION/RUNTIME."
(let* ((effect-id (and effect (etaf--generation-effect-effect-id effect)))
(semantic-id (and effect
(etaf--generation-effect-semantic-id effect)))
(candidate (and semantic-id
(hash-table-p
(etaf-runtime-candidate-graph-nodes runtime))
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
(semantic (or candidate
(and generation semantic-id
(etaf--generation-effect-semantic
generation effect-id))))
(facts
(cond
((etaf--semantic-component-p semantic)
(list (etaf--semantic-component-composition-version semantic)
(etaf--semantic-component-input-props semantic)
(etaf--semantic-component-input-attrs semantic)
(etaf--semantic-component-input-slots semantic)
(etaf--semantic-component-context-deps semantic)
(etaf--semantic-component-output-signature semantic)))
((etaf--semantic-host-p semantic)
(list (etaf--semantic-host-composition-version semantic)
(etaf--semantic-host-props-signature semantic)
(etaf--semantic-host-context-deps semantic)))
((etaf--semantic-range-p semantic)
(list (etaf--semantic-range-composition-version semantic)
(etaf--semantic-range-output-signature semantic)
(etaf--semantic-range-context-deps semantic)))
((etaf--semantic-slot-range-p semantic)
(list (etaf--semantic-slot-range-composition-version semantic)
(etaf--semantic-slot-range-output-signature semantic)
(etaf--semantic-slot-range-context-deps semantic)))
((etaf--semantic-inline-range-p semantic)
(list (etaf--semantic-inline-range-composition-version semantic)
(etaf--semantic-inline-range-output semantic)
(etaf--semantic-inline-range-context-deps semantic)))
(t nil))))
(list :effect-id effect-id
:kind (and effect (etaf--generation-effect-kind effect))
:semantic-id semantic-id
:candidate-p (and candidate t)
:facts-hash (etaf--runtime-fixed-point-safe-hash facts))))
(defun etaf--runtime-effect-input-version-tuple (runtime generation effect-id)
"Return candidate-aware tuple for EFFECT-ID in RUNTIME GENERATION.
The tuple includes source versions, candidate semantic facts, and the exact
effect-to-source edges. It is intentionally immutable and suitable as an
`equal' hash key for one flush."
(let* ((effect (or (etaf--runtime-candidate-effect runtime effect-id)
(and generation
(etaf--generation-effect generation effect-id))))
(deps (and effect (etaf--generation-effect-deps effect)))
(edges
(sort
(mapcar (lambda (source)
(list (etaf-reactive-source-id source)
(cond ((etaf-ref-p source)
(etaf-ref-version source))
((etaf-computed-p source)
(etaf-computed-version source))
(t 0))))
deps)
(lambda (left right) (< (car left) (car right))))))
(list :mount-epoch (etaf-runtime-mount-epoch runtime)
:generation-id (and generation
(etaf-generation-generation-id generation))
:effect (etaf--runtime-effect-semantic-stamp
runtime generation effect)
:edges edges)))
(defun etaf--runtime-fixed-point-graph-size (runtime generation)
"Return graph-derived counts and a finite flush bound for RUNTIME GENERATION."
(let ((nodes (or (and (hash-table-p
(etaf-runtime-candidate-graph-nodes runtime))
(hash-table-count
(etaf-runtime-candidate-graph-nodes runtime)))
0))
(edges 0)
(sources 0)
(effect-count (max 1 (etaf-runtime-next-effect-id runtime))))
(when (hash-table-p (etaf-runtime-candidate-effects runtime))
(maphash
(lambda (_id effect)
(cl-incf edges (length (etaf--generation-effect-deps effect))))
(etaf-runtime-candidate-effects runtime)))
(when generation
(let ((root (etaf-generation-effect-sources generation)))
(cl-labels
((walk (node)
(when node
(when (etaf--pvec-node-value node)
(cl-incf sources))
(let ((children (etaf--pvec-node-children node)))
(when children
(dotimes (index (length children))
(walk (aref children index))))))))
(walk root))))
(setq nodes (max nodes effect-count)
;; The committed source index may contain effects not staged in the
;; candidate. Count their source edges conservatively from the
;; monotonic effect allocator, while retaining the explicit edge
;; count for diagnostics and the bound itself.
edges (max edges effect-count)
sources (max sources (hash-table-count
(etaf-runtime-route-sources runtime))))
(list :nodes nodes :edges edges :sources sources
:bound (max 16 (* 2 (+ 1 nodes edges sources))))))
(defun etaf--runtime-record-effect-input-version (runtime generation effect-id)
"Record one EFFECT-ID tuple for RUNTIME GENERATION, or signal non-convergence."
(when etaf--runtime-fixed-point-stamps
(cl-incf etaf--runtime-fixed-point-steps)
(when (and etaf--runtime-fixed-point-step-bound
(> etaf--runtime-fixed-point-steps
etaf--runtime-fixed-point-step-bound))
(signal 'etaf-runtime-error
(list :non-converging-effect-steps
:bound etaf--runtime-fixed-point-step-bound
:steps etaf--runtime-fixed-point-steps
:effect-id effect-id)))
(let* ((tuple (etaf--runtime-effect-input-version-tuple
runtime generation effect-id))
(entry (list :effect-id effect-id
:tuple tuple
:edges (plist-get tuple :edges))))
(when (gethash tuple etaf--runtime-fixed-point-stamps)
(signal 'etaf-runtime-error
(list :non-converging-effect-tuple tuple
:path (nreverse (cons entry
etaf--runtime-fixed-point-history)))))
(puthash tuple t etaf--runtime-fixed-point-stamps)
(push entry etaf--runtime-fixed-point-history))))
(defun etaf--runtime-authorized-route-runtime (route)
"Return the live Runtime authorized by opaque ROUTE, or nil."
(when (and (etaf-runtime-route-p route)
(etaf-runtime-route-active-p route))
(when-let* ((runtime
(gethash (etaf-runtime-route-mount-epoch route)
etaf--runtime-route-registry)))
(and (eq route (etaf-runtime-route-token runtime))
(eq (etaf-runtime-route-scheduler-context route)
(etaf-runtime-scheduler-context runtime))
(etaf-runtime-mounted-p runtime)
(etaf-host-authority-accepts-token-p
(etaf-runtime-host-authority runtime)
(etaf-runtime-route-authority-token route))
runtime))))
(defun etaf--runtime-route-scheduler (route source)
"Route dirty SOURCE through opaque ROUTE to its current generation."
(when-let* ((runtime (etaf--runtime-authorized-route-runtime route)))
(dolist (effect-id
(etaf--generation-source-effects
(etaf-runtime-current-generation runtime) source))
(when (etaf--generation-effect
(etaf-runtime-current-generation runtime) effect-id)
(etaf--runtime-enqueue-effect runtime effect-id)
(when (equal effect-id (etaf-runtime-root-effect-id runtime))
(etaf--runtime-mark-root-dirty runtime))))
(etaf-reactive-enqueue-runtime-flush
(etaf-runtime-mount-epoch runtime)
(lambda () (etaf--runtime-request-flush runtime))
(etaf-runtime-scheduler-context runtime))))
(defun etaf--runtime-evaluate-root-candidate (runtime)
"Evaluate RUNTIME root while privately collecting dependencies."
(let (deps value)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq value (etaf--runtime-evaluate-root runtime)))
(setf (etaf-runtime-candidate-root-deps runtime) (nreverse deps))
value))
(defvar etaf--current-runtime nil
"Runtime owning the current setup, lifecycle, or event operation.")
(defun etaf-current-runtime ()
"Return the dynamically active Runtime, or nil outside a Runtime."
etaf--current-runtime)
(defun etaf--runtime-forward-ebox-report (_buffer report)
"Forward accepted Ebox or TP REPORT into the active Runtime operation."
(etaf-observer-emit report))
(defun etaf--runtime-record-observer-diagnostic (runtime diagnostic)
"Record contained observer DIAGNOSTIC on RUNTIME."
(push (append (list :phase 'observer) (copy-tree diagnostic))
(etaf-runtime-diagnostics runtime))
nil)
(defcustom etaf-retirement-journal-limit 64
"Maximum completed retirement journals retained by one Runtime."
:type 'positive-integer
:group 'etaf)
(defun etaf--runtime-new-retirement-journal (runtime outcome-id)
"Create RUNTIME retirement journal correlated with committed OUTCOME-ID."
(etaf-retirement-journal-create
:operation-id
(if etaf--observer-context
(etaf--observer-context-operation-id etaf--observer-context)
(or (etaf-runtime-next-operation-id runtime) 0))
:outcome-id outcome-id
:generation-id (etaf-runtime-generation runtime)
:revision (etaf-render-port-revision (etaf-runtime-buffer runtime))))
(defun etaf--runtime-run-postcommit-step (journal owner kind function)
"Run FUNCTION after commit, recording its condition in JOURNAL.
OWNER and KIND identify the step. Return the original condition, or nil."
(condition-case condition
(progn (funcall function) nil)
((error quit)
(etaf-retirement-record-contained-failure
journal owner kind condition))))
(defun etaf--runtime-retain-retirement-journal (runtime journal)
"Retain completed JOURNAL and its diagnostics on RUNTIME."
(push journal (etaf-runtime-retirement-journals runtime))
(when (> (length (etaf-runtime-retirement-journals runtime))
(max 1 etaf-retirement-journal-limit))
(setcdr (nthcdr (1- (max 1 etaf-retirement-journal-limit))
(etaf-runtime-retirement-journals runtime))
nil))
(dolist (diagnostic (etaf-retirement-journal-diagnostics journal))
(push (append (list :phase 'retirement
:diagnostic-journal-id
(etaf-retirement-journal-id journal))
(copy-tree diagnostic))
(etaf-runtime-diagnostics runtime)))
journal)
(defun etaf--runtime-drain-retirement (runtime journal &optional contained-p)
"Drain RUNTIME JOURNAL and re-signal public failure unless CONTAINED-P."
(let ((condition (etaf-retirement-drain journal)))
(etaf--runtime-retain-retirement-journal runtime journal)
(when (and condition (not contained-p))
(etaf-retirement-resignal condition journal))
condition))
(defun etaf-runtime-call-operation (runtime kind label function)
"Call FUNCTION as one observed RUNTIME operation.
KIND is a stable symbol and LABEL is a user-facing string. Nested calls for
the same Runtime reuse the active operation. Calls for another Runtime own a
separate operation. Return FUNCTION's exact result and re-signal its exact
error or quit."
(unless (and (etaf-runtime-p runtime)
(etaf-runtime-mounted-p runtime))
(signal 'etaf-runtime-error (list "ETAF runtime is not mounted")))
(unless (and (symbolp kind) kind)
(signal 'wrong-type-argument (list 'symbolp kind)))
(unless (stringp label)
(signal 'wrong-type-argument (list 'stringp label)))
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(let* ((runtime-id (etaf-runtime-mount-epoch runtime))
(current etaf--observer-context)
(same-runtime
(and current
(= runtime-id
(etaf--observer-context-runtime-id current))))
(observer (etaf-runtime-observer runtime)))
(cond
(same-runtime
(funcall function))
((null observer)
;; A different Runtime must not leak provider reports into the outer
;; operation merely because its own observer is disabled.
(let ((etaf--observer-context nil))
(funcall function)))
(t
(let* ((operation-id
(1+ (or (etaf-runtime-next-operation-id runtime) 0)))
(generation-before (etaf-runtime-generation runtime))
(scheduler-context
(or (etaf-runtime-scheduler-context runtime)
etaf-scheduler-default-context))
(scheduler-before
(etaf-scheduler-context-metrics scheduler-context))
(started (float-time))
(gc-count-before gcs-done)
(gc-elapsed-before gc-elapsed)
(status 'error)
(context
(etaf--observer-context-create
:sink observer
:operation-id operation-id
:runtime-id runtime-id
:buffer-name (buffer-name (etaf-runtime-buffer runtime))
:diagnostic
(lambda (diagnostic)
(etaf--runtime-record-observer-diagnostic
runtime diagnostic))))
projection-summaries
result)
(setf (etaf-runtime-next-operation-id runtime) operation-id)
(cl-labels
((run-body
()
(etaf--observer-call-with-context
context
(lambda ()
(condition-case condition
(prog1 (setq result (funcall function))
(setq status 'success))
(quit
(setq status 'quit)
(signal (car condition) (cdr condition)))))))
(emit-final
(summaries)
(let ((scheduler-after
(etaf-scheduler-context-metrics scheduler-context)))
(etaf--observer-call-with-context
context
(lambda ()
(etaf-observer-emit
(list
:provider 'etaf
:stage 'runtime-operation
:kind kind
:label (copy-sequence label)
:generation-before generation-before
:generation-after (etaf-runtime-generation runtime)
:status status
:scheduler-context-id
(plist-get scheduler-after :context-id)
:scheduler-projection-epoch-before
(plist-get scheduler-before :projection-epoch)
:scheduler-projection-epoch-after
(plist-get scheduler-after :projection-epoch)
:scheduler-turns
(- (plist-get scheduler-after :turn-count)
(plist-get scheduler-before :turn-count))
:scheduler-source-enqueues
(- (plist-get scheduler-after :source-enqueues)
(plist-get scheduler-before :source-enqueues))
:scheduler-source-dedupes
(- (plist-get scheduler-after :source-dedupes)
(plist-get scheduler-before :source-dedupes))
:scheduler-source-deliveries
(- (plist-get scheduler-after :source-deliveries)
(plist-get scheduler-before :source-deliveries))
:scheduler-subscriber-visits
(- (plist-get scheduler-after :subscriber-visits)
(plist-get scheduler-before :subscriber-visits))
:scheduler-effect-claims
(- (plist-get scheduler-after :effect-claims)
(plist-get scheduler-before :effect-claims))
:scheduler-effect-evaluations
(- (plist-get scheduler-after :effect-evaluations)
(plist-get scheduler-before :effect-evaluations))
:scheduler-runtime-enqueues
(- (plist-get scheduler-after :runtime-enqueues)
(plist-get scheduler-before :runtime-enqueues))
:scheduler-runtime-dedupes
(- (plist-get scheduler-after :runtime-dedupes)
(plist-get scheduler-before :runtime-dedupes))
:scheduler-runtime-executions
(- (plist-get scheduler-after :runtime-executions)
(plist-get scheduler-before :runtime-executions))
:scheduler-stale-route-drops
(- (plist-get scheduler-after :stale-route-drops)
(plist-get scheduler-before :stale-route-drops))
:scheduler-faults
(- (plist-get scheduler-after :fault-count)
(plist-get scheduler-before :fault-count))
:scheduler-projections (copy-tree summaries)
:scheduler-fault-state
(plist-get scheduler-after :fault-state)
:duration-ms
(max 0.0 (* 1000.0 (- (float-time) started)))
:gc-count (- gcs-done gc-count-before)
:gc-duration-ms
(max 0.0
(* 1000.0
(- gc-elapsed gc-elapsed-before))))))))))
(if (etaf-scheduler-projection-active-p)
(unwind-protect
(run-body)
(etaf-scheduler-on-projection-complete
(lambda (summary) (emit-final (list summary)))))
(let ((etaf-scheduler-projection-observer
(lambda (summary)
(push summary projection-summaries))))
(unwind-protect
(run-body)
(emit-final (nreverse projection-summaries)))))
result))))))
(cl-defmacro etaf--runtime-with-operation ((runtime kind label) &rest body)
"Evaluate BODY in RUNTIME operation KIND and LABEL when observed."
(declare (indent 1) (debug ((form form form) body)))
(let ((runtime-value (make-symbol "runtime")))
`(let ((,runtime-value ,runtime))
(if (and (null etaf--observer-context)
(null (etaf-runtime-observer ,runtime-value)))
(progn ,@body)
(etaf-runtime-call-operation
,runtime-value ,kind ,label (lambda () ,@body))))))
(defun etaf-runtime-set-focus-ref (runtime host-ref)
"Set RUNTIME's focused Host reference to HOST-REF and return it."
(setf (etaf-runtime-focus-ref runtime) host-ref)
host-ref)
(defun etaf-runtime-event-begin (runtime)
"Enter one logical event batch for mounted RUNTIME."
(setq runtime (etaf-runtime-require-mounted runtime))
(cl-incf (etaf-runtime-event-depth runtime))
(etaf-scheduler-context-event-begin
(etaf-runtime-scheduler-context runtime))
runtime)
(defun etaf-runtime-event-end (runtime)
"Leave RUNTIME's logical event batch and publish pending state once."
(when (etaf-runtime-p runtime)
(setf (etaf-runtime-event-depth runtime)
(max 0 (1- (etaf-runtime-event-depth runtime))))
(etaf-scheduler-context-event-end
(etaf-runtime-scheduler-context runtime))
(when (and (etaf-runtime-mounted-p runtime)
(zerop (etaf-runtime-event-depth runtime))
(etaf-runtime-pending-p runtime))
(setf (etaf-runtime-pending-p runtime) nil)
(etaf--runtime-request-flush runtime)))
runtime)
(defun etaf-runtime-for-buffer (buffer-or-name)
"Return the live Runtime mounted in BUFFER-OR-NAME, or nil."
(let* ((buffer (get-buffer buffer-or-name))
(runtime (and buffer (gethash buffer etaf--runtime-table))))
(and runtime
(etaf-runtime-mounted-p runtime)
(etaf-host-authority-attached-p
(etaf-runtime-host-authority runtime))
runtime)))
(defun etaf-runtime-require-mounted (&optional runtime)
"Return mounted RUNTIME or the Runtime in the current buffer.
Signal an ETAF runtime error before any downstream action or renderer lookup
when the requested boundary is no longer mounted."
(let ((runtime (or runtime etaf--current-runtime
(and (buffer-live-p (current-buffer))
(gethash (current-buffer) etaf--runtime-table)))))
(unless (and (etaf-runtime-p runtime)
(etaf-runtime-mounted-p runtime)
(etaf-host-authority-attached-p
(etaf-runtime-host-authority runtime)))
(signal 'etaf-runtime-error
(list "ETAF runtime is not mounted")))
runtime))
;;;###autoload
(defun etaf-runtime-set-observer (runtime observer-or-nil)
"Set mounted RUNTIME's observer to OBSERVER-OR-NIL and return it.
The observer receives one immutable flat report argument. Nil detaches the
Runtime from its Ebox surface. Replacing observation during an active
operation is rejected so the operation keeps one stable sink."
(setq runtime (etaf-runtime-require-mounted runtime))
(unless (or (null observer-or-nil) (functionp observer-or-nil))
(signal 'wrong-type-argument (list 'functionp observer-or-nil)))
(unless (eq observer-or-nil (etaf-runtime-observer runtime))
(when (and etaf--observer-context
(= (etaf-runtime-mount-epoch runtime)
(etaf--observer-context-runtime-id
etaf--observer-context)))
(error "ETAF observer cannot change during an active operation"))
(ebox-buffer-set-observer
(etaf-runtime-buffer runtime)
(and observer-or-nil #'etaf--runtime-forward-ebox-report))
(setf (etaf-runtime-observer runtime) observer-or-nil))
observer-or-nil)
;;;###autoload
(defun etaf-runtime-compare-and-set-observer (runtime expected replacement)
"Replace RUNTIME observer EXPECTED with REPLACEMENT atomically.
EXPECTED and REPLACEMENT are functions or nil. Return non-nil only when the
current observer is `eq' to EXPECTED; in that case REPLACEMENT is installed
through the ordinary observer boundary. A mismatch leaves the Runtime
untouched. This lets optional consumers detach only the sink they own without
reading Runtime storage fields."
(setq runtime (etaf-runtime-require-mounted runtime))
(dolist (observer (list expected replacement))
(unless (or (null observer) (functionp observer))
(signal 'wrong-type-argument (list 'functionp observer))))
(when (eq expected (etaf-runtime-observer runtime))
(etaf-runtime-set-observer runtime replacement)
t))
(defun etaf--runtime-watch-scheduler (runtime job _flush)
"Run watcher JOB while RUNTIME remains mounted."
(when (etaf-runtime-mounted-p runtime)
(funcall job)))
(defun etaf--runtime-call-with-component-env (runtime component-id function)
"Call FUNCTION in RUNTIME candidate/committed COMPONENT-ID environment."
(let* ((generation (etaf-runtime-current-generation runtime))
(env (and component-id
(gethash component-id
(etaf-runtime-candidate-component-envs runtime))))
(base (and component-id generation
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
component-id)))
(component
(and base
(or (gethash (etaf--semantic-component-identity base)
(etaf-runtime-candidate-semantic-nodes runtime))
base)))
(instance
(or (plist-get env :instance)
(and component
(gethash (etaf--semantic-component-resource-key component)
(etaf-runtime-resource-registry runtime)))))
(identity
(or (plist-get env :identity)
(and component (etaf--semantic-component-identity component))))
(props
(or (plist-get env :props)
(and component (etaf--semantic-component-props component))))
(slots
(or (plist-get env :slots)
(and component (etaf--semantic-component-slots component)))))
(if (null component-id)
(let ((etaf--current-runtime runtime)
(etaf--current-component-instance nil)
(etaf--current-component-identity nil)
(etaf--current-component-semantic-id nil)
(etaf--current-component-props nil)
(etaf--current-component-slots nil))
(funcall function))
(let ((etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(and instance (etaf--component-instance-state instance)))
(etaf--current-component-setup-defined-p
(and instance
(not (null (etaf--component-spec-setup
(etaf--component-instance-spec instance))))))
(etaf--current-component-setup-complete-p
(and instance
(etaf--component-instance-setup-complete-p instance)))
(etaf--component-phase 'render)
(etaf--current-component-identity identity)
(etaf--current-component-semantic-id component-id)
(etaf--current-component-props props)
(etaf--current-component-slots slots)
(etaf--current-context
(or (and component
(etaf--runtime-context-frame-for-candidate
runtime component))
(etaf--component-instance-context instance))))
(funcall function)))))
(defun etaf--runtime-component-env-signature (runtime component-id)
"Return COMPONENT-ID's candidate or committed input signature in RUNTIME."
(when component-id
(or (when-let* ((env (gethash component-id
(etaf-runtime-candidate-component-envs runtime))))
(list (copy-tree (plist-get env :props))
(copy-tree (plist-get env :attrs))
(copy-tree (plist-get env :slots))))
(when-let* ((generation (etaf-runtime-current-generation runtime))
(component
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
component-id)))
(list (copy-tree (etaf--semantic-component-props component))
(copy-tree (etaf--semantic-component-attrs component))
(copy-tree (etaf--semantic-component-slots component)))))))
(defun etaf--context-frame-changed-keys (old new)
"Return stable keys whose values differ between OLD and NEW frames."
(let ((seen (make-hash-table :test #'eq)) result)
(dolist (frame (list old new))
(when frame
(maphash (lambda (key _value) (puthash key t seen))
(etaf-context-values frame))))
(maphash
(lambda (key _)
(unless (equal (and old (gethash key (etaf-context-values old)
etaf--context-missing))
(and new (gethash key (etaf-context-values new)
etaf--context-missing)))
(push key result)))
seen)
(sort result (lambda (left right)
(string< (symbol-name left) (symbol-name right))))))
(defun etaf--runtime-enqueue-context-consumers (runtime provider-id old new)
"Enqueue RUNTIME consumers affected by PROVIDER-ID changing OLD to NEW."
(dolist (key (etaf--context-frame-changed-keys old new))
(dolist (effect-id
(etaf--generation-index-lookup
(etaf-runtime-current-generation runtime) 'context-consumers
(cons provider-id key)))
(etaf--runtime-enqueue-effect runtime effect-id))))
(defun etaf--runtime-context-frame-for-candidate (runtime semantic)
"Return SEMANTIC Context frame rebased onto RUNTIME candidate provider."
(let* ((frame (etaf-context-copy
(etaf--semantic-component-context-frame semantic)))
(parent (and frame (etaf-context-parent frame)))
(provider-id (and parent (etaf-context-owner-id parent)))
(provider (and provider-id
(gethash provider-id
(etaf-runtime-candidate-graph-nodes runtime)))))
(when (and frame (etaf--semantic-component-p provider))
(setf (etaf-context-parent frame)
(etaf--semantic-component-context-frame provider)))
frame))
(defun etaf--runtime-event-kind (property)
"Return event symbol represented by callback PROPERTY."
(intern (substring (symbol-name property) 4)))
(defun etaf--runtime-register-host
(runtime props path &optional site-token old-semantic)
"Register PROPS contributions in RUNTIME for one semantic Host at PATH.
SITE-TOKEN supplies its stable author call-site identity when non-nil.
OLD-SEMANTIC supplies the already-read committed Host, when any."
(let ((host-ref (etaf--generated-host-ref props path site-token))
(tail props)
semantic-p
handlers
old-semantic-p
old-handlers-p)
(while tail
(let ((key (pop tail))
(value (pop tail)))
(when (and value (etaf--semantic-property-p key))
(setq semantic-p t))
(when (and (keywordp key)
(string-prefix-p ":on-" (symbol-name key))
(functionp value))
(push (cons (etaf--runtime-event-kind key) value) handlers))))
(when (etaf--semantic-host-p old-semantic)
(let ((old-props (etaf--semantic-host-base-props old-semantic)))
(while old-props
(let ((key (pop old-props))
(value (pop old-props)))
(when (and value (etaf--semantic-property-p key))
(setq old-semantic-p t))
(when (and (keywordp key)
(string-prefix-p ":on-" (symbol-name key))
(functionp value))
(setq old-handlers-p t))))))
(when (or semantic-p old-semantic-p handlers old-handlers-p)
;; A local Component rerender can remove and recreate the same stable
;; Host reference. Re-registration cancels the candidate tombstone;
;; otherwise the generation contribution index would hide the new
;; handler/property entry behind the old removal.
(setf (etaf-runtime-candidate-removed-host-refs runtime)
(delete host-ref
(etaf-runtime-candidate-removed-host-refs runtime)))
(puthash host-ref (and semantic-p props)
(etaf-runtime-candidate-host-props runtime))
(cond
(handlers
(puthash host-ref handlers
(etaf-runtime-candidate-handlers runtime)))
(old-handlers-p
;; A retained Host can keep its identity while losing its callback.
(puthash host-ref nil
(etaf-runtime-candidate-handlers runtime)))))))
(defun etaf--runtime-candidate-add-child (runtime parent-id child-id)
"Append CHILD-ID to PARENT-ID's candidate semantic order in RUNTIME."
(let* ((children (etaf-runtime-candidate-graph-children runtime))
(tails (etaf-runtime-candidate-graph-child-tails runtime))
(cell (list child-id))
(tail (gethash parent-id tails)))
(if tail
(setcdr tail cell)
(puthash parent-id cell children))
(puthash parent-id cell tails)))
(defun etaf--runtime-range-must-refresh-for-component-input-p (expr)
"Return non-nil when EXPR's value is coupled to a Component rerender.
Compiler-owned branch/keyed programs and compiled direct Expr callsites may
read the current Component props while they materialize. Setup-retained
interpolation programs are opaque values and can safely reuse their Range
when only an unrelated parent structure changed."
(and etaf--rendering-component-effect-p
(or (memq (and (etaf--expr-p expr) (etaf--expr-kind expr))
'(branch keyed-list))
(and (etaf--expr-p expr)
(consp (etaf--expr-token expr))
(eq (car (etaf--expr-token expr)) 'etaf-compiled-site)))))
(defun etaf--runtime-semantic-id-for-identity (runtime identity)
"Return stable semantic id for IDENTITY in RUNTIME's current candidate."
(or (gethash identity (etaf-runtime-candidate-identity-entries runtime))
(and etaf--current-range-item-index
(gethash identity etaf--current-range-item-index))
(and (etaf-runtime-current-generation runtime)
(gethash identity
(etaf-generation-identity-index
(etaf-runtime-current-generation runtime))))
(cl-incf (etaf-runtime-next-semantic-id runtime))))
(defun etaf--runtime-host-property-effect-p (property)
"Return non-nil when PROPERTY can update without changing Host identity."
(and (keywordp property)
(or (ebox-style-schema-id property)
(memq property '(:class)))
(not (memq property '(:key :ref :use)))
(not (string-prefix-p ":on-" (symbol-name property)))))
(defun etaf--runtime-resolve-host-properties (props)
"Resolve Host PROPS and extract independently reactive property bindings.
Return `(RESOLVED BINDINGS DEPS CONTEXT-DEPS)'. Identity, Behavior, and event
properties stay on the enclosing render effect; only Ebox-local properties
receive an independent Host effect."
(let (resolved bindings deps context-deps)
(while props
(let ((property (pop props))
(expression (pop props)))
(if (and (etaf--expr-p expression)
(etaf--runtime-host-property-effect-p property))
(let (local-deps local-context-deps value)
(let ((etaf--runtime-dependency-collector
(lambda (source)
(cl-pushnew source local-deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
local-context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq value (etaf--resolve-property-value expression)))
(when (or local-deps local-context-deps)
(push (etaf--host-property-binding-create
:property property :expression expression)
bindings)
(dolist (source local-deps)
(cl-pushnew source deps :test #'eq))
(dolist (dependency local-context-deps)
(cl-pushnew dependency context-deps :test #'equal)))
(push property resolved)
(push value resolved))
(setq resolved
(cons (etaf--resolve-property-value expression)
(cons property resolved))))))
(list (nreverse resolved) (nreverse bindings) (nreverse deps)
(nreverse context-deps))))
(defun etaf--runtime-register-semantic-host
(runtime name props backend-props path
&optional theme-bindings theme-deps
property-bindings property-deps property-context-deps base-props
site-token)
"Register visual Host NAME at PATH in RUNTIME and return its semantic id."
(let* ((key (plist-get props :key))
(identity (if key
(list 'host etaf--current-semantic-parent-id :key key)
(if site-token
(list 'host etaf--current-semantic-parent-id
:site site-token)
(list 'host etaf--current-semantic-parent-id
:position path))))
(semantic-id (etaf--runtime-semantic-id-for-identity runtime identity))
(old
(and (etaf-runtime-current-generation runtime)
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
semantic-id)))
(_host-contributions
(etaf--runtime-register-host
runtime props path site-token old))
(effect-id
(and (or theme-bindings property-bindings)
(or (and (etaf--semantic-host-p old)
(etaf--semantic-host-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime)))))
(record (etaf--semantic-host-create
:semantic-id semantic-id :identity identity
:parent-id etaf--current-semantic-parent-id
:component-id etaf--current-component-semantic-id
:host-ref (etaf--generated-host-ref props path site-token)
:key key :name name :effect-id effect-id
:property-bindings property-bindings
:theme-bindings theme-bindings
:deps (delete-dups
(append property-deps theme-deps))
:context-deps property-context-deps
:base-props base-props
:site-token site-token
:props-signature backend-props
:path path
:style-identity etaf--render-style-stack)))
(unless etaf--rendering-range-p
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime)))
(puthash semantic-id record (etaf-runtime-candidate-graph-nodes runtime))
(when (and (etaf--semantic-host-p old)
(etaf--semantic-host-effect-id old)
(null effect-id))
(cl-pushnew (etaf--semantic-host-effect-id old)
(etaf-runtime-candidate-removed-effect-ids runtime)
:test #'eql))
(when effect-id
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'host-properties
:semantic-id semantic-id
:deps (copy-sequence (etaf--semantic-host-deps record)))
(etaf-runtime-candidate-effects runtime)))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
semantic-id))
(defun etaf--runtime-finish-semantic-host
(runtime semantic-id &optional content content-parts)
"Seal SEMANTIC-ID Host child order from RUNTIME candidate graph."
(when-let* ((record (gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
(setf (etaf--semantic-host-child-ids record)
(copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime)))
(etaf--semantic-host-content record) (copy-tree content))
(setf (etaf--semantic-host-content-parts record)
(copy-tree content-parts)))
semantic-id)
(defun etaf--runtime-behavior-specs (value)
"Normalize `:use' VALUE to a list of Behavior specs."
(setq value (etaf--resolve-property-value value))
(cl-labels
((resolve
(entry)
(cond
((etaf-behavior-spec-p entry) entry)
((and (symbolp entry) (fboundp entry))
(let ((spec (funcall entry)))
(unless (etaf-behavior-spec-p spec)
(signal 'etaf-behavior-error
(list (format "Behavior constructor %S returned %S"
entry spec))))
spec))
((symbolp entry)
(signal 'etaf-behavior-error
(list (format "Unknown Behavior constructor: %S" entry))))
(t
(signal 'etaf-behavior-error
(list (format "Invalid :use entry: %S" entry)))))))
(let ((specs
(cond
((null value) nil)
((or (symbolp value) (etaf-behavior-spec-p value))
(list (resolve value)))
((proper-list-p value) (mapcar #'resolve value))
(t
(signal
'etaf-behavior-error
(list ":use must be a Behavior symbol, spec, or proper list"))))))
(let (names)
(dolist (spec specs)
(let ((name (etaf-behavior-spec-name spec)))
(when (memq name names)
(signal 'etaf-behavior-error
(list (format "Duplicate Behavior on one Host: %S"
name))))
(push name names))))
specs)))
(defun etaf--runtime-target-value-equal-p (left right)
"Compare LEFT and RIGHT with reactive/function identity rules."
(cond
((or (etaf-ref-p left) (etaf-computed-p left)
(etaf-ref-p right) (etaf-computed-p right))
(eq left right))
((or (functionp left) (functionp right))
(eq left right))
((and (consp left) (consp right))
(and (etaf--runtime-target-value-equal-p (car left) (car right))
(etaf--runtime-target-value-equal-p (cdr left) (cdr right))))
((or (consp left) (consp right)) nil)
(t (equal left right))))
(defun etaf--runtime-behavior-spec-equal-p (left right)
"Return whether Behavior specs LEFT and RIGHT may share installer state."
(and (etaf-behavior-spec-p left)
(etaf-behavior-spec-p right)
(eq (etaf-behavior-spec-name left)
(etaf-behavior-spec-name right))
(eq (etaf-behavior-spec-install left)
(etaf-behavior-spec-install right))
(etaf--runtime-target-value-equal-p
(etaf-behavior-spec-attributes left)
(etaf-behavior-spec-attributes right))))
(defun etaf--compose-event-callbacks (primary secondary)
"Compose two event callbacks in declaration order.
PRIMARY is the explicit Host callback and SECONDARY comes from a Behavior.
The composition belongs to the Runtime event layer, so UI Components do not
need to know how Behavior attributes are merged."
(cond
((not (functionp primary)) secondary)
((not (functionp secondary)) primary)
(t
(lambda (&rest arguments)
(prog1
(apply primary arguments)
(apply secondary arguments))))))
(defun etaf--runtime-install-behavior (runtime spec path props)
"Install Behavior SPEC for RUNTIME at PATH and return its state."
(let ((install (etaf-behavior-spec-install spec))
cleanup)
(when install
(let ((etaf--current-behavior-context
(etaf--behavior-context-create
:runtime runtime :path path :host-props props)))
(setq cleanup (funcall install))))
(unless (or (null cleanup) (functionp cleanup))
(signal 'etaf-behavior-error
(list (format "Behavior %S installer must return cleanup"
(etaf-behavior-spec-name spec)))))
(cons spec cleanup)))
(defun etaf--runtime-behavior-node (runtime node path)
"Install or update NODE's `:use' Behaviors in RUNTIME and return it merged."
(if (not (plist-member (etaf--view-node-props node) :use))
node
(let* ((props (etaf--resolve-property-plist
(etaf--view-node-props node)))
(specs (etaf--runtime-behavior-specs (plist-get props :use)))
(merged (copy-sequence props)))
(dolist (spec specs)
(let* ((identity (list path (etaf-behavior-spec-name spec)))
(old (gethash identity (etaf-runtime-behaviors runtime)))
(same-p (and old
(etaf--runtime-behavior-spec-equal-p
(car old) spec)))
(state (if same-p
old
(etaf--runtime-install-behavior runtime spec path props)))
(resource-key
(if same-p
(and (hash-table-p
(etaf-runtime-behavior-resource-keys runtime))
(gethash identity
(etaf-runtime-behavior-resource-keys runtime)))
(cons (etaf-runtime-mount-epoch runtime)
(cl-incf (etaf-runtime-next-resource-id runtime))))))
(puthash identity state (etaf-runtime-candidate-behaviors runtime))
(puthash identity resource-key
(etaf-runtime-candidate-behavior-resource-keys runtime))
(let ((attributes (etaf-behavior-spec-attributes (car state))))
(while attributes
(let ((key (pop attributes))
(value (pop attributes)))
(if (and (keywordp key)
(string-prefix-p ":on-" (symbol-name key))
(plist-member merged key))
(setq merged
(plist-put
merged key
(etaf--compose-event-callbacks
(plist-get merged key) value)))
(unless (plist-member merged key)
(setq merged (append merged (list key value))))))))))
(etaf--view-node-create
:name (etaf--view-node-name node)
:props merged
:children (etaf--view-node-children node)))))
(defun etaf--runtime-promote-behaviors (runtime retirement-journal)
"Publish RUNTIME Behaviors and enqueue cleanup in RETIREMENT-JOURNAL."
(let ((old-resources (or (etaf-runtime-behavior-resource-keys runtime)
(make-hash-table :test #'equal)))
(candidate-resources
(or (etaf-runtime-candidate-behavior-resource-keys runtime)
(make-hash-table :test #'equal))))
(cl-loop for entry in (sort (let (entries)
(maphash (lambda (key value)
(push (cons key value) entries))
(etaf-runtime-behaviors runtime))
entries)
(lambda (left right)
(string< (prin1-to-string (car left))
(prin1-to-string (car right)))))
for index from 0
do
(let* ((identity (car entry)) (old (cdr entry))
(candidate (gethash identity
(etaf-runtime-candidate-behaviors runtime)))
(old-key (gethash identity old-resources))
(candidate-key (gethash identity candidate-resources)))
(unless (and candidate (eq candidate old))
(when old-key
(remhash old-key (etaf-runtime-resource-registry runtime)))
(when-let* ((cleanup (cdr old)))
(if retirement-journal
(let ((callback cleanup))
(etaf-retirement-enqueue
retirement-journal
:owner (copy-tree identity)
:kind 'behavior-remove
:payload callback
:ordering-key (list 4 index)
:policy 'retryable-idempotent
:max-attempts 2))
(etaf--runtime-run-contained-cleanup
runtime 'behavior-remove identity cleanup))))
(when (and candidate candidate-key)
(puthash candidate-key candidate
(etaf-runtime-resource-registry runtime)))))
;; Candidate resource membership becomes the only generation-visible
;; address set after publication; the state map remains a local disposal
;; index and is never consulted by generation dispatch.
(setf (etaf-runtime-behaviors runtime)
(etaf-runtime-candidate-behaviors runtime)
(etaf-runtime-behavior-resource-keys runtime) candidate-resources
(etaf-runtime-candidate-behaviors runtime) nil
(etaf-runtime-candidate-behavior-resource-keys runtime) nil)))
(defun etaf--runtime-rollback-behaviors (runtime)
"Dispose Behavior installers created by a failed RUNTIME candidate."
(when-let* ((candidate (etaf-runtime-candidate-behaviors runtime)))
(dolist (entry (reverse
(sort (let (entries)
(maphash (lambda (key value)
(push (cons key value) entries))
candidate)
entries)
(lambda (left right)
(string< (prin1-to-string (car left))
(prin1-to-string (car right)))))))
(let* ((identity (car entry)) (state (cdr entry))
(old-state (gethash identity (etaf-runtime-behaviors runtime)))
(candidate-key
(and (hash-table-p
(etaf-runtime-candidate-behavior-resource-keys runtime))
(gethash identity
(etaf-runtime-candidate-behavior-resource-keys
runtime))))
(old-key
(and (hash-table-p (etaf-runtime-behavior-resource-keys runtime))
(gethash identity
(etaf-runtime-behavior-resource-keys runtime))))
(same-state (eq state old-state)))
(unless same-state
(when-let* ((cleanup (cdr state)))
(etaf--runtime-run-contained-cleanup
runtime 'behavior-rollback identity cleanup))
(when (and candidate-key (not (equal candidate-key old-key)))
(remhash candidate-key (etaf-runtime-resource-registry runtime))))))))
(defun etaf--runtime-run-contained-cleanup (runtime phase identity function)
"Run cleanup FUNCTION for IDENTITY and record PHASE failures in RUNTIME."
(let ((inhibit-quit t) (quit-flag nil))
(condition-case condition
(funcall function)
((error quit)
(push (list :phase phase :identity (copy-tree identity)
:condition condition)
(etaf-runtime-diagnostics runtime)))))
nil)
(defun etaf--runtime-call-key (call path)
"Return retained identity for CALL at PATH, honoring an optional `:key'."
(let* ((props (etaf--component-call-props call))
(key (and (plist-member props :key)
(etaf--resolve-property-value (plist-get props :key)))))
(when key
(etaf--validate-key key))
(if key
(append (butlast path) (list :key key))
path)))
(defun etaf--runtime-owned-slots (slots)
"Attach current caller ownership to unowned normalized SLOTS."
(mapcar
(lambda (entry)
(let* ((name (car entry)) (value (cdr entry))
;; Code-mode forwarding uses `etaf-current-slot', which exposes
;; the owned child list rather than the private SlotContent
;; wrapper. Recover the wrapper by spine identity so the
;; original author Component remains the lifecycle owner.
(forwarded-content
(cl-loop for forwarded in etaf--current-component-slots
for content = (cdr forwarded)
when (and (etaf--slot-content-p content)
value
(or (eq value
(etaf--slot-content-children content))
(equal-including-properties
value
(etaf--slot-content-children content))))
return content)))
(cond
((etaf--slot-content-p value) entry)
(forwarded-content (cons name forwarded-content))
((and (= (length value) 1)
(etaf--slot-projection-p (car value)))
(let* ((projection (car value))
(forwarded (assq (etaf--slot-projection-name projection)
etaf--current-component-slots)))
(if (and forwarded (etaf--slot-content-p (cdr forwarded)))
(cons name (cdr forwarded))
(cons name
(etaf--slot-content-create
:owner-component-id etaf--current-component-semantic-id
:children value)))))
(t
(cons name
(etaf--slot-content-create
:owner-component-id etaf--current-component-semantic-id
:children value))))))
slots))
(defun etaf--runtime-new-instance (runtime spec identity)
"Create and register IDENTITY's Component instance for RUNTIME from SPEC."
(let* ((resource-id (cl-incf (etaf-runtime-next-resource-id runtime)))
(resource-key (cons (etaf-runtime-mount-epoch runtime) resource-id))
(instance
(etaf--component-instance-create
:spec spec
:identity identity
:scope (let ((etaf--render-phase-p nil))
(etaf-effect-scope :name identity))
:context (etaf--context-create :parent etaf--current-context)
:resource-key resource-key)))
(push instance (etaf-runtime-candidate-created runtime))
instance))
(defun etaf--runtime-instance-for-call (runtime call path)
"Return retained Component instance for CALL at PATH in RUNTIME."
(let* ((spec (etaf--component-call-spec call))
(identity (list (etaf--component-spec-name spec)
(etaf--runtime-call-key call path)))
(old-semantic
(and (etaf-runtime-current-generation runtime)
(etaf--generation-semantic
(etaf-runtime-current-generation runtime) identity)))
(old (and old-semantic
(gethash (etaf--semantic-component-resource-key old-semantic)
(etaf-runtime-resource-registry runtime))))
(staged (gethash identity (etaf-runtime-candidate-live runtime)))
(instance (cond
((etaf--component-instance-p staged) staged)
((and old (eq (etaf--component-instance-spec old) spec)) old)
(old
(push (list identity old)
(etaf-runtime-candidate-old-instances runtime))
(etaf--runtime-new-instance runtime spec identity))
(t
(etaf--runtime-new-instance runtime spec identity)))))
(puthash identity instance (etaf-runtime-candidate-live runtime))
instance))
(defun etaf--run-hooks (hooks)
"Run HOOKS in registration order."
(dolist (hook (reverse hooks))
(funcall hook)))
(defun etaf--runtime-render-component-resource
(runtime instance identity props attrs slots path
&optional old-output-range-id old-publication-kind old-context-frame)
"Render RUNTIME candidate IDENTITY from resource INSTANCE without mutation."
(let* ((spec (etaf--component-instance-spec instance))
(setup (etaf--component-spec-setup spec)))
(let ((candidate-context
(if old-context-frame
(etaf-context-copy old-context-frame)
(etaf--component-instance-context instance))))
(let ((etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(etaf--component-instance-state instance))
(etaf--current-component-setup-defined-p (not (null setup)))
(etaf--current-component-setup-complete-p
(etaf--component-instance-setup-complete-p instance))
(etaf--component-phase 'render)
(etaf--current-component-identity identity)
(etaf--current-component-props props)
(etaf--current-component-slots slots)
(etaf--raw-slot-read-p nil)
(etaf--current-context candidate-context)
(etaf--render-runtime runtime)
(etaf--render-parent-style-stack etaf--render-style-stack)
(etaf--render-style-stack
(list
(cons (etaf--component-spec-styles spec)
(append path (list :view))))))
(when (and setup
(not (etaf--component-instance-setup-complete-p instance)))
(let ((state
(etaf-scope-run
(etaf--component-instance-scope instance)
(lambda ()
(let ((etaf--runtime-dependency-collector nil)
(etaf--tracking-enabled-p nil)
(etaf--active-effect nil)
(etaf--render-phase-p nil)
(etaf--component-phase 'setup))
(funcall setup props slots)))
:watch-scheduler
(lambda (job phase)
(etaf--runtime-watch-scheduler runtime job phase)))))
(when (functionp state)
(signal 'etaf-runtime-error
(list (format
"Component %S :setup returned a function"
(etaf--component-spec-name spec)))))
(setf (etaf--component-instance-state instance) state
(etaf--component-instance-setup-complete-p instance) t
etaf--current-component-state state
etaf--current-component-setup-complete-p t)))
(let* ((render-function (etaf--component-spec-render spec))
(rendered
(etaf--validate-component-render-result
(funcall render-function props slots)
(etaf--component-spec-name spec)))
(rendered
(etaf--apply-component-attrs
rendered attrs (etaf--component-spec-name spec)))
(transparent-p
(and (not (eq old-publication-kind 'material))
(etaf--runtime-transparent-output-p rendered)))
(component-id etaf--current-semantic-parent-id)
(range-id (and transparent-p
(or old-output-range-id
(cl-incf (etaf-runtime-next-semantic-id runtime)))))
(old-range (and old-output-range-id
(etaf-runtime-current-generation runtime)
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
old-output-range-id)))
(nodes
(let ((etaf--current-semantic-parent-id
(or range-id etaf--current-semantic-parent-id))
(etaf--current-range-item-index
(or (and old-range
(etaf--semantic-range-item-identity-index
old-range))
etaf--current-range-item-index))
;; Rendering below a retained Range changes only how this
;; Component publishes its own output. Descendant Range
;; anchors remain semantic children and are never folded
;; into their ancestor's identity.
(etaf--rendering-range-p
(or transparent-p etaf--rendering-range-p)))
(etaf--render-value-list rendered
(append path (list :view))))))
(when (cl-some (lambda (node)
(memq node etaf--rendered-range-container-nodes))
nodes)
(setq transparent-p nil))
;; An unretained/raw slot projection still owns its structure through
;; the Component render target. Keep that existing material boundary
;; until every projection is represented by a semantic slot Range.
(when etaf--raw-slot-read-p
(setq transparent-p nil))
(when (and transparent-p
(cl-some
(lambda (child-id)
(let ((child
(gethash child-id
(etaf-runtime-candidate-graph-nodes
runtime))))
(or
(and (etaf--semantic-component-p child)
(eq
(etaf--semantic-component-publication-kind child)
'material))
(and (cl-every #'listp nodes)
(or (etaf--semantic-slot-range-p child)
(and (etaf--semantic-range-p child)
(not (eq
(etaf--semantic-range-kind child)
'component-output))))))))
(etaf--runtime-candidate-descendant-ids
runtime
(gethash range-id
(etaf-runtime-candidate-graph-children runtime))))
;; A single explicit Host anchor is the reviewed escape
;; for a retained page/slot Range: material Components may
;; live below that Host without collapsing the Range back
;; into its parent Component. The Host remains the sole
;; visual item and the normal backend identity proof still
;; validates its subtree.
(not (and (= (length nodes) 1)
(etaf--semantic-host-p
(gethash
(car (gethash range-id
(etaf-runtime-candidate-graph-children
runtime)))
(etaf-runtime-candidate-graph-nodes
runtime))))))
(unless (null (cdr nodes))
(signal 'etaf-runtime-error
(list "Transparent sequence containing a material Component requires an explicit Host")))
(setq transparent-p nil)
(let ((children
(copy-sequence
(gethash range-id
(etaf-runtime-candidate-graph-children runtime)))))
(puthash component-id children
(etaf-runtime-candidate-graph-children runtime))
(remhash range-id (etaf-runtime-candidate-graph-children runtime))
(dolist (child-id children)
(when-let* ((child
(gethash child-id
(etaf-runtime-candidate-graph-nodes runtime))))
(let ((copy (copy-sequence child)))
(cond ((etaf--semantic-component-p copy)
(setf (etaf--semantic-component-parent-id copy)
component-id))
((etaf--semantic-host-p copy)
(setf (etaf--semantic-host-parent-id copy) component-id)))
(puthash child-id copy
(etaf-runtime-candidate-graph-nodes runtime)))))))
(let ((node
(unless transparent-p
(etaf--ebox-forest-root
nodes
(list 'etaf-component-root
(copy-tree
(etaf--component-instance-identity instance)))))))
(when node
(let ((range-container-p
(memq node etaf--rendered-range-container-nodes)))
(setq node (copy-sequence node))
(when range-container-p
(push node etaf--rendered-range-container-nodes))))
(list node rendered etaf--raw-slot-read-p nodes
(if transparent-p 'transparent 'material)
range-id candidate-context)))))))
(defun etaf--runtime-transparent-output-p (value)
"Return whether VALUE has a transparent Component output boundary."
(or (null value)
(and (proper-list-p value) (not (etaf--view-node-p value)))
(and (etaf--view-node-p value)
(eq (etaf--view-node-name value) 'fragment))))
(defun etaf--runtime-stage-component-output-range
(runtime old component-id _component-effect-id semantic-id rendered nodes path)
"Stage transparent COMPONENT-ID output NODES in RUNTIME from OLD state."
(let* ((old-range (and old
(etaf--semantic-component-output-range-id old)
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
(etaf--semantic-component-output-range-id old))))
(range-ref (or (and old-range
(etaf--semantic-range-range-ref old-range))
(list 'etaf-component-output
(etaf-runtime-mount-epoch runtime) semantic-id)))
(effect-id (or (and old-range
(etaf--semantic-range-effect-id old-range))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(identity (list 'component-output-range component-id))
(child-ids (copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime))))
(all-item-ids
(etaf--runtime-candidate-descendant-ids runtime child-ids))
(item-index (make-hash-table :test #'equal))
(record
(etaf--semantic-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id
:kind 'component-output :parent-id component-id
:component-id component-id :token 'component-output
:range-ref range-ref :path (copy-tree path)
:caller-style-stack (copy-tree etaf--render-style-stack)
:output-signature (copy-tree rendered) :deps nil
:artifact-key (list (1+ (etaf-runtime-generation runtime))
'component-output effect-id)
:item-root-ids child-ids :item-identity-index item-index)))
(dolist (child-id child-ids)
(when-let* ((child (gethash child-id
(etaf-runtime-candidate-graph-nodes runtime))))
(let ((copy (copy-sequence child)))
(cond ((etaf--semantic-host-p copy)
(setf (etaf--semantic-host-parent-id copy) semantic-id)
(puthash (etaf--semantic-host-identity copy) child-id item-index))
((etaf--semantic-component-p copy)
(setf (etaf--semantic-component-parent-id copy) semantic-id))
((etaf--semantic-range-p copy)
(setf (etaf--semantic-range-parent-id copy) semantic-id))
((etaf--semantic-slot-range-p copy)
(setf (etaf--semantic-slot-range-parent-id copy) semantic-id)))
(puthash child-id copy
(etaf-runtime-candidate-graph-nodes runtime)))))
(dolist (item-id all-item-ids)
(when-let* ((item (gethash item-id
(etaf-runtime-candidate-graph-nodes runtime))))
(when (etaf--semantic-host-p item)
(puthash (etaf--semantic-host-identity item) item-id item-index))))
(when old-range
(let ((new-set (make-hash-table :test #'eql)))
(dolist (item-id all-item-ids) (puthash item-id t new-set))
(dolist (old-id
(etaf--runtime-generation-descendant-ids
(etaf-runtime-current-generation runtime)
(etaf--semantic-range-item-root-ids old-range)))
(unless (gethash old-id new-set)
(push old-id
(etaf-runtime-candidate-removed-semantic-ids runtime))))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(puthash semantic-id record
(etaf-runtime-candidate-graph-nodes runtime))
(puthash semantic-id child-ids
(etaf-runtime-candidate-graph-children runtime))
(puthash component-id (list semantic-id)
(etaf-runtime-candidate-graph-children runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'component-output
:semantic-id semantic-id :deps nil)
(etaf-runtime-candidate-effects runtime))
(dolist (child-id child-ids)
(when-let* ((child (gethash child-id
(etaf-runtime-candidate-graph-nodes runtime))))
(let ((nested
(cond
((etaf--semantic-component-p child)
(and (etaf--semantic-component-output-range-id child)
(gethash (etaf--semantic-component-output-range-id child)
(etaf-runtime-candidate-graph-nodes runtime))))
((or (etaf--semantic-range-p child)
(etaf--semantic-slot-range-p child))
child))))
(when nested
(let ((copy (copy-sequence nested)))
(if (etaf--semantic-slot-range-p copy)
(setf (etaf--semantic-slot-range-range-ref copy) range-ref)
(setf (etaf--semantic-range-range-ref copy) range-ref))
(puthash (if (etaf--semantic-slot-range-p copy)
(etaf--semantic-slot-range-semantic-id copy)
(etaf--semantic-range-semantic-id copy))
copy (etaf-runtime-candidate-graph-nodes runtime)))))))
(list record (apply #'ebox-child-range range-ref nodes))))
(defun etaf--runtime-render-component (runtime call path)
"Render CALL through retained RUNTIME at PATH to one Ebox node."
(let* ((parent etaf--current-component-identity)
(parent-semantic
(and parent (etaf-runtime-current-generation runtime)
(etaf--generation-semantic
(etaf-runtime-current-generation runtime) parent)))
(parent-resource
(and parent-semantic
(gethash (etaf--semantic-component-resource-key parent-semantic)
(etaf-runtime-resource-registry runtime))))
(instance
(let ((etaf--active-scope
(and parent-resource
(etaf--component-instance-scope parent-resource))))
(etaf--runtime-instance-for-call runtime call path)))
(identity (etaf--component-instance-identity instance))
(slots (etaf--runtime-owned-slots (etaf--component-call-slots call)))
(old-generation (etaf-runtime-current-generation runtime))
(old (and old-generation
(etaf--generation-semantic old-generation identity)))
(input-effect-id
(or (and old (etaf--semantic-component-input-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(effect-id (or (and old (etaf--semantic-component-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(semantic-id (or (and old (etaf--semantic-component-semantic-id old))
(cl-incf (etaf-runtime-next-semantic-id runtime))))
(input-props (etaf--component-business-props call))
(input-attrs (etaf--component-call-attrs call))
props attrs input-deps render-deps context-deps slot-retargeted-p)
(unless (etaf-context-owner-id (etaf--component-instance-context instance))
(setf (etaf-context-owner-id (etaf--component-instance-context instance))
semantic-id))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source input-deps :test #'eq)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq props (etaf--resolve-property-plist input-props)
attrs (etaf--resolve-property-plist input-attrs)))
(puthash semantic-id
(list :identity identity :instance instance
:props props :attrs attrs :slots slots)
(etaf-runtime-candidate-component-envs runtime))
(when (and old
(or etaf--rendering-component-effect-p
(not (equal-including-properties
slots (etaf--semantic-component-slots old))))
(not (etaf--semantic-component-raw-slot-reader-p old)))
(setq slot-retargeted-p
(etaf--runtime-retarget-component-slot-ranges runtime old slots)))
(if (not (or (null old)
etaf--runtime-force-full-component-render-p
(gethash input-effect-id
(etaf-runtime-dirty-effect-ids runtime))
(gethash effect-id (etaf-runtime-dirty-effect-ids runtime))
(and slots etaf--rendering-component-effect-p
(not slot-retargeted-p))
(not (equal-including-properties
props (etaf--semantic-component-props old)))
(not (equal-including-properties
attrs (etaf--semantic-component-attrs old)))
(and (not slot-retargeted-p)
(not (equal-including-properties
slots (etaf--semantic-component-slots old))))))
(progn
(when (or (etaf-runtime-candidate-full-rebuild-p runtime)
etaf--rendering-range-p)
(etaf--runtime-carry-committed-subtree runtime old-generation old))
(if (eq (etaf--semantic-component-publication-kind old) 'transparent)
(let* ((range
(etaf--generation-component-output-range
old-generation old))
(input (etaf--runtime-committed-range-input runtime range)))
(if (or etaf--rendering-range-p
(= etaf--current-semantic-parent-id
(etaf-runtime-root-range-id runtime)))
(cons 'component-output-range input)
(list 'component-output-anchor
(etaf--semantic-range-range-ref range) input)))
(let ((input
(and (etaf--semantic-component-artifact-key old)
(gethash (etaf--semantic-component-artifact-key old)
(etaf-runtime-artifact-registry runtime)))))
(unless input
(setq input
(etaf--runtime-rebuild-component-artifact runtime old))
(puthash identity old
(etaf-runtime-candidate-semantic-nodes runtime))
(puthash semantic-id old
(etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id input
(etaf-runtime-candidate-artifacts runtime)))
(unless (ebox-canonical-input-p input)
(signal 'etaf-runtime-error
(list "Material Component artifact is not canonical input")))
;; Local overlays do not copy a whole unchanged descendant
;; subtree. Preserve the artifact root's contribution entry so
;; a stable interactive child remains dispatchable without
;; traversing unrelated descendants.
(let ((host-ref (ebox-canonical-input-root-host-ref input)))
(when-let* ((handlers
(etaf--generation-index-lookup
old-generation 'handlers host-ref)))
(puthash host-ref (copy-tree handlers)
(etaf-runtime-candidate-handlers runtime)))
(when-let* ((host-props
(etaf--generation-index-lookup
old-generation 'host-props host-ref)))
(puthash host-ref (copy-tree host-props)
(etaf-runtime-candidate-host-props runtime))))
(cons 'component-output-material input))))
(let ((builder (ebox-source-builder-create)) result)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source render-deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--current-component-semantic-id semantic-id)
(etaf--current-semantic-parent-id semantic-id)
(etaf--ebox-source-builder builder)
(etaf--rendering-component-effect-p t)
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq result
(etaf--runtime-render-component-resource
runtime instance identity props attrs slots path
(and old (etaf--semantic-component-output-range-id old))
(and old (etaf--semantic-component-publication-kind old))
(and old (etaf--semantic-component-context-frame old)))))
(cl-destructuring-bind
(material-root output-signature raw-slot-reader-p output-nodes
publication-kind range-id context-frame)
result
(let* ((transparent-p (eq publication-kind 'transparent))
(output-range
(and transparent-p
(let ((etaf--ebox-source-builder builder))
(etaf--runtime-stage-component-output-range
runtime old semantic-id effect-id range-id
output-signature output-nodes path))))
(_material-root
(unless (or transparent-p material-root)
(signal 'etaf-runtime-error
(list "Material Component has no canonical root"))))
(input
(ebox-canonical-input-create
(if transparent-p
(copy-sequence output-nodes)
(list material-root))
(ebox-source-builder-finish builder)))
(semantic
(etaf--semantic-component-create
:semantic-id semantic-id
:identity (copy-tree identity)
:input-effect-id input-effect-id :effect-id effect-id
:resource-key
(copy-tree (etaf--component-instance-resource-key instance))
:props (copy-tree props) :attrs (copy-tree attrs)
:slots (copy-tree slots)
:input-props (copy-tree input-props)
:input-attrs (copy-tree input-attrs)
:input-slots (copy-tree slots)
:output-signature (copy-tree output-signature)
:artifact-key (and (not transparent-p) effect-id)
:path (copy-tree path)
:caller-style-stack (copy-tree etaf--render-style-stack)
:input-deps (nreverse input-deps)
:deps (nreverse render-deps)
:parent-id etaf--current-semantic-parent-id
:caller-component-id etaf--current-component-semantic-id
:raw-slot-reader-p raw-slot-reader-p
:publication-kind publication-kind
:output-range-id
(and transparent-p
(etaf--semantic-range-semantic-id (car output-range)))
:context-frame (etaf-context-copy context-frame)
:context-deps (nreverse context-deps)
:child-ids
(copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime))))))
(puthash identity semantic
(etaf-runtime-candidate-semantic-nodes runtime))
(puthash semantic-id semantic
(etaf-runtime-candidate-graph-nodes runtime))
(puthash input-effect-id
(etaf--generation-effect-create
:effect-id input-effect-id :kind 'component-input
:semantic-id semantic-id
:deps (etaf--semantic-component-input-deps semantic))
(etaf-runtime-candidate-effects runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'component-render
:semantic-id semantic-id
:deps (etaf--semantic-component-deps semantic))
(etaf-runtime-candidate-effects runtime))
(if transparent-p
(puthash (etaf--semantic-range-effect-id (car output-range))
input
(etaf-runtime-candidate-range-artifacts runtime))
(puthash effect-id input
(etaf-runtime-candidate-artifacts runtime)))
(push identity (etaf-runtime-candidate-rendered-identities runtime))
(cond
((not transparent-p)
(cons 'component-output-material input))
((or etaf--rendering-range-p
(= etaf--current-semantic-parent-id
(etaf-runtime-root-range-id runtime)))
(cons 'component-output-range input))
(t
(list 'component-output-anchor
(etaf--semantic-range-range-ref (car output-range))
input)))))))))
(defun etaf--runtime-lower-semantic-artifact (runtime generation semantic-id)
"Purely lower SEMANTIC-ID from GENERATION and RUNTIME Range artifacts."
(let ((semantic (etaf--pvec-get
(etaf-generation-semantic-nodes generation) semantic-id)))
(cond
((or (etaf--semantic-range-p semantic)
(etaf--semantic-slot-range-p semantic))
(apply #'ebox-child-range
(etaf--semantic-backend-range-ref semantic)
(copy-sequence
(etaf--runtime-range-nodes runtime semantic))))
((etaf--semantic-component-p semantic)
(let ((nodes (mapcar
(lambda (child-id)
(etaf--runtime-lower-semantic-artifact
runtime generation child-id))
(etaf--semantic-component-child-ids semantic))))
(let ((node
(etaf--ebox-forest-root
nodes
(list 'etaf-component-root
(copy-tree
(etaf--semantic-component-identity semantic))))))
(if (eq (etaf--semantic-component-publication-kind semantic)
'transparent)
node
node))))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-output semantic))
((etaf--semantic-host-p semantic)
(let* ((name (etaf--semantic-host-name semantic))
(props (copy-tree (etaf--semantic-host-props-signature semantic)))
(child-ids (etaf--semantic-host-child-ids semantic))
(content
(if (eq name 'text)
(if (etaf--semantic-host-content-parts semantic)
(apply #'concat
(mapcar
(lambda (part)
(if (integerp part)
(etaf--semantic-inline-range-output
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
part))
part))
(etaf--semantic-host-content-parts semantic)))
(etaf--semantic-host-content semantic))
(etaf--semantic-host-content semantic)))
(children
(unless (eq name 'text)
(mapcar
(lambda (child-id)
(etaf--runtime-lower-semantic-artifact
runtime generation child-id))
child-ids)))
(range-child-p
(cl-some
(lambda (child-id)
(let ((child (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
child-id)))
(or (etaf--semantic-range-p child)
(etaf--semantic-slot-range-p child))))
child-ids)))
(etaf--lower-resolved-semantic-host
name props content
children range-child-p)))
(t (signal 'etaf-runtime-error
(list "Missing semantic artifact node" semantic-id))))))
(defun etaf--runtime-lower-semantic-host-content-input (semantic content)
"Lower SEMANTIC Host with resolved CONTENT into one atomic input."
(let ((builder (ebox-source-builder-create)))
(let* ((etaf--ebox-source-builder builder)
(node
(etaf--lower-resolved-semantic-host
(etaf--semantic-host-name semantic)
(copy-tree (etaf--semantic-host-props-signature semantic))
(copy-sequence (or content ""))
nil nil)))
(ebox-canonical-input-create
(list node) (ebox-source-builder-finish builder)))))
(defun etaf--runtime-lower-semantic-host-shallow (semantic)
"Lower only SEMANTIC Host into one atomic input for a property patch."
(etaf--runtime-lower-semantic-host-content-input
semantic (etaf--semantic-host-content semantic)))
(defun etaf--runtime-lower-semantic-input (runtime generation semantic-id)
"Lower RUNTIME GENERATION SEMANTIC-ID into one atomic canonical input."
(let ((builder (ebox-source-builder-create)))
(let* ((etaf--ebox-source-builder builder)
(node
(etaf--runtime-lower-semantic-artifact
runtime generation semantic-id)))
(ebox-canonical-input-create
(list node) (ebox-source-builder-finish builder)))))
(defun etaf--runtime-component-artifact-from-generation
(runtime generation semantic)
"Build material RUNTIME SEMANTIC input from immutable GENERATION."
(unless (eq (etaf--semantic-component-publication-kind semantic) 'material)
(signal 'etaf-runtime-error
(list "Transparent Component backend input belongs to its Range")))
(let ((builder (ebox-source-builder-create)))
(let* ((etaf--ebox-source-builder builder)
(nodes
(mapcar
(lambda (child-id)
(etaf--runtime-lower-semantic-artifact
runtime generation child-id))
(etaf--semantic-component-child-ids semantic)))
(root
(etaf--ebox-forest-root
nodes
(list 'etaf-component-root
(copy-tree (etaf--semantic-component-identity semantic))))))
(ebox-canonical-input-create
(list root) (ebox-source-builder-finish builder)))))
(defun etaf--runtime-rebuild-component-artifact (runtime semantic)
"Rebuild material RUNTIME SEMANTIC input without application code."
(etaf--runtime-component-artifact-from-generation
runtime (etaf-runtime-current-generation runtime) semantic))
(defun etaf--runtime-carry-committed-subtree (runtime generation semantic)
"Carry RUNTIME SEMANTIC and its GENERATION children during Root traversal."
(let* ((semantic-id
(cond ((etaf--semantic-component-p semantic)
(etaf--semantic-component-semantic-id semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-semantic-id semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-semantic-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-semantic-id semantic))
(t (etaf--semantic-inline-range-semantic-id semantic))))
(identity
(cond ((etaf--semantic-component-p semantic)
(etaf--semantic-component-identity semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-identity semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-identity semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-identity semantic))
(t (etaf--semantic-inline-range-identity semantic))))
(children
(cond ((etaf--semantic-component-p semantic)
(etaf--semantic-component-child-ids semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-child-ids semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-item-root-ids semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-item-root-ids semantic))
(t nil))))
(unless (and (etaf--semantic-host-p semantic)
(etaf--semantic-range-p
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
(etaf--semantic-host-parent-id semantic))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime)))
(puthash semantic-id semantic (etaf-runtime-candidate-graph-nodes runtime))
(when (and (etaf--semantic-host-p semantic)
(etaf--semantic-host-host-ref semantic))
(let ((host-ref (etaf--semantic-host-host-ref semantic)))
(when-let* ((handlers
(etaf--generation-index-lookup
generation 'handlers host-ref)))
(puthash host-ref (copy-tree handlers)
(etaf-runtime-candidate-handlers runtime)))
(when-let* ((props
(etaf--generation-index-lookup
generation 'host-props host-ref)))
(puthash host-ref (copy-tree props)
(etaf-runtime-candidate-host-props runtime)))))
(when (and (etaf--semantic-host-p semantic)
(etaf--semantic-host-effect-id semantic))
(let ((effect
(or (etaf--pvec-get
(etaf-generation-effect-map generation)
(etaf--semantic-host-effect-id semantic))
(etaf--generation-effect-create
:effect-id (etaf--semantic-host-effect-id semantic)
:kind 'host-properties :semantic-id semantic-id
:deps (etaf--semantic-host-deps semantic)))))
(puthash (etaf--generation-effect-effect-id effect) effect
(etaf-runtime-candidate-effects runtime))))
(when (etaf--semantic-component-p semantic)
(puthash identity semantic (etaf-runtime-candidate-semantic-nodes runtime))
(puthash identity
(gethash (etaf--semantic-component-resource-key semantic)
(etaf-runtime-resource-registry runtime))
(etaf-runtime-candidate-live runtime))
(dolist (entry
(list
(etaf--generation-effect-create
:effect-id (etaf--semantic-component-input-effect-id semantic)
:kind 'component-input :semantic-id semantic-id
:deps (etaf--semantic-component-input-deps semantic))
(etaf--generation-effect-create
:effect-id (etaf--semantic-component-effect-id semantic)
:kind 'component-render :semantic-id semantic-id
:deps (etaf--semantic-component-deps semantic))))
(puthash (etaf--generation-effect-effect-id entry) entry
(etaf-runtime-candidate-effects runtime))))
(when (etaf--semantic-range-p semantic)
(let ((effect
(or (etaf--pvec-get
(etaf-generation-effect-map generation)
(etaf--semantic-range-effect-id semantic))
(etaf--generation-effect-create
:effect-id (etaf--semantic-range-effect-id semantic)
:kind 'range :semantic-id semantic-id
:deps (etaf--semantic-range-deps semantic)))))
(puthash (etaf--generation-effect-effect-id effect) effect
(etaf-runtime-candidate-effects runtime))))
(when (etaf--semantic-inline-range-p semantic)
(let ((effect
(etaf--pvec-get
(etaf-generation-effect-map generation)
(etaf--semantic-inline-range-effect-id semantic))))
(puthash (etaf--generation-effect-effect-id effect) effect
(etaf-runtime-candidate-effects runtime))))
(when (etaf--semantic-slot-range-p semantic)
(let ((effect
(etaf--pvec-get
(etaf-generation-effect-map generation)
(etaf--semantic-slot-range-effect-id semantic))))
(puthash (etaf--generation-effect-effect-id effect) effect
(etaf-runtime-candidate-effects runtime))))
(puthash semantic-id (copy-sequence children)
(etaf-runtime-candidate-graph-children runtime))
(dolist (child-id children)
(when-let* ((child (etaf--pvec-get
(etaf-generation-semantic-nodes generation) child-id)))
(etaf--runtime-carry-committed-subtree runtime generation child)))))
(defun etaf--runtime-render-child-range (runtime expr path &optional kind)
"Lower RUNTIME direct material-child EXPR at PATH as retained Range KIND."
(let* ((token (etaf--expr-token expr))
(identity (list 'range etaf--current-semantic-parent-id
(or token (copy-tree path))))
(old-generation (etaf-runtime-current-generation runtime))
(old-id (and old-generation
(gethash identity
(etaf-generation-identity-index old-generation))))
(old (and old-id
(etaf--pvec-get (etaf-generation-semantic-nodes old-generation)
old-id)))
(candidate (and old-id
(gethash old-id
(etaf-runtime-candidate-graph-nodes runtime))))
(semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime))))
(effect-id (or (and old (etaf--semantic-range-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(range-ref (or (and old (etaf--semantic-range-range-ref old))
(list 'etaf-range (etaf-runtime-mount-epoch runtime)
semantic-id))))
(if candidate
(progn
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(cons 'range
(list
(apply #'ebox-child-range range-ref
(copy-sequence
(etaf--runtime-range-nodes runtime candidate))))))
(if (and old
;; A parent Component may rerender because a preceding static
;; sibling changed while this direct Range did not. Its stable
;; site token and retained artifact are sufficient to reuse the
;; Range; a genuinely dirty Range effect still takes the render
;; branch below.
(not (etaf--runtime-range-must-refresh-for-component-input-p
expr))
(not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime))))
(progn
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(when (etaf-runtime-candidate-full-rebuild-p runtime)
(etaf--runtime-carry-committed-subtree runtime old-generation old))
(cons 'range
(list
(apply #'ebox-child-range range-ref
(copy-sequence
(etaf--runtime-range-nodes runtime old))))))
(let (deps context-deps value nodes keyed-snapshot range-render)
(let ((collector
(lambda (source) (cl-pushnew source deps :test #'eq))))
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq keyed-snapshot
(etaf--runtime-keyed-range-snapshot expr))
(setq value
(etaf--runtime-normalize-range-value
;; Keyed item renderers may intentionally return a
;; transparent Component span; ordinary direct Expr
;; ranges still fail closed on Component output.
(if keyed-snapshot
(etaf--keyed-program-outputs expr keyed-snapshot)
(funcall (etaf--expr-thunk expr)))
(not (null keyed-snapshot)))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--current-semantic-parent-id semantic-id)
(etaf--current-range-item-index
(and old (etaf--semantic-range-item-identity-index old)))
(etaf--rendering-range-p t)
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq range-render
(etaf--runtime-render-range-items
value path expr keyed-snapshot)
nodes (plist-get range-render :nodes))))
(let* ((item-root-ids
(copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime))))
(all-item-ids
(etaf--runtime-candidate-descendant-ids runtime item-root-ids))
(item-index (make-hash-table :test #'equal))
(keyed
(etaf--runtime-keyed-range-metadata
expr keyed-snapshot
(plist-get range-render :item-root-groups)
(plist-get range-render :item-node-counts)))
(input (etaf--ebox-input-for-nodes nodes))
(record
(etaf--semantic-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id
:kind (or kind 'range)
:parent-id etaf--current-semantic-parent-id
:component-id etaf--current-component-semantic-id
:token token :range-ref range-ref :path (copy-tree path)
:caller-style-stack (copy-tree etaf--render-style-stack)
:output-signature (copy-tree value) :deps (nreverse deps)
:context-deps (nreverse context-deps)
:artifact-key (cons (1+ (etaf-runtime-generation runtime))
effect-id)
:item-root-ids item-root-ids
:item-identity-index item-index
:keyed-context-signature (plist-get keyed :context)
:keyed-item-signatures (plist-get keyed :signatures)
:keyed-item-root-id-index (plist-get keyed :root-id-index)
:keyed-item-node-span-index
(plist-get keyed :node-span-index)
:keyed-key-order (plist-get keyed :keys))))
(etaf--runtime-index-range-item-identities
runtime all-item-ids item-index)
(when old
(let ((new-set (make-hash-table :test #'eql)))
(dolist (item-id all-item-ids) (puthash item-id t new-set))
(dolist (old-id
(etaf--runtime-generation-descendant-ids
old-generation
(etaf--semantic-range-item-root-ids old)))
(unless (gethash old-id new-set)
(push old-id
(etaf-runtime-candidate-removed-semantic-ids runtime))))))
(puthash semantic-id record
(etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind (or kind 'range)
:semantic-id semantic-id
:deps (etaf--semantic-range-deps record) :target expr)
(etaf-runtime-candidate-effects runtime))
(puthash effect-id input
(etaf-runtime-candidate-range-artifacts runtime))
(when (and old
(not (ebox-canonical-input-equal-p
(etaf--runtime-committed-range-input runtime old)
input)))
(push (list old record
(etaf--runtime-committed-range-input runtime old)
input nil)
(etaf-runtime-candidate-eager-range-changes runtime))
(etaf--runtime-invalidate-range-ancestors runtime old)
(etaf--runtime-record-range-owner-update runtime old))
(cons 'range
(list (apply #'ebox-child-range range-ref nodes)))))))))
(defun etaf--runtime-render-fragment-range (runtime fragment path)
"Lower material-child FRAGMENT at PATH in RUNTIME as one retained Range."
(let* ((expr (etaf--expr-create
:token (etaf--view-node-token fragment)
:thunk (lambda () (etaf--view-node-children fragment)))))
(etaf--runtime-render-child-range runtime expr path 'fragment)))
(defun etaf--runtime-render-slot-range (runtime projection path)
"Lower material-child PROJECTION at PATH in RUNTIME as a retained slot Range."
(let* ((name (etaf--slot-projection-name projection))
(entry (assq name etaf--current-component-slots))
(content (and entry (cdr entry)))
(provided-p (and entry t))
(children (if (etaf--slot-content-p content)
(etaf--slot-content-children content)
(or content (etaf--slot-projection-fallback projection))))
(owner-id (if provided-p
(and (etaf--slot-content-p content)
(etaf--slot-content-owner-component-id content))
etaf--current-component-semantic-id))
(consumer-id etaf--current-component-semantic-id)
(style-stack (copy-tree (if provided-p
etaf--render-parent-style-stack
etaf--render-style-stack)))
(token (etaf--slot-projection-token projection))
(identity (list 'slot-range etaf--current-semantic-parent-id
(or token (copy-tree path)) name))
(generation (etaf-runtime-current-generation runtime))
(old-id (and generation
(gethash identity (etaf-generation-identity-index generation))))
(old (and old-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
old-id)))
(old-effect
(and old
(etaf--pvec-get (etaf-generation-effect-map generation)
(etaf--semantic-slot-range-effect-id old))))
(candidate (and old-id
(gethash old-id
(etaf-runtime-candidate-graph-nodes runtime))))
(semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime))))
(effect-id (or (and old (etaf--semantic-slot-range-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(range-ref (or (and old (etaf--semantic-slot-range-range-ref old))
(list 'etaf-slot-range (etaf-runtime-mount-epoch runtime)
semantic-id)))
(target (list :children children :owner-id owner-id
:owner-input
(etaf--runtime-component-env-signature runtime owner-id)
:consumer-id consumer-id :style-stack style-stack)))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(cond
(candidate
(cons 'range
(list (apply #'ebox-child-range range-ref
(copy-sequence
(etaf--runtime-range-nodes runtime candidate))))))
((and old
(equal-including-properties
target (etaf--generation-effect-target old-effect))
(not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime))))
(when (etaf-runtime-candidate-full-rebuild-p runtime)
(etaf--runtime-carry-committed-subtree runtime generation old))
(cons 'range
(list (apply #'ebox-child-range range-ref
(copy-sequence
(etaf--runtime-range-nodes runtime old))))))
(t
(cl-multiple-value-bind (value deps nodes context-deps)
(etaf--runtime-evaluate-slot-target
runtime target semantic-id
(and old (etaf--semantic-slot-range-item-identity-index old)) path)
(let ((result
(etaf--runtime-finish-slot-range-candidate
runtime generation old identity semantic-id effect-id range-ref
name token owner-id consumer-id style-stack path target
value deps nodes context-deps)))
(when old
(let ((candidate-range
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
(unless (equal-including-properties
(etaf--semantic-slot-range-output-signature old)
(etaf--semantic-slot-range-output-signature
candidate-range))
(push (list old candidate-range
(etaf--runtime-committed-range-input runtime old)
(etaf--runtime-range-input runtime candidate-range)
nil)
(etaf-runtime-candidate-eager-range-changes runtime))
(etaf--runtime-invalidate-semantic-ancestors
runtime (etaf--semantic-slot-range-parent-id old))
(etaf--runtime-record-slot-owner-update runtime old))))
result))))))
(defun etaf--runtime-finish-slot-range-candidate
(runtime generation old identity semantic-id effect-id range-ref
name token owner-id consumer-id style-stack path target
value deps nodes context-deps)
"Finish GENERATION slot Range candidate in RUNTIME.
The candidate uses resolved VALUE, DEPS, and NODES."
(let* ((item-host-ids
(copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime))))
(all-item-ids
(etaf--runtime-candidate-descendant-ids runtime item-host-ids))
(item-index (make-hash-table :test #'equal))
(record
(etaf--semantic-slot-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id
:parent-id etaf--current-semantic-parent-id
:owner-component-id owner-id :consumer-component-id consumer-id
:token token :name name :range-ref range-ref :path (copy-tree path)
:style-stack (copy-tree style-stack)
:output-signature (copy-tree value) :deps deps
:context-deps context-deps
:artifact-key (cons (1+ (etaf-runtime-generation runtime)) effect-id)
:item-root-ids item-host-ids :item-identity-index item-index)))
(dolist (item-id all-item-ids)
(let ((item (gethash item-id
(etaf-runtime-candidate-graph-nodes runtime))))
(unless (etaf--semantic-host-p item)
(signal 'etaf-runtime-error
(list "Slot Range items require Step4b Host/string output")))
(puthash (etaf--semantic-host-identity item) item-id item-index)))
(when old
(let ((new-set (make-hash-table :test #'eql)))
(dolist (item-id all-item-ids) (puthash item-id t new-set))
(dolist (old-item-id
(etaf--runtime-generation-descendant-ids
generation (etaf--semantic-slot-range-item-root-ids old)))
(unless (gethash old-item-id new-set)
(push old-item-id
(etaf-runtime-candidate-removed-semantic-ids runtime))))))
(puthash semantic-id record (etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'slot :semantic-id semantic-id
:deps deps :target target)
(etaf-runtime-candidate-effects runtime))
(puthash effect-id (etaf--ebox-input-for-nodes nodes)
(etaf-runtime-candidate-range-artifacts runtime))
(cons 'range (list (apply #'ebox-child-range range-ref nodes)))))
(defun etaf--runtime-evaluate-slot-target
(runtime target semantic-id old-item-index path)
"Evaluate slot TARGET for RUNTIME SEMANTIC-ID and return its candidate data."
(let (deps context-deps value nodes)
(let ((collector (lambda (source) (cl-pushnew source deps :test #'eq)))
(owner-id (plist-get target :owner-id)))
(etaf--runtime-call-with-component-env
runtime owner-id
(lambda ()
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq value
(etaf--runtime-normalize-range-value
(plist-get target :children)))
(let ((etaf--render-style-stack
(copy-tree (plist-get target :style-stack))))
(setq value (etaf--runtime-style-range-value value path))))
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--render-runtime runtime)
(etaf--current-semantic-parent-id semantic-id)
(etaf--current-range-item-index old-item-index)
(etaf--rendering-range-p t)
(etaf--render-style-stack
(copy-tree (plist-get target :style-stack)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq nodes (etaf--render-value-list value path))))))
(cl-values value (nreverse deps) nodes (nreverse context-deps))))
(defun etaf--runtime-style-range-value (value path)
"Apply active Component style scopes to normalized Range VALUE at PATH."
(cl-loop for item in value for index from 0 collect
(if (etaf--view-node-p item)
(let ((styled
(etaf--runtime-style-node
item (append path (list index)))))
(setf (etaf--view-node-children styled)
(etaf--runtime-style-range-value
(etaf--view-node-children styled)
(append path (list index))))
styled)
item)))
(defun etaf--runtime-normalize-range-value (value &optional allow-components-p)
"Return normalized RANGE VALUE with nested Expr sites eagerly resolved.
When ALLOW-COMPONENTS-P is non-nil, keyed item boundaries may contain
Component calls whose retained output is owned by the keyed Range."
(cond
((null value) nil)
((stringp value) (list value))
((and allow-components-p
(or (etaf--component-call-p value)
(etaf--slot-projection-p value)))
(list value))
((etaf--expr-p value)
(etaf--runtime-normalize-range-value
(funcall (etaf--expr-thunk value)) allow-components-p))
((etaf--view-node-p value)
(if (eq (etaf--view-node-name value) 'fragment)
(cl-mapcan (lambda (child)
(etaf--runtime-normalize-range-value
child allow-components-p))
(etaf--view-node-children value))
(let ((copy (copy-sequence value)))
(setf (etaf--view-node-children copy)
(cl-loop for child in (etaf--view-node-children value)
append
(etaf--runtime-normalize-range-value
child allow-components-p)))
(list copy))))
((proper-list-p value)
(cl-mapcan (lambda (child)
(etaf--runtime-normalize-range-value
child allow-components-p))
value))
(t
(signal 'etaf-runtime-error
(list "Direct material expr requires Step4b output")))))
(defun etaf--runtime-keyed-range-snapshot (expr)
"Return EXPR's validated keyed Range snapshot, or nil."
(if (eq (etaf--expr-kind expr) 'keyed-list)
(etaf--keyed-program-snapshot expr)
(when-let* ((snapshot-function (etaf--expr-range-snapshot expr)))
(let ((key-function (etaf--expr-range-key expr))
(item-function (etaf--expr-range-item expr))
(snapshot (funcall snapshot-function)))
(when snapshot
(unless (and (functionp key-function)
(functionp item-function)
(proper-list-p snapshot)
(plist-member snapshot :items)
(proper-list-p (plist-get snapshot :items)))
(signal 'etaf-runtime-error
(list "Invalid keyed Range program snapshot")))
snapshot)))))
(defun etaf--runtime-keyed-range-keys (expr snapshot)
"Return validated keys for EXPR aligned with keyed SNAPSHOT items."
(if (plist-member snapshot :keys)
(plist-get snapshot :keys)
(let ((key-function (etaf--expr-range-key expr)))
(unless (functionp key-function)
(signal 'etaf-runtime-error
(list "Keyed Range lacks a key function")))
(mapcar (lambda (item)
(etaf--validate-key (funcall key-function item)))
(plist-get snapshot :items)))))
(defun etaf--runtime-keyed-range-item-path (path key)
"Return stable PATH below one keyed Range item KEY."
(append path (list (list :range-item (copy-tree key)))))
(defun etaf--runtime-render-range-items (value path expr snapshot)
"Render normalized Range VALUE at PATH using optional keyed SNAPSHOT.
EXPR supplies the key function. Keyed item paths encode stable keys rather
than transient positions, so reordering changes geometry without changing any
generated descendant identity. Return a plist containing flat backend NODES
and, for keyed input, the semantic root groups and backend node counts owned by
each logical item."
(if (null snapshot)
(list :nodes (etaf--render-value-list value path))
(let ((items (plist-get snapshot :items))
(keys (etaf--runtime-keyed-range-keys expr snapshot))
(seen (make-hash-table :test #'equal))
nodes root-groups node-counts)
(unless (and (= (length value) (length items))
(= (length items) (length keys)))
(signal 'etaf-runtime-error
(list "Keyed Range item/output cardinality mismatch")))
(cl-mapc
(lambda (output _item key)
(let ((key (etaf--validate-key key)))
(when (gethash key seen)
(signal 'etaf-runtime-error
(list "Keyed Range keys must be unique" key)))
(puthash key t seen)
(let* ((before
(length
(gethash etaf--current-semantic-parent-id
(etaf-runtime-candidate-graph-children
etaf--render-runtime))))
(rendered
(etaf--render-value-list
output (etaf--runtime-keyed-range-item-path path key)))
(children
(gethash etaf--current-semantic-parent-id
(etaf-runtime-candidate-graph-children
etaf--render-runtime)))
(roots (copy-sequence (nthcdr before children))))
(setq nodes (nconc nodes rendered))
(push roots root-groups)
(push (length rendered) node-counts))))
value items keys)
(list :nodes nodes
:item-root-groups (nreverse root-groups)
:item-node-counts (nreverse node-counts)))))
(defun etaf--runtime-keyed-range-metadata
(expr snapshot item-root-groups item-node-counts)
"Return retained metadata for EXPR and SNAPSHOT.
ITEM-ROOT-GROUPS and ITEM-NODE-COUNTS describe aligned item spans."
(when snapshot
(let ((items (plist-get snapshot :items))
(snapshot-keys (etaf--runtime-keyed-range-keys expr snapshot))
(signatures (make-hash-table :test #'equal))
(root-id-index (make-hash-table :test #'equal))
(node-span-index (make-hash-table :test #'equal))
(seen (make-hash-table :test #'equal))
(node-offset 0)
keys)
(unless (and (= (length items) (length item-root-groups))
(= (length items) (length item-node-counts)))
(signal 'etaf-runtime-error
(list "Keyed Range item/span cardinality mismatch")))
(cl-mapc
(lambda (item root-ids node-count key)
(let ((key (etaf--validate-key key)))
(when (gethash key seen)
(signal 'etaf-runtime-error
(list "Keyed Range keys must be unique" key)))
(unless (and (proper-list-p root-ids)
(natnump node-count))
(signal 'etaf-runtime-error
(list "Invalid keyed Range item span" key)))
(puthash key t seen)
(puthash key (copy-tree item) signatures)
(puthash key (copy-sequence root-ids) root-id-index)
(puthash key (cons node-offset node-count) node-span-index)
(cl-incf node-offset node-count)
(push key keys)))
items item-root-groups item-node-counts
snapshot-keys)
(list :context (copy-tree (plist-get snapshot :context))
:signatures signatures
:root-id-index root-id-index
:node-span-index node-span-index
:keys (nreverse keys)))))
(defun etaf--runtime-index-range-item-identities
(runtime semantic-ids identity-index)
"Validate RUNTIME SEMANTIC-IDS and index Hosts in IDENTITY-INDEX."
(dolist (semantic-id semantic-ids)
(let ((semantic
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
(unless (or (etaf--semantic-host-p semantic)
(etaf--semantic-component-p semantic)
(etaf--semantic-range-p semantic)
(etaf--semantic-slot-range-p semantic)
(etaf--semantic-inline-range-p semantic))
(signal 'etaf-runtime-error
(list "Invalid semantic root below Range" semantic-id)))
(when (etaf--semantic-host-p semantic)
(puthash (etaf--semantic-host-identity semantic)
semantic-id identity-index)))))
(defun etaf--runtime-candidate-descendant-ids (runtime roots)
"Return ROOTS and all candidate semantic descendants in RUNTIME."
(let ((queue (copy-sequence roots)) result)
(while queue
(let ((semantic-id (pop queue)))
(push semantic-id result)
(setq queue
(nconc queue
(copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime)))))))
(nreverse result)))
(defun etaf--runtime-generation-descendant-ids (generation roots)
"Return ROOTS and all committed semantic descendants in GENERATION."
(let ((queue (copy-sequence roots)) result)
(while queue
(let ((semantic-id (pop queue)))
(push semantic-id result)
(setq queue
(nconc queue
(copy-sequence
(etaf--generation-child-ids
generation semantic-id))))))
(nreverse result)))
(defun etaf--runtime-inline-value-string (value surface)
"Return inline VALUE when it is a string.
SURFACE is retained in the Range record for ABI stability but never applies
raw Emacs properties; Text presentation is projected by Ebox."
(ignore surface)
(cond
((null value) "")
((stringp value) value)
(t
(signal 'etaf-runtime-error
(list "Text expr must resolve to nil or one string")))))
(defun etaf--runtime-render-inline-range
(runtime host-id expr path surface)
"Create or reuse one inline EXPR Range owned by HOST-ID in RUNTIME."
(let* ((token (etaf--expr-token expr))
(identity (list 'inline-range host-id (or token (copy-tree path))))
(generation (etaf-runtime-current-generation runtime))
(old-id (and generation
(gethash identity (etaf-generation-identity-index generation))))
(old (and old-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
old-id)))
(candidate (and old-id
(gethash old-id
(etaf-runtime-candidate-graph-nodes runtime))))
(semantic-id (or old-id
(cl-incf (etaf-runtime-next-semantic-id runtime))))
(effect-id (or (and old (etaf--semantic-inline-range-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime)))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child runtime host-id semantic-id)
(if candidate
(cons semantic-id (etaf--semantic-inline-range-output candidate))
(if (and old (not etaf--rendering-component-effect-p)
(not (gethash effect-id
(etaf-runtime-dirty-effect-ids runtime))))
(progn
(when (etaf-runtime-candidate-full-rebuild-p runtime)
(etaf--runtime-carry-committed-subtree runtime generation old))
(cons semantic-id (etaf--semantic-inline-range-output old)))
(let (deps context-deps output)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq output
(etaf--runtime-inline-value-string
(funcall (etaf--expr-thunk expr)) surface)))
(let ((record
(etaf--semantic-inline-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id
:parent-id host-id :component-id etaf--current-component-semantic-id
:token token :path (copy-tree path)
:surface-properties (copy-tree surface)
:output (copy-sequence output) :deps (nreverse deps)
:context-deps (nreverse context-deps))))
(puthash semantic-id record
(etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'inline
:semantic-id semantic-id :deps (etaf--semantic-inline-range-deps record)
:target expr)
(etaf-runtime-candidate-effects runtime))
(when (and old
(not (equal-including-properties
(etaf--semantic-inline-range-output old) output)))
(cl-pushnew host-id
(etaf-runtime-candidate-inline-host-ids runtime)
:test #'eql)
(etaf--runtime-invalidate-semantic-ancestors runtime host-id)
(when-let* ((component-id
(etaf--semantic-inline-range-component-id old))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
component-id)))
(cl-pushnew (etaf--semantic-component-identity component)
(etaf-runtime-candidate-updated-component-identities
runtime)
:test #'equal)))
(cons semantic-id output)))))))
(defun etaf--runtime-render-inline-content
(runtime host-id values path &optional surface)
"Return resolved inline content and semantic parts for HOST-ID in RUNTIME."
(let (parts strings)
(cl-labels
((walk
(value current-path inherited)
(cond
((null value) nil)
((stringp value)
(push value parts) (push value strings))
((etaf--expr-p value)
(let ((entry (etaf--runtime-render-inline-range
runtime host-id value current-path inherited)))
(push (car entry) parts) (push (cdr entry) strings)))
((etaf--view-node-p value)
(signal 'etaf-runtime-error
(list "Text payload cannot contain a View node")))
((proper-list-p value)
(let ((index 0))
(dolist (item value)
(walk item (append current-path (list index)) inherited)
(cl-incf index))))
(t (signal 'etaf-runtime-error
(list "Inline text requires Step4b output"))))))
(walk values path surface))
(list (apply #'concat (nreverse strings)) (nreverse parts))))
(defun etaf--runtime-style-node (node path)
"Apply active Component style scopes to NODE at structural PATH."
(let ((result node))
(dolist (scope etaf--render-style-stack result)
(let ((styles (car scope))
(root-path (cdr scope)))
(when (and styles (equal path root-path))
(setq result (etaf--apply-inline-style-rules result styles t)))
(when (and styles (not (equal path root-path)))
(setq result (etaf--apply-inline-style-rules result styles nil)))))))
(defun etaf--runtime-enqueue-instance-hooks
(journal instance kind hooks ordering-prefix)
"Enqueue INSTANCE HOOKS of KIND into JOURNAL after ORDERING-PREFIX."
(cl-loop for hook in (reverse hooks)
for index from 0
do
(let ((callback hook))
(etaf-retirement-enqueue
journal
:owner (copy-tree (etaf--component-instance-identity instance))
:kind kind
:payload (lambda ()
(let ((etaf--render-phase-p nil))
(funcall callback)))
:ordering-key (append ordering-prefix (list 0 index))
:policy 'run-once-public
:max-attempts 1))))
(defun etaf--runtime-dispose-instance
(instance &optional run-hooks-p retirement-journal ordering-prefix)
"Dispose INSTANCE and run public hooks when RUN-HOOKS-P is non-nil.
When RETIREMENT-JOURNAL is non-nil, enqueue public hooks and structural scope
cleanup after ORDERING-PREFIX instead of running them inline."
(when (etaf--component-instance-p instance)
(let ((mounted-p (etaf--component-instance-mounted-p instance))
(scope (etaf--component-instance-scope instance)))
;; Authority is removed before any user or structural cleanup runs.
(setf (etaf--component-instance-mounted-p instance) nil)
(if retirement-journal
(progn
(when (and run-hooks-p mounted-p)
(etaf--runtime-enqueue-instance-hooks
retirement-journal instance 'unmounted
(etaf--component-instance-unmounted-hooks instance)
ordering-prefix))
(etaf-retirement-enqueue
retirement-journal
:owner (copy-tree (etaf--component-instance-identity instance))
:kind 'scope-stop
:payload
(lambda ()
(when-let* ((errors (etaf-scope-stop scope)))
(signal (caar errors) (cdar errors))))
:ordering-key (append ordering-prefix '(1 0))
:policy 'contained-once
:max-attempts 1))
(progn
(when (and run-hooks-p mounted-p)
(let ((etaf--render-phase-p nil))
(etaf--run-hooks
(etaf--component-instance-unmounted-hooks instance))))
(etaf-scope-stop scope))))))
(defun etaf--runtime-dispose-created-candidate (runtime)
"Dispose RUNTIME's instances created by an uncommitted candidate."
(dolist (instance (etaf-runtime-candidate-created runtime))
(remhash (etaf--component-instance-identity instance)
(etaf-runtime-instances runtime))
(remhash (etaf--component-instance-resource-key instance)
(etaf-runtime-resource-registry runtime))
(etaf--runtime-dispose-instance instance nil))
(dolist (entry (etaf-runtime-candidate-old-instances runtime))
(puthash (car entry) (cadr entry) (etaf-runtime-instances runtime)))
runtime)
(defun etaf--runtime-clear-candidate (runtime)
"Clear transient candidate bookkeeping in RUNTIME."
(setf (etaf-runtime-candidate-created runtime) nil
(etaf-runtime-candidate-old-instances runtime) nil
(etaf-runtime-candidate-live runtime) nil
(etaf-runtime-candidate-semantic-nodes runtime) nil
(etaf-runtime-candidate-component-envs runtime) nil
(etaf-runtime-candidate-graph-nodes runtime) nil
(etaf-runtime-candidate-identity-entries runtime) nil
(etaf-runtime-candidate-graph-children runtime) nil
(etaf-runtime-candidate-graph-child-tails runtime) nil
(etaf-runtime-candidate-removed-semantic-ids runtime) nil
(etaf-runtime-candidate-removed-effect-ids runtime) nil
(etaf-runtime-candidate-removed-host-refs runtime) nil
(etaf-runtime-candidate-rendered-identities runtime) nil
(etaf-runtime-candidate-updated-component-identities runtime) nil
(etaf-runtime-candidate-artifacts runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-range-artifacts runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-invalidated-artifact-keys runtime) nil
(etaf-runtime-candidate-inline-host-ids runtime) nil
(etaf-runtime-candidate-eager-range-changes runtime) nil
(etaf-runtime-candidate-effects runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-source-deltas runtime) nil
(etaf-runtime-candidate-handlers runtime) nil
(etaf-runtime-candidate-host-props runtime) nil
(etaf-runtime-candidate-theme-paint-updates runtime) nil
(etaf-runtime-candidate-behaviors runtime) nil
(etaf-runtime-candidate-behavior-resource-keys runtime) nil))
(defun etaf--runtime-promote (runtime retirement-journal)
"Promote RUNTIME candidate and enqueue removals in RETIREMENT-JOURNAL."
(let (removed added existing)
(maphash
(lambda (identity instance)
(if (gethash identity (etaf-runtime-candidate-live runtime))
(if (etaf--component-instance-mounted-p instance)
(push instance existing)
(push instance added))
(push instance removed)))
(etaf-runtime-instances runtime))
;; Removed descendants are disposed before their parents.
(cl-loop for instance in (sort removed
(lambda (left right)
(> (length (etaf--component-instance-identity left))
(length (etaf--component-instance-identity right)))))
for index from 0
do
(remhash (etaf--component-instance-identity instance)
(etaf-runtime-instances runtime))
(remhash (etaf--component-instance-resource-key instance)
(etaf-runtime-resource-registry runtime))
(etaf--runtime-dispose-instance
instance t retirement-journal (list 0 index)))
(cl-loop for entry in (etaf-runtime-candidate-old-instances runtime)
for index from 0
do (etaf--runtime-dispose-instance
(cadr entry) t retirement-journal (list 1 index)))
(dolist (instance added)
(setf (etaf--component-instance-mounted-p instance) t))
(list
(sort added
(lambda (left right)
(< (length (etaf--component-instance-identity left))
(length (etaf--component-instance-identity right)))))
existing)))
(defun etaf--runtime-run-lifecycle (groups retirement-journal)
"Enqueue mounted and updated GROUPS in RETIREMENT-JOURNAL."
(cl-loop for instance in (car groups)
for index from 0
do (etaf--runtime-enqueue-instance-hooks
retirement-journal instance 'mounted
(etaf--component-instance-mounted-hooks instance)
(list 2 index)))
(cl-loop for instance in (cadr groups)
for index from 0
do (etaf--runtime-enqueue-instance-hooks
retirement-journal instance 'updated
(etaf--component-instance-updated-hooks instance)
(list 3 index))))
(defun etaf--runtime-begin-candidate (runtime)
"Reset candidate bookkeeping before a RUNTIME render."
(setq etaf--rendered-range-container-nodes nil)
(setf (etaf-runtime-candidate-live runtime) (make-hash-table :test #'equal)
(etaf-runtime-candidate-semantic-nodes runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-component-envs runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-graph-nodes runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-identity-entries runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-graph-children runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-graph-child-tails runtime)
(make-hash-table :test #'eql)
(etaf-runtime-candidate-removed-semantic-ids runtime) nil
(etaf-runtime-candidate-removed-effect-ids runtime) nil
(etaf-runtime-candidate-removed-host-refs runtime) nil
(etaf-runtime-candidate-rendered-identities runtime) nil
(etaf-runtime-candidate-updated-component-identities runtime) nil
(etaf-runtime-candidate-effects runtime) (make-hash-table :test #'eql)
(etaf-runtime-candidate-generation-metrics runtime)
(etaf--generation-metrics-create)
(etaf-runtime-candidate-full-rebuild-p runtime) nil
(etaf-runtime-candidate-invalidated-artifact-keys runtime) nil
(etaf-runtime-candidate-inline-host-ids runtime) nil
(etaf-runtime-candidate-eager-range-changes runtime) nil
(etaf-runtime-candidate-root-deps runtime)
(and (etaf-runtime-current-generation runtime)
(copy-sequence
(etaf--pvec-get
(etaf-generation-effect-sources
(etaf-runtime-current-generation runtime))
(etaf-runtime-root-effect-id runtime))))
(etaf-runtime-candidate-created runtime) nil
(etaf-runtime-candidate-old-instances runtime) nil
(etaf-runtime-candidate-handlers runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-host-props runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-theme-paint-updates runtime)
(make-hash-table :test #'eq)
(etaf-runtime-candidate-behaviors runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-behavior-resource-keys runtime)
(make-hash-table :test #'equal)))
(defun etaf--runtime-evaluate-root (runtime)
"Evaluate RUNTIME's root View without lowering Components."
(let ((root-view (etaf-runtime-root-view runtime)))
(if (functionp root-view) (funcall root-view) root-view)))
(defun etaf--runtime-render-root (runtime)
"Lower RUNTIME's cached root View."
(let ((etaf--current-semantic-parent-id
(etaf-runtime-root-range-id runtime)))
(etaf--render-value-list
(etaf-runtime-root-view-cache runtime) '(root))))
(defun etaf--runtime-stage-root-range (runtime deps)
"Stage RUNTIME's nonvisual semantic Root Range with DEPS."
(let* ((semantic-id (etaf-runtime-root-range-id runtime))
(identity (list 'root-range (etaf-runtime-mount-epoch runtime)))
(children (copy-sequence
(gethash semantic-id
(etaf-runtime-candidate-graph-children runtime))))
(record
(etaf--semantic-range-create
:semantic-id semantic-id :identity identity
:effect-id (etaf-runtime-root-effect-id runtime) :kind 'root
:parent-id 0 :component-id nil :token 'root :range-ref nil
:path '(root) :caller-style-stack nil
:output-signature (copy-tree (etaf-runtime-root-view-cache runtime))
:deps (copy-sequence deps) :artifact-key nil
:item-root-ids children
:item-identity-index (make-hash-table :test #'equal))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(puthash semantic-id record
(etaf-runtime-candidate-graph-nodes runtime))
(puthash 0 (list semantic-id)
(etaf-runtime-candidate-graph-children runtime))))
(defun etaf--runtime-record-detached-candidate-subtrees (runtime base)
"Record BASE subtrees detached by RUNTIME's changed candidate edges.
Only parents present in the candidate child table are examined. A child
reattached by another candidate edge remains live together with its committed
subtree; every genuinely detached descendant is retired from the next
Generation, including its effects and Host contributions."
(when base
(let ((candidate-children
(etaf-runtime-candidate-graph-children runtime))
(candidate-nodes (etaf-runtime-candidate-graph-nodes runtime))
(candidate-attached (make-hash-table :test #'eql))
(removed (make-hash-table :test #'eql)))
(dolist (semantic-id
(etaf-runtime-candidate-removed-semantic-ids runtime))
(puthash semantic-id t removed))
(maphash
(lambda (_parent-id children)
(dolist (semantic-id children)
(puthash semantic-id t candidate-attached)))
candidate-children)
(cl-labels
((candidate-attached-p
(semantic-id)
(gethash semantic-id candidate-attached))
(record-detached
(semantic-id)
(unless (or (candidate-attached-p semantic-id)
(gethash semantic-id removed))
(puthash semantic-id t removed)
(push semantic-id
(etaf-runtime-candidate-removed-semantic-ids runtime))
(dolist (child-id
(etaf--generation-child-ids base semantic-id))
(record-detached child-id)))))
(maphash
(lambda (parent-id children)
(dolist (old-child-id
(etaf--generation-child-ids base parent-id))
(unless (memq old-child-id children)
(record-detached old-child-id))))
candidate-children))
;; A stable semantic address may be reused while its public Host ref
;; changes. Retire the previous contribution even though the semantic
;; node itself remains attached and is overwritten in place.
(maphash
(lambda (semantic-id semantic)
(when-let* ((old (etaf--pvec-get
(etaf-generation-semantic-nodes base) semantic-id)))
(when (and (etaf--semantic-host-p old)
(etaf--semantic-host-p semantic)
(not (equal (etaf--semantic-host-host-ref old)
(etaf--semantic-host-host-ref semantic))))
(cl-pushnew
(etaf--semantic-host-host-ref old)
(etaf-runtime-candidate-removed-host-refs runtime)
:test #'equal))))
candidate-nodes))))
(defun etaf--runtime-build-generation (runtime &optional base)
"Build RUNTIME generation, point-copying candidate owners from BASE."
(etaf--runtime-record-detached-candidate-subtrees runtime base)
(let* ((full-p (or (null base) (etaf-runtime-root-dirty-p runtime)))
(generation-id (1+ (etaf-runtime-generation runtime)))
(metrics (or (etaf-runtime-candidate-generation-metrics runtime)
(etaf--generation-metrics-create)))
(nodes (and (not full-p) (etaf-generation-semantic-nodes base)))
(effect-map (and (not full-p) (etaf-generation-effect-map base)))
(source-effects (and (not full-p) (etaf-generation-source-effects base)))
(effect-sources (and (not full-p) (etaf-generation-effect-sources base)))
(resources (and (not full-p) (etaf-generation-resource-membership base)))
(identity-index (if (not full-p)
(etaf-generation-identity-index base)
(make-hash-table :test #'equal)))
(identity-copy nil)
(affected-sources (make-hash-table :test #'eq))
(effect-map-shadow (make-hash-table :test #'eql))
(effect-sources-shadow (make-hash-table :test #'eql))
(source-effects-shadow (make-hash-table :test #'eql))
(missing-index-value (make-symbol "etaf-missing-index-value"))
deltas
node-updates resource-updates
effect-map-update-ids effect-sources-update-ids
source-effects-update-ids)
(cl-labels
((index-value
(shadow root id kind)
(let ((value (gethash id shadow missing-index-value)))
(if (eq value missing-index-value)
(etaf--pvec-get root id metrics kind)
value)))
(stage-index-value
(shadow ids id value)
(let ((new-p (eq (gethash id shadow missing-index-value)
missing-index-value)))
(puthash id value shadow)
(if new-p (cons id ids) ids)))
(staged-index-entries
(shadow ids)
(mapcar (lambda (id) (cons id (gethash id shadow)))
(nreverse ids)))
(install-effect
(effect old-deps new-deps)
(let ((effect-id (etaf--generation-effect-effect-id effect)))
(setq effect-map-update-ids
(stage-index-value effect-map-shadow effect-map-update-ids
effect-id effect)
effect-sources-update-ids
(stage-index-value effect-sources-shadow
effect-sources-update-ids effect-id
(copy-sequence new-deps)))
(dolist (source (cl-delete-duplicates
(append (copy-sequence old-deps)
(copy-sequence new-deps))
:test #'eq))
(puthash source t affected-sources)
(let* ((source-id (etaf-reactive-source-id source))
(current-effects
(copy-sequence
(index-value source-effects-shadow source-effects
source-id 'source)))
(new-effects (delq effect-id current-effects)))
(when (memq source new-deps)
(setq new-effects
(sort (cons effect-id new-effects) #'<)))
(unless (equal current-effects new-effects)
(setq source-effects-update-ids
(stage-index-value source-effects-shadow
source-effects-update-ids
source-id new-effects)))))))
(remove-effect
(effect-id)
(when-let* ((old-effect
(index-value effect-map-shadow effect-map effect-id
'effect)))
(let ((deps (etaf--generation-effect-deps old-effect)))
(setq effect-map-update-ids
(stage-index-value effect-map-shadow effect-map-update-ids
effect-id nil)
effect-sources-update-ids
(stage-index-value effect-sources-shadow
effect-sources-update-ids effect-id nil))
(dolist (source deps)
(puthash source t affected-sources)
(let* ((source-id (etaf-reactive-source-id source))
(current-effects
(copy-sequence
(index-value source-effects-shadow source-effects
source-id 'source)))
(new-effects (delq effect-id current-effects)))
(unless (equal current-effects new-effects)
(setq source-effects-update-ids
(stage-index-value source-effects-shadow
source-effects-update-ids
source-id new-effects))))))))
(semantic-effect-ids
(semantic)
(cond
((etaf--semantic-component-p semantic)
(delq nil
(list (etaf--semantic-component-input-effect-id semantic)
(etaf--semantic-component-effect-id semantic))))
((etaf--semantic-host-p semantic)
(delq nil (list (etaf--semantic-host-effect-id semantic))))
((etaf--semantic-range-p semantic)
(list (etaf--semantic-range-effect-id semantic)))
((etaf--semantic-slot-range-p semantic)
(list (etaf--semantic-slot-range-effect-id semantic)))
((etaf--semantic-inline-range-p semantic)
(list (etaf--semantic-inline-range-effect-id semantic)))
(t nil))))
(when full-p
(maphash (lambda (source _) (puthash source t affected-sources))
(etaf-runtime-route-sources runtime)))
(maphash
(lambda (identity candidate)
(let* ((semantic (copy-sequence candidate))
(semantic-id (etaf--semantic-component-semantic-id semantic))
(effect-id (etaf--semantic-component-effect-id semantic))
(resource-id
(cdr (etaf--semantic-component-resource-key semantic))))
(when (gethash effect-id (etaf-runtime-candidate-artifacts runtime))
(setf (etaf--semantic-component-artifact-key semantic)
(cons generation-id effect-id)))
(push (cons semantic-id semantic) node-updates)
(unless (gethash identity identity-index)
(unless identity-copy
(setq identity-index (copy-hash-table identity-index)
identity-copy t))
(puthash identity semantic-id identity-index))
(unless (and (not full-p)
(etaf--pvec-get resources resource-id))
(push (cons resource-id
(etaf--semantic-component-resource-key semantic))
resource-updates))))
(etaf-runtime-candidate-semantic-nodes runtime))
(maphash
(lambda (semantic-id semantic)
(unless (etaf--semantic-component-p semantic)
(push (cons semantic-id semantic) node-updates)))
(etaf-runtime-candidate-graph-nodes runtime))
(maphash
(lambda (identity _state)
(let ((resource-key
(and (hash-table-p
(etaf-runtime-candidate-behavior-resource-keys runtime))
(gethash identity
(etaf-runtime-candidate-behavior-resource-keys
runtime)))))
(when resource-key
(push (cons (cdr resource-key) resource-key)
resource-updates))))
(etaf-runtime-candidate-behaviors runtime))
(dolist (effect-id (etaf-runtime-candidate-removed-effect-ids runtime))
(remove-effect effect-id))
(dolist (semantic-id (etaf-runtime-candidate-removed-semantic-ids runtime))
(let ((live-p
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
;; Replacement may reintroduce a stable descendant below a new
;; ancestor. Candidate liveness wins over the old subtree's removal
;; journal for both the node and its effects.
(unless live-p
(when-let* ((old-node (and base
(etaf--pvec-get
(etaf-generation-semantic-nodes base)
semantic-id))))
(dolist (effect-id (semantic-effect-ids old-node))
(remove-effect effect-id))
(when (and (etaf--semantic-host-p old-node)
(etaf--semantic-host-host-ref old-node))
(let ((host-ref (etaf--semantic-host-host-ref old-node)))
(unless (or
(gethash host-ref
(etaf-runtime-candidate-host-props runtime))
(gethash host-ref
(etaf-runtime-candidate-handlers runtime)))
(cl-pushnew
host-ref
(etaf-runtime-candidate-removed-host-refs runtime)
:test #'equal)))))
(push (cons semantic-id nil) node-updates))))
(maphash
(lambda (identity semantic-id)
(unless (gethash identity identity-index)
(unless identity-copy
(setq identity-index (copy-hash-table identity-index)
identity-copy t))
(puthash identity semantic-id identity-index)))
(etaf-runtime-candidate-identity-entries runtime))
(maphash
(lambda (effect-id effect)
(let ((old (and base
(etaf--pvec-get
(etaf-generation-effect-map base)
effect-id metrics 'effect))))
(install-effect effect
(and old (etaf--generation-effect-deps old))
(etaf--generation-effect-deps effect))))
(etaf-runtime-candidate-effects runtime))
(when full-p
(let* ((effect-id (etaf-runtime-root-effect-id runtime))
(old-deps (and base
(etaf--pvec-get
(etaf-generation-effect-sources base) effect-id)))
(new-deps (etaf-runtime-candidate-root-deps runtime))
(root-children
(copy-sequence
(gethash 0
(etaf-runtime-candidate-graph-children runtime))))
(root (etaf--semantic-root-create
:semantic-id 0 :effect-id effect-id
:input-signature
(copy-tree (etaf-runtime-root-view-cache runtime))
:deps (copy-sequence new-deps)
:child-ids root-children)))
(push (cons 0 root) node-updates)
(install-effect
(etaf--generation-effect-create
:effect-id effect-id :kind 'root
:semantic-id (etaf-runtime-root-range-id runtime) :deps new-deps)
old-deps new-deps)))
;; Apply all semantic/index membership edits in one trie batch. The
;; candidate remains immutable; only the number of copied persistent
;; vector spines changes.
(setq effect-map
(etaf--pvec-put-many effect-map
(staged-index-entries
effect-map-shadow effect-map-update-ids)
metrics)
effect-sources
(etaf--pvec-put-many effect-sources
(staged-index-entries
effect-sources-shadow
effect-sources-update-ids)
metrics)
source-effects
(etaf--pvec-put-many source-effects
(staged-index-entries
source-effects-shadow
source-effects-update-ids)
metrics)
nodes
(etaf--pvec-put-many nodes node-updates metrics)
resources
(etaf--pvec-put-many resources resource-updates metrics))
(maphash
(lambda (source _)
(let ((old-effects
(and base
(etaf--pvec-get (etaf-generation-source-effects base)
(etaf-reactive-source-id source))))
(new-effects
(etaf--pvec-get source-effects
(etaf-reactive-source-id source))))
(unless (equal old-effects new-effects)
(push (list source old-effects new-effects) deltas))))
affected-sources)
(setf (etaf-runtime-candidate-source-deltas runtime) (nreverse deltas)
(etaf-runtime-candidate-generation-metrics runtime) metrics)
(let ((generation
(etaf--generation-create
:generation-id generation-id
:root-semantic-id 0
:semantic-nodes nodes
:effect-map effect-map
:source-effects source-effects
:effect-sources effect-sources
:parent-table nil
:children-table nil
:resource-membership resources
:identity-index identity-index
:indexes (etaf--runtime-build-contribution-indexes
runtime base full-p))))
(etaf--generation-validate-context-acyclic generation)))))
(defun etaf--runtime-prearm-generation (runtime generation)
"Prearm RUNTIME GENERATION sources and return the new-source journal."
(ignore generation)
(let ((route (etaf-runtime-route-token runtime)) journal completed)
(unwind-protect
(progn
(dolist (delta (etaf-runtime-candidate-source-deltas runtime))
(let ((source (car delta)) (new-effects (nth 2 delta)))
(when (and new-effects
(not (gethash route
(etaf--source-subscribers source))))
(push source journal)
(puthash route t (etaf--source-subscribers source))
(puthash source t (etaf-runtime-route-sources runtime)))))
(setq completed t)
journal)
(unless completed
(etaf--runtime-rollback-prearm runtime journal)))))
(defun etaf--runtime-rollback-prearm (runtime journal)
"Remove RUNTIME route from every newly prearmed source in JOURNAL."
(dolist (source journal)
(remhash (etaf-runtime-route-token runtime)
(etaf--source-subscribers source))
(remhash source (etaf-runtime-route-sources runtime))))
(defun etaf--runtime-complete-generation (runtime generation)
"Complete RUNTIME through GENERATION and prune obsolete routes."
(when-let* ((focus-ref (etaf-runtime-focus-ref runtime)))
(let ((props (etaf--generation-index-lookup
generation 'host-props focus-ref)))
(unless (and (numberp (plist-get props :tab-index))
(>= (plist-get props :tab-index) 0)
(not (plist-get props :disabled)))
(setf (etaf-runtime-focus-ref runtime) nil))))
(dolist (delta (etaf-runtime-candidate-source-deltas runtime))
(let ((source (car delta)) (effects (nth 2 delta)))
(when (null effects)
(remhash (etaf-runtime-route-token runtime)
(etaf--source-subscribers source))
(remhash source (etaf-runtime-route-sources runtime))))))
(defun etaf--runtime-new-semantic-candidate (runtime generation)
"Return RUNTIME's next versioned semantic candidate for GENERATION."
(let ((candidate-id
(cl-incf (etaf-runtime-next-semantic-candidate-id runtime)))
(operation-id
(if etaf--observer-context
(etaf--observer-context-operation-id etaf--observer-context)
0)))
(etaf-semantic-candidate-create
(etaf--runtime-generation-authority runtime)
generation operation-id candidate-id
(etaf-runtime-mount-epoch runtime)
(etaf-runtime-mount-epoch runtime))))
(defun etaf--runtime-swap-generation
(runtime old candidate &optional semantic-candidate)
"Swap RUNTIME from OLD to CANDIDATE with an exact authority guard.
SEMANTIC-CANDIDATE selects the versioned token/store CAS path."
(if semantic-candidate
(progn
(unless (and
(eq old
(etaf-semantic-candidate-expected-generation
semantic-candidate))
(eq candidate
(etaf-semantic-candidate-candidate-generation
semantic-candidate)))
(signal 'etaf-generation-error
(list :participant-candidate-mismatch)))
(etaf-semantic-candidate-stage semantic-candidate))
(unless (eq (etaf-runtime-current-generation runtime) old)
(error "ETAF generation authority changed during publication"))
(setf (etaf-runtime-current-generation runtime) candidate)))
(defun etaf--runtime-rollback-generation
(runtime old candidate &optional semantic-candidate)
"Idempotently restore OLD when RUNTIME still points at CANDIDATE."
(if semantic-candidate
(etaf-semantic-candidate-rollback semantic-candidate)
(when (eq (etaf-runtime-current-generation runtime) candidate)
(setf (etaf-runtime-current-generation runtime) old))))
(defun etaf--runtime-preinstall-resources (runtime old generation)
"Install RUNTIME resources/artifacts for GENERATION and return journal.
OLD supplies the retained artifact generation whose obsolete entries are
removed inside the same rollback journal."
(let ((removed-keys (make-hash-table :test #'equal)) journal completed)
(cl-labels
((remove-retained
(kind registry key)
(when key
(let ((address (list kind key))
(missing (make-symbol "etaf-artifact-missing")))
(unless (gethash address removed-keys)
(puthash address t removed-keys)
(let ((value (gethash key registry missing)))
(unless (eq value missing)
(push (list kind key value) journal)
(remhash key registry))))))))
(unwind-protect
(progn
(dolist (instance (etaf-runtime-candidate-created runtime))
(let* ((key (etaf--component-instance-resource-key instance))
(identity (etaf--component-instance-identity instance))
(missing (make-symbol "etaf-instance-missing"))
(old-instance
(gethash identity (etaf-runtime-instances runtime)
missing)))
(push (list 'resource key instance) journal)
(puthash key instance (etaf-runtime-resource-registry runtime))
(push (list 'instance identity
(not (eq old-instance missing)) old-instance instance)
journal)
(puthash identity instance (etaf-runtime-instances runtime))))
(maphash
(lambda (_identity semantic)
(when-let* ((instance
(gethash
(etaf--semantic-component-resource-key semantic)
(etaf-runtime-resource-registry runtime))))
(let ((old-context
(etaf--component-instance-context instance))
(new-context
(etaf--semantic-component-context-frame semantic)))
(unless (eq old-context new-context)
(push (list 'instance-context instance
old-context new-context)
journal)
(setf (etaf--component-instance-context instance)
new-context)))))
(etaf-runtime-candidate-semantic-nodes runtime))
(when (and (hash-table-p
(etaf-runtime-candidate-behavior-resource-keys runtime))
(hash-table-p
(etaf-runtime-candidate-behaviors runtime)))
(maphash
(lambda (identity resource-key)
(let ((state (gethash identity
(etaf-runtime-candidate-behaviors runtime))))
(when (and resource-key state
(not (eq state
(gethash resource-key
(etaf-runtime-resource-registry
runtime)))))
(push (list 'behavior-resource resource-key state) journal)
(puthash resource-key state
(etaf-runtime-resource-registry runtime)))))
(etaf-runtime-candidate-behavior-resource-keys runtime)))
(maphash
(lambda (effect-id artifact)
(unless (ebox-canonical-input-p artifact)
(signal 'etaf-runtime-error
(list "Material Component artifact is not canonical input")))
(when-let* ((semantic
(etaf--generation-effect-semantic
generation effect-id)))
(let ((key (etaf--semantic-component-artifact-key semantic)))
(push (list 'artifact key artifact) journal)
(puthash key artifact
(etaf-runtime-artifact-registry runtime)))))
(etaf-runtime-candidate-artifacts runtime))
(maphash
(lambda (effect-id artifact)
(unless (ebox-canonical-input-p artifact)
(signal 'etaf-runtime-error
(list "Range artifact is not canonical input")))
(when-let* ((range
(etaf--generation-effect-semantic
generation effect-id)))
(let ((key (etaf--semantic-backend-range-artifact-key range)))
(push (list 'range-artifact key artifact) journal)
(puthash key artifact
(etaf-runtime-range-artifact-registry runtime)))))
(etaf-runtime-candidate-range-artifacts runtime))
(maphash
(lambda (effect-id _artifact)
(when-let* ((old-semantic
(and old
(etaf--generation-effect-semantic
old effect-id)))
(new-semantic
(etaf--generation-effect-semantic
generation effect-id))
(old-key
(etaf--semantic-component-artifact-key old-semantic)))
(unless (equal
old-key
(etaf--semantic-component-artifact-key new-semantic))
(remove-retained
'artifact-removal
(etaf-runtime-artifact-registry runtime) old-key))))
(etaf-runtime-candidate-artifacts runtime))
(maphash
(lambda (effect-id _artifact)
(when-let* ((old-range
(and old
(etaf--generation-effect-semantic
old effect-id)))
(new-range
(etaf--generation-effect-semantic
generation effect-id))
(old-key
(etaf--semantic-backend-range-artifact-key
old-range)))
(unless (equal
old-key
(etaf--semantic-backend-range-artifact-key new-range))
(remove-retained
'range-artifact-removal
(etaf-runtime-range-artifact-registry runtime) old-key))))
(etaf-runtime-candidate-range-artifacts runtime))
(dolist (key
(etaf-runtime-candidate-invalidated-artifact-keys runtime))
(remove-retained
'artifact-removal
(etaf-runtime-artifact-registry runtime) key))
(setq completed t)
journal)
(unless completed
(etaf--runtime-rollback-resource-journal runtime journal))))))
(defun etaf--runtime-rollback-resource-journal (runtime journal)
"Remove RUNTIME resources still owned by failed JOURNAL entries."
(dolist (entry journal)
(pcase (car entry)
('instance
(let ((identity (nth 1 entry))
(present-p (nth 2 entry))
(old (nth 3 entry))
(candidate (nth 4 entry)))
(when (eq (gethash identity (etaf-runtime-instances runtime))
candidate)
(if present-p
(puthash identity old (etaf-runtime-instances runtime))
(remhash identity (etaf-runtime-instances runtime))))))
('instance-context
(let ((instance (nth 1 entry))
(old-context (nth 2 entry))
(new-context (nth 3 entry)))
(when (eq (etaf--component-instance-context instance) new-context)
(setf (etaf--component-instance-context instance) old-context))))
('resource
(when (eq (gethash (nth 1 entry)
(etaf-runtime-resource-registry runtime))
(nth 2 entry))
(remhash (nth 1 entry) (etaf-runtime-resource-registry runtime))))
('behavior-resource
(when (eq (gethash (nth 1 entry)
(etaf-runtime-resource-registry runtime))
(nth 2 entry))
(remhash (nth 1 entry) (etaf-runtime-resource-registry runtime))))
('artifact
(when (eq (gethash (nth 1 entry)
(etaf-runtime-artifact-registry runtime))
(nth 2 entry))
(remhash (nth 1 entry) (etaf-runtime-artifact-registry runtime))))
('range-artifact
(when (eq (gethash (nth 1 entry)
(etaf-runtime-range-artifact-registry runtime))
(nth 2 entry))
(remhash (nth 1 entry)
(etaf-runtime-range-artifact-registry runtime))))
((or 'artifact-removal 'range-artifact-removal)
(let* ((registry
(if (eq (car entry) 'artifact-removal)
(etaf-runtime-artifact-registry runtime)
(etaf-runtime-range-artifact-registry runtime)))
(key (nth 1 entry))
(value (nth 2 entry))
(missing (make-symbol "etaf-artifact-missing"))
(current (gethash key registry missing)))
(cond
((eq current missing) (puthash key value registry))
((eq current value) nil)
(t
(error "ETAF artifact authority changed during rollback: %S" key)))))))
nil)
(defun etaf--runtime-bind-semantic-inverse-journal
(candidate runtime resource-journal route-journal)
"Bind CANDIDATE inverse journals for RUNTIME before authority staging.
RESOURCE-JOURNAL and ROUTE-JOURNAL remain opaque owner-local entries."
(setf (etaf-semantic-candidate-inverse-journal candidate)
(list :runtime runtime
:resource-journal resource-journal
:route-journal route-journal
:state 'armed))
candidate)
(defun etaf--runtime-rollback-semantic-inverse-journal (candidate)
"Rollback CANDIDATE route/resource journals exactly once."
(when-let* ((inverse (etaf-semantic-candidate-inverse-journal candidate))
((eq (plist-get inverse :state) 'armed)))
(let ((runtime (plist-get inverse :runtime)))
(plist-put inverse :state 'rolling-back)
(unwind-protect
(progn
(etaf--runtime-rollback-prearm
runtime (plist-get inverse :route-journal))
(etaf--runtime-rollback-resource-journal
runtime (plist-get inverse :resource-journal)))
(plist-put inverse :state 'rolled-back))))
candidate)
(defun etaf--runtime-commit-semantic-inverse-journal (candidate)
"Mark CANDIDATE inverse journal committed and no longer rollback-capable."
(when-let* ((inverse (etaf-semantic-candidate-inverse-journal candidate)))
(unless (eq (plist-get inverse :state) 'armed)
(signal 'etaf-generation-error
(list :inverse-journal-not-armed
(plist-get inverse :state))))
(plist-put inverse :state 'committed))
candidate)
(defun etaf--runtime-participant-publish (participant)
"Publish PARTICIPANT generation, restoring old authority on any failure."
(let* ((success nil)
(runtime (etaf--generation-participant-runtime participant))
(semantic-candidate
(etaf--generation-participant-semantic-candidate participant))
(old (etaf-semantic-candidate-expected-generation semantic-candidate))
(candidate
(etaf-semantic-candidate-candidate-generation semantic-candidate))
paint-updates)
(when-let* ((table
(etaf-runtime-candidate-theme-paint-updates runtime)))
(maphash (lambda (slot spec)
(push (cons slot (copy-tree spec)) paint-updates))
table))
(unwind-protect
(progn
(when paint-updates
(setf (etaf--generation-participant-paint-journal participant)
(tp-paint-slot-apply-updates
(etaf-runtime-buffer runtime) paint-updates)))
(etaf--runtime-swap-generation
runtime old candidate semantic-candidate)
(setf (etaf--generation-participant-state participant) 'published
success t))
(unless success
(etaf--runtime-participant-rollback participant)))
participant))
(defun etaf--runtime-participant-rollback (participant)
"Rollback PARTICIPANT generation exactly and idempotently."
(unless (eq (etaf--generation-participant-state participant) 'rolled-back)
(let ((semantic-candidate
(etaf--generation-participant-semantic-candidate participant)))
(etaf--runtime-rollback-generation
(etaf--generation-participant-runtime participant)
(etaf-semantic-candidate-expected-generation semantic-candidate)
(etaf-semantic-candidate-candidate-generation semantic-candidate)
semantic-candidate)
(when-let* ((paint-journal
(etaf--generation-participant-paint-journal participant)))
(tp-paint-slot-rollback-updates paint-journal)
(setf (etaf--generation-participant-paint-journal participant) nil))
(etaf--runtime-rollback-semantic-inverse-journal semantic-candidate)
(setf (etaf--generation-participant-state participant) 'rolled-back)))
participant)
(defun etaf--runtime-participant-commit (participant)
"Commit PARTICIPANT semantic candidate after render final accept."
(let ((candidate
(etaf--generation-participant-semantic-candidate participant)))
(etaf-semantic-candidate-commit candidate)
(etaf--runtime-commit-semantic-inverse-journal candidate)
(setf (etaf--generation-participant-state participant) 'committed)
participant))
(defun etaf--runtime-begin-component-overlay (runtime generation)
"Seed RUNTIME candidate tables from committed GENERATION without traversal."
(etaf--runtime-begin-candidate runtime)
(ignore generation)
(setf (etaf-runtime-candidate-behaviors runtime)
(copy-hash-table (etaf-runtime-behaviors runtime))
(etaf-runtime-candidate-behavior-resource-keys runtime)
(copy-hash-table
(or (etaf-runtime-behavior-resource-keys runtime)
(make-hash-table :test #'equal)))))
(defun etaf--runtime-evaluate-component-input (runtime semantic)
"Recompute RUNTIME SEMANTIC input and enqueue render only when it differs."
(let* ((caller-id (etaf--semantic-component-caller-component-id semantic))
deps)
(etaf--runtime-call-with-component-env
runtime caller-id
(lambda ()
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(let* ((props (etaf--resolve-property-plist
(etaf--semantic-component-input-props semantic)))
(attrs (etaf--resolve-property-plist
(etaf--semantic-component-input-attrs semantic)))
(slots (etaf--semantic-component-input-slots semantic))
(candidate (copy-sequence semantic))
(effect-id
(etaf--semantic-component-input-effect-id semantic)))
(setf (etaf--semantic-component-props candidate) (copy-tree props)
(etaf--semantic-component-attrs candidate) (copy-tree attrs)
(etaf--semantic-component-slots candidate) (copy-tree slots)
(etaf--semantic-component-input-deps candidate)
(nreverse deps))
(puthash (etaf--semantic-component-identity semantic) candidate
(etaf-runtime-candidate-semantic-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'component-input
:semantic-id
(etaf--semantic-component-semantic-id semantic)
:deps (etaf--semantic-component-input-deps candidate))
(etaf-runtime-candidate-effects runtime))
(unless
(and (etaf--runtime-target-value-equal-p
props (etaf--semantic-component-props semantic))
(etaf--runtime-target-value-equal-p
attrs (etaf--semantic-component-attrs semantic))
(etaf--runtime-target-value-equal-p
slots (etaf--semantic-component-slots semantic)))
(etaf--runtime-enqueue-effect
runtime (etaf--semantic-component-effect-id semantic)))))))))
(defun etaf--runtime-retarget-component-slot-ranges (runtime semantic slots)
"Retarget SEMANTIC projection slot effects to candidate SLOTS in RUNTIME."
(let* ((generation (etaf-runtime-current-generation runtime))
(descendants
(etaf--runtime-generation-descendant-ids
generation (etaf--semantic-component-child-ids semantic)))
found)
(dolist (semantic-id descendants)
(when-let* ((slot-range
(let ((node (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
semantic-id)))
(and (etaf--semantic-slot-range-p node) node))))
(setq found t)
(let* ((name (etaf--semantic-slot-range-name slot-range))
(entry (assq name slots))
(content (and entry (cdr entry)))
(old-effect
(etaf--generation-effect
generation (etaf--semantic-slot-range-effect-id slot-range)))
(old-target (etaf--generation-effect-target old-effect))
(owner-id
(if entry
(and (etaf--slot-content-p content)
(etaf--slot-content-owner-component-id content))
(etaf--semantic-slot-range-consumer-component-id slot-range)))
(children
(if entry
(if (etaf--slot-content-p content)
(etaf--slot-content-children content)
content)
(plist-get old-target :children)))
(target
(list :children children :owner-id owner-id
:owner-input
(etaf--runtime-component-env-signature runtime owner-id)
:consumer-id
(etaf--semantic-slot-range-consumer-component-id slot-range)
:style-stack (plist-get old-target :style-stack))))
(unless (etaf--runtime-target-value-equal-p target old-target)
(let ((effect (copy-sequence old-effect)))
(setf (etaf--generation-effect-target effect) target)
(push (etaf--runtime-render-dirty-slot-range
runtime effect slot-range)
(etaf-runtime-candidate-eager-range-changes runtime)))))))
(when found
(let ((candidate (copy-sequence semantic)))
(setf (etaf--semantic-component-slots candidate) (copy-tree slots)
(etaf--semantic-component-input-slots candidate) (copy-tree slots))
(puthash (etaf--semantic-component-identity semantic) candidate
(etaf-runtime-candidate-semantic-nodes runtime))))
found))
(defun etaf--runtime-render-dirty-host-properties (runtime effect semantic)
"Resolve EFFECT for Host SEMANTIC into RUNTIME's candidate graph."
(let* ((base
(or (gethash (etaf--semantic-host-semantic-id semantic)
(etaf-runtime-candidate-graph-nodes runtime))
semantic))
(candidate (copy-sequence base))
(host-ref (etaf--semantic-host-host-ref base))
(property-bindings
(copy-sequence (etaf--semantic-host-property-bindings base)))
(host-props
(copy-tree
(or (and property-bindings
(etaf--semantic-host-base-props base))
(etaf--generation-index-lookup
(etaf-runtime-current-generation runtime)
'host-props host-ref)
nil)))
(theme-bindings
(copy-sequence (etaf--semantic-host-theme-bindings base)))
deps context-deps)
(dolist (binding property-bindings)
(let (local-deps local-context-deps value)
(let ((evaluate
(lambda ()
(let ((etaf--runtime-dependency-collector
(lambda (source)
(cl-pushnew source local-deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew
(cons (etaf-context-owner-id frame) key)
local-context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq value
(etaf--resolve-property-value
(etaf--host-property-binding-expression
binding)))))))
(if-let* ((component-id
(etaf--semantic-host-component-id base)))
(etaf--runtime-call-with-component-env
runtime component-id evaluate)
(funcall evaluate)))
(setq host-props
(plist-put host-props
(etaf--host-property-binding-property binding)
value))
(dolist (source local-deps)
(cl-pushnew source deps :test #'eq))
(dolist (dependency local-context-deps)
(cl-pushnew dependency context-deps :test #'equal))))
(let ((next-base-props (and property-bindings (copy-tree host-props))))
(if property-bindings
(let* ((node
(etaf--view-node-create
:name (etaf--semantic-host-name base)
:token (etaf--semantic-host-site-token base)
:props host-props :children nil))
(etaf--render-style-stack
(copy-tree (etaf--semantic-host-style-identity base)))
(styled (etaf--runtime-style-node
node (etaf--semantic-host-path base)))
(themed (etaf--apply-theme-defaults styled))
(theme-result
(etaf--resolve-theme-property-plist
(etaf--view-node-props themed))))
(setq host-props (nth 0 theme-result)
theme-bindings (nth 1 theme-result))
(dolist (source (nth 2 theme-result))
(cl-pushnew source deps :test #'eq)))
(dolist (binding theme-bindings)
(let* ((property (etaf--theme-property-binding-property binding))
(source (etaf--theme-property-binding-source binding))
(token (etaf--theme-property-binding-token binding))
(resolved
(etaf--theme-token-resolve-from-source token source))
(value
(etaf--runtime-theme-paint-value
runtime property token source resolved)))
(setq host-props (plist-put host-props property value))
(when (or (etaf-ref-p source) (etaf-computed-p source))
(cl-pushnew source deps :test #'eq)))))
(let ((backend-props
(etaf--merge-property
(etaf--ebox-properties host-props
(etaf--semantic-host-path base)
(etaf--semantic-host-site-token base))
:source-identity host-ref)))
(setf (etaf--semantic-host-property-bindings candidate) property-bindings
(etaf--semantic-host-theme-bindings candidate) theme-bindings
(etaf--semantic-host-base-props candidate) next-base-props
(etaf--semantic-host-props-signature candidate) backend-props
(etaf--semantic-host-deps candidate) (nreverse deps)
(etaf--semantic-host-context-deps candidate)
(nreverse context-deps)
(etaf--semantic-host-composition-version candidate)
(1+ (etaf--semantic-host-composition-version base)))
(puthash (etaf--semantic-host-semantic-id candidate) candidate
(etaf-runtime-candidate-graph-nodes runtime))
(puthash host-ref host-props (etaf-runtime-candidate-host-props runtime))
(puthash (etaf--generation-effect-effect-id effect)
(etaf--generation-effect-create
:effect-id (etaf--generation-effect-effect-id effect)
:kind 'host-properties
:semantic-id (etaf--semantic-host-semantic-id candidate)
:deps (etaf--semantic-host-deps candidate))
(etaf-runtime-candidate-effects runtime))
candidate))))
(defun etaf--runtime-render-dirty-component (runtime semantic)
"Render one input-ready SEMANTIC into RUNTIME candidate."
(let* ((identity (etaf--semantic-component-identity semantic))
(effect-id (etaf--semantic-component-effect-id semantic))
(committed
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
(etaf--semantic-component-semantic-id semantic)))
(instance (gethash (etaf--semantic-component-resource-key semantic)
(etaf-runtime-resource-registry runtime)))
(parent-id (etaf--semantic-component-parent-id semantic))
(parent-record
(and parent-id
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
parent-id)))
(parent (and (etaf--semantic-component-p parent-record)
(etaf--semantic-component-identity parent-record)))
(props (etaf--semantic-component-props semantic))
(attrs (etaf--semantic-component-attrs semantic))
(slots (etaf--semantic-component-slots semantic))
(builder (ebox-source-builder-create))
deps context-deps result)
(puthash (etaf--semantic-component-semantic-id semantic)
(list :identity identity :instance instance
:props props :attrs attrs :slots slots)
(etaf-runtime-candidate-component-envs runtime))
(let ((etaf--current-component-identity parent)
(etaf--current-component-semantic-id
(etaf--semantic-component-semantic-id semantic))
(etaf--current-semantic-parent-id
(etaf--semantic-component-semantic-id semantic))
(etaf--render-style-stack
(copy-tree (etaf--semantic-component-caller-style-stack semantic)))
(etaf--render-parent-style-stack nil)
(etaf--ebox-source-builder builder)
(etaf--rendering-component-effect-p t)
(etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq result
(etaf--runtime-render-component-resource
runtime instance identity
props attrs slots
(etaf--semantic-component-path semantic)
(etaf--semantic-component-output-range-id committed)
(etaf--semantic-component-publication-kind committed)
(etaf--runtime-context-frame-for-candidate runtime committed))))
(cl-destructuring-bind
(material-root output-signature raw-slot-reader-p output-nodes
publication-kind range-id context-frame)
result
(let* ((transparent-p (eq publication-kind 'transparent))
(output-range
(and transparent-p
(let ((etaf--ebox-source-builder builder))
(etaf--runtime-stage-component-output-range
runtime committed
(etaf--semantic-component-semantic-id semantic)
effect-id range-id output-signature output-nodes
(etaf--semantic-component-path semantic)))))
(_material-root
(unless (or transparent-p material-root)
(signal 'etaf-runtime-error
(list "Material Component has no canonical root"))))
(input
(ebox-canonical-input-create
(if transparent-p
(copy-sequence output-nodes)
(list material-root))
(ebox-source-builder-finish builder)))
(candidate (copy-sequence semantic))
(committed-input
(if (eq (etaf--semantic-component-publication-kind committed)
'transparent)
(etaf--runtime-committed-range-input
runtime
(etaf--generation-component-output-range
(etaf-runtime-current-generation runtime) committed))
(let ((retained
(and (etaf--semantic-component-artifact-key committed)
(gethash
(etaf--semantic-component-artifact-key committed)
(etaf-runtime-artifact-registry runtime)))))
(or retained
(etaf--runtime-rebuild-component-artifact
runtime committed))))))
(setf (etaf--semantic-component-output-signature candidate)
(copy-tree output-signature)
(etaf--semantic-component-props candidate) (copy-tree props)
(etaf--semantic-component-attrs candidate) (copy-tree attrs)
(etaf--semantic-component-slots candidate) (copy-tree slots)
(etaf--semantic-component-deps candidate) (nreverse deps)
(etaf--semantic-component-raw-slot-reader-p candidate)
raw-slot-reader-p
(etaf--semantic-component-publication-kind candidate)
publication-kind
(etaf--semantic-component-output-range-id candidate)
(and transparent-p
(etaf--semantic-range-semantic-id (car output-range)))
(etaf--semantic-component-artifact-key candidate)
(and (not transparent-p)
(etaf--semantic-component-artifact-key committed))
(etaf--semantic-component-context-frame candidate)
(etaf-context-copy context-frame)
(etaf--semantic-component-context-deps candidate)
(nreverse context-deps)
(etaf--semantic-component-child-ids candidate)
(copy-sequence
(gethash (etaf--semantic-component-semantic-id semantic)
(etaf-runtime-candidate-graph-children runtime))))
(etaf--runtime-enqueue-context-consumers
runtime (etaf--semantic-component-semantic-id semantic)
(etaf--semantic-component-context-frame committed)
(etaf--semantic-component-context-frame candidate))
(let ((new-direct (make-hash-table :test #'eql)))
(dolist (id (etaf--semantic-component-child-ids candidate))
(puthash id t new-direct))
(dolist (old-root (etaf--semantic-component-child-ids committed))
(unless (gethash old-root new-direct)
(dolist (old-id
(etaf--runtime-generation-descendant-ids
(etaf-runtime-current-generation runtime)
(list old-root)))
(cl-pushnew old-id
(etaf-runtime-candidate-removed-semantic-ids runtime)
:test #'eql)))))
(puthash identity candidate
(etaf-runtime-candidate-semantic-nodes runtime))
(puthash (etaf--semantic-component-semantic-id candidate) candidate
(etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'component-render
:semantic-id (etaf--semantic-component-semantic-id semantic)
:deps (etaf--semantic-component-deps candidate))
(etaf-runtime-candidate-effects runtime))
(if transparent-p
(puthash (etaf--semantic-range-effect-id (car output-range)) input
(etaf-runtime-candidate-range-artifacts runtime))
(puthash effect-id input
(etaf-runtime-candidate-artifacts runtime)))
(when (and transparent-p
(etaf--semantic-component-artifact-key committed))
(cl-pushnew
(etaf--semantic-component-artifact-key committed)
(etaf-runtime-candidate-invalidated-artifact-keys runtime)
:test #'equal))
(push identity (etaf-runtime-candidate-rendered-identities runtime))
(list candidate committed-input input)))))
(defun etaf--runtime-render-keyed-range
(runtime effect range component instance)
"Render EFFECT's changed items in keyed RANGE for RUNTIME.
COMPONENT and INSTANCE supply the retained owner environment. Return nil when
the range is not eligible for keyed incremental rendering."
(let* ((expr (etaf--generation-effect-target effect))
(snapshot-function (and (etaf--expr-p expr)
(etaf--expr-range-snapshot expr)))
(key-function (and (etaf--expr-p expr)
(etaf--expr-range-key expr)))
(item-function (and (etaf--expr-p expr)
(etaf--expr-range-item expr)))
(old-signatures (etaf--semantic-range-keyed-item-signatures range))
(old-root-id-index
(etaf--semantic-range-keyed-item-root-id-index range))
(old-node-span-index
(etaf--semantic-range-keyed-item-node-span-index range))
(old-keys (etaf--semantic-range-keyed-key-order range)))
(when (and snapshot-function item-function
(or key-function (eq (etaf--expr-kind expr) 'keyed-list))
(hash-table-p old-signatures)
(hash-table-p old-root-id-index)
(hash-table-p old-node-span-index)
(proper-list-p old-keys))
(let (deps context-deps snapshot)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(etaf--component-instance-state instance))
(etaf--current-component-setup-defined-p
(not (null (etaf--component-spec-setup
(etaf--component-instance-spec instance)))))
(etaf--current-component-setup-complete-p
(etaf--component-instance-setup-complete-p instance))
(etaf--component-phase 'render)
(etaf--current-component-identity
(etaf--semantic-component-identity component))
(etaf--current-component-props
(etaf--semantic-component-props component))
(etaf--current-component-slots
(etaf--semantic-component-slots component))
(etaf--current-context
(etaf--semantic-component-context-frame component))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq snapshot (etaf--runtime-keyed-range-snapshot expr)))
(when snapshot
(let* ((generation (etaf-runtime-current-generation runtime))
(items (plist-get snapshot :items))
(snapshot-keys
(etaf--runtime-keyed-range-keys expr snapshot))
(context (plist-get snapshot :context))
(context-stable-p
(equal-including-properties
context
(etaf--semantic-range-keyed-context-signature range)))
(old-input (etaf--runtime-range-input runtime range))
(old-nodes (ebox-canonical-input-roots old-input))
(seen (make-hash-table :test #'equal))
(missing (make-symbol "etaf-keyed-span-missing"))
(old-node-offset 0)
(new-node-offset 0)
nodes keys signatures reuse-map reused-roots
item-root-groups item-node-counts)
(dolist (key old-keys)
(let ((span (gethash key old-node-span-index missing)))
(unless (and (consp span)
(natnump (car span))
(natnump (cdr span))
(= (car span) old-node-offset)
(<= (+ (car span) (cdr span))
(length old-nodes)))
(signal 'etaf-runtime-error
(list "Keyed Range retained node spans are invalid"
key)))
(cl-incf old-node-offset (cdr span))))
(unless (= old-node-offset (length old-nodes))
(signal 'etaf-runtime-error
(list "Keyed Range retained artifact is misaligned")))
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--render-runtime runtime)
(etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(etaf--component-instance-state instance))
(etaf--current-component-setup-defined-p
(not (null (etaf--component-spec-setup
(etaf--component-instance-spec instance)))))
(etaf--current-component-setup-complete-p
(etaf--component-instance-setup-complete-p instance))
(etaf--component-phase 'render)
(etaf--current-component-identity
(etaf--semantic-component-identity component))
(etaf--current-component-props
(etaf--semantic-component-props component))
(etaf--current-component-slots
(etaf--semantic-component-slots component))
(etaf--current-context
(etaf--semantic-component-context-frame component))
(etaf--current-component-semantic-id
(etaf--semantic-range-component-id range))
(etaf--current-semantic-parent-id
(etaf--semantic-range-semantic-id range))
(etaf--current-range-item-index
(etaf--semantic-range-item-identity-index range))
(etaf--rendering-range-p t)
(etaf--active-effect nil)
(etaf--render-phase-p t)
(etaf--render-style-stack
(copy-tree
(etaf--semantic-range-caller-style-stack range))))
(cl-loop
for item in items
for key in snapshot-keys
for index from 0
do
(let* ((key (etaf--validate-key key))
(old-signature (gethash key old-signatures))
(old-root-ids
(gethash key old-root-id-index missing))
(old-node-span
(gethash key old-node-span-index missing))
(reuse-p
(and context-stable-p
(not (eq old-root-ids missing))
(not (eq old-node-span missing))
(equal-including-properties item old-signature))))
(when (gethash key seen)
(signal 'etaf-runtime-error
(list "Keyed Range keys must be unique" key)))
(puthash key t seen)
(push key keys)
(push (copy-tree item) signatures)
(if reuse-p
(let* ((old-start (car old-node-span))
(old-count (cdr old-node-span))
(old-item-nodes
(cl-subseq old-nodes old-start
(+ old-start old-count))))
(unless (proper-list-p old-root-ids)
(signal 'etaf-runtime-error
(list "Keyed Range retained roots are invalid"
key)))
(dolist (old-root-id old-root-ids)
(let ((semantic
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
old-root-id)))
(unless semantic
(signal 'etaf-runtime-error
(list "Keyed Range retained root is missing"
key old-root-id)))
(etaf--runtime-candidate-add-child
runtime (etaf--semantic-range-semantic-id range)
old-root-id)
(etaf--runtime-carry-committed-subtree
runtime generation semantic)))
(cl-loop for offset below old-count
do (push
(cons (+ new-node-offset offset)
(+ old-start offset))
reuse-map))
(setq nodes (nconc nodes old-item-nodes)
reused-roots
(nconc reused-roots
(copy-sequence old-item-nodes)))
(push (copy-sequence old-root-ids) item-root-groups)
(push old-count item-node-counts)
(cl-incf new-node-offset old-count))
(let* ((before
(length
(gethash
(etaf--semantic-range-semantic-id range)
(etaf-runtime-candidate-graph-children runtime))))
(value
(etaf--runtime-normalize-range-value
(funcall item-function item context)
t))
(rendered
(etaf--render-value-list
value
(etaf--runtime-keyed-range-item-path
(etaf--semantic-range-path range) key)))
(children
(gethash
(etaf--semantic-range-semantic-id range)
(etaf-runtime-candidate-graph-children runtime)))
(root-ids
(copy-sequence (nthcdr before children)))
(node-count (length rendered)))
(setq nodes (nconc nodes rendered))
(push root-ids item-root-groups)
(push node-count item-node-counts)
(cl-incf new-node-offset node-count)))))
(ebox-canonical-input-import-roots
old-input reused-roots etaf--ebox-source-builder)
(list :nodes nodes
:snapshot snapshot
:value (list :keyed-range
(copy-tree context)
(nreverse keys)
(nreverse signatures))
:item-root-groups (nreverse item-root-groups)
:item-node-counts (nreverse item-node-counts)
:deps (nreverse deps)
:context-deps (nreverse context-deps)
:reuse-map (nreverse reuse-map)
;; Ebox validates every non-reused slot against this input's
;; source generation; reused slots are replaced by their
;; exact published objects from the explicit reuse map.
:retain-item-identities-p t))))))))
(defun etaf--runtime-render-dirty-range (runtime effect range)
"Evaluate RUNTIME dirty RANGE EFFECT without running its Component owner."
(let* ((generation (etaf-runtime-current-generation runtime))
(base-component
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
(etaf--semantic-range-component-id range)))
(component
(or (gethash (etaf--semantic-component-identity base-component)
(etaf-runtime-candidate-semantic-nodes runtime))
base-component))
(instance
(gethash (etaf--semantic-component-resource-key component)
(etaf-runtime-resource-registry runtime)))
(builder (ebox-source-builder-create))
deps context-deps value nodes keyed-snapshot
item-root-groups item-node-counts)
(let ((etaf--ebox-source-builder builder))
(let ((keyed
(etaf--runtime-render-keyed-range
runtime effect range component instance)))
(if keyed
(setq deps (plist-get keyed :deps)
context-deps (plist-get keyed :context-deps)
value (plist-get keyed :value)
nodes (plist-get keyed :nodes)
keyed-snapshot (plist-get keyed :snapshot)
item-root-groups (plist-get keyed :item-root-groups)
item-node-counts (plist-get keyed :item-node-counts))
(let ((collector
(lambda (source) (cl-pushnew source deps :test #'eq))))
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-state
(etaf--component-instance-state instance))
(etaf--current-component-setup-defined-p
(not (null (etaf--component-spec-setup
(etaf--component-instance-spec instance)))))
(etaf--current-component-setup-complete-p
(etaf--component-instance-setup-complete-p instance))
(etaf--component-phase 'render)
(etaf--current-component-identity
(etaf--semantic-component-identity component))
(etaf--current-component-props
(etaf--semantic-component-props component))
(etaf--current-component-slots
(etaf--semantic-component-slots component))
(etaf--current-context
(etaf--semantic-component-context-frame component))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq value
(etaf--runtime-normalize-range-value
(funcall (etaf--expr-thunk
(etaf--generation-effect-target effect))))))
;; Lowering may resolve property expressions on Component calls
;; produced by the Range. Keep the lexical Component environment for
;; both normalization and lowering; otherwise prop symbol macros read
;; an empty dynamic environment during an independent Range update.
(etaf--runtime-call-with-component-env
runtime (etaf--semantic-range-component-id range)
(lambda ()
(let ((etaf--runtime-dependency-collector collector)
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--render-runtime runtime)
(etaf--current-component-semantic-id
(etaf--semantic-range-component-id range))
(etaf--current-semantic-parent-id
(etaf--semantic-range-semantic-id range))
(etaf--current-range-item-index
(etaf--semantic-range-item-identity-index range))
(etaf--rendering-range-p t)
(etaf--active-effect nil)
(etaf--render-phase-p t)
(etaf--render-style-stack
(copy-tree (etaf--semantic-range-caller-style-stack range))))
(setq nodes (etaf--render-value-list
value (etaf--semantic-range-path range))))))))
(let* ((item-root-ids
(copy-sequence
(gethash (etaf--semantic-range-semantic-id range)
(etaf-runtime-candidate-graph-children runtime))))
(all-item-ids
(etaf--runtime-candidate-descendant-ids runtime item-root-ids))
(item-index (make-hash-table :test #'equal))
(keyed-metadata
(and keyed-snapshot
(etaf--runtime-keyed-range-metadata
(etaf--generation-effect-target effect)
keyed-snapshot item-root-groups item-node-counts)))
(candidate (copy-sequence range)))
(etaf--runtime-index-range-item-identities
runtime all-item-ids item-index)
(let ((new-set (make-hash-table :test #'eql)))
(dolist (item-id all-item-ids) (puthash item-id t new-set))
(dolist (old-id
(etaf--runtime-generation-descendant-ids
(etaf-runtime-current-generation runtime)
(etaf--semantic-range-item-root-ids range)))
(unless (gethash old-id new-set)
(push old-id
(etaf-runtime-candidate-removed-semantic-ids runtime)))))
(setf (etaf--semantic-range-output-signature candidate) (copy-tree value)
(etaf--semantic-range-deps candidate) (nreverse deps)
(etaf--semantic-range-context-deps candidate) (nreverse context-deps)
(etaf--semantic-range-artifact-key candidate)
(cons (1+ (etaf-runtime-generation runtime))
(etaf--semantic-range-effect-id range))
(etaf--semantic-range-item-root-ids candidate) item-root-ids
(etaf--semantic-range-item-identity-index candidate) item-index
(etaf--semantic-range-keyed-context-signature candidate)
(plist-get keyed-metadata :context)
(etaf--semantic-range-keyed-item-signatures candidate)
(plist-get keyed-metadata :signatures)
(etaf--semantic-range-keyed-item-root-id-index candidate)
(plist-get keyed-metadata :root-id-index)
(etaf--semantic-range-keyed-item-node-span-index candidate)
(plist-get keyed-metadata :node-span-index)
(etaf--semantic-range-keyed-key-order candidate)
(plist-get keyed-metadata :keys)
(etaf--semantic-range-composition-version candidate)
(1+ (etaf--semantic-range-composition-version range)))
(puthash (etaf--semantic-range-semantic-id range) candidate
(etaf-runtime-candidate-graph-nodes runtime))
(puthash (etaf--semantic-range-effect-id range)
(etaf--generation-effect-create
:effect-id (etaf--semantic-range-effect-id range)
:kind (or (etaf--semantic-range-kind range) 'range)
:semantic-id (etaf--semantic-range-semantic-id range)
:deps (etaf--semantic-range-deps candidate)
:target (etaf--generation-effect-target effect))
(etaf-runtime-candidate-effects runtime))
(puthash (etaf--semantic-range-effect-id range)
(etaf--ebox-input-for-nodes nodes)
(etaf-runtime-candidate-range-artifacts runtime))
(etaf--runtime-invalidate-range-ancestors runtime range)
(unless (equal-including-properties
(etaf--semantic-range-output-signature range) value)
(etaf--runtime-record-range-owner-update runtime range))
(list range candidate
(etaf--runtime-committed-range-input runtime range)
(etaf--runtime-range-input runtime candidate)
(plist-get keyed :reuse-map)
;; A keyed render with no reused item owns every payload node in
;; this candidate source generation. Ebox rechecks that proof
;; before retaining identity; other Range paths keep copy-based
;; fallback semantics.
(plist-get keyed :retain-item-identities-p)))))))
(defun etaf--runtime-record-range-owner-update (runtime range)
"Record RANGE's lexical Component lifecycle participation in RUNTIME."
(when-let* ((component-id (etaf--semantic-range-component-id range))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
component-id)))
(cl-pushnew (etaf--semantic-component-identity component)
(etaf-runtime-candidate-updated-component-identities runtime)
:test #'equal)))
(defun etaf--runtime-render-dirty-inline-range (runtime effect inline)
"Evaluate RUNTIME dirty INLINE EFFECT and stage its semantic output."
(let (deps context-deps output)
(etaf--runtime-call-with-component-env
runtime (etaf--semantic-inline-range-component-id inline)
(lambda ()
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder
(lambda (frame key)
(cl-pushnew (cons (etaf-context-owner-id frame) key)
context-deps :test #'equal)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq output
(etaf--runtime-inline-value-string
(funcall
(etaf--expr-thunk (etaf--generation-effect-target effect)))
(etaf--semantic-inline-range-surface-properties inline))))))
(let ((candidate (copy-sequence inline)))
(setf (etaf--semantic-inline-range-output candidate)
(copy-sequence output)
(etaf--semantic-inline-range-deps candidate) (nreverse deps)
(etaf--semantic-inline-range-context-deps candidate)
(nreverse context-deps)
(etaf--semantic-inline-range-composition-version candidate)
(1+ (etaf--semantic-inline-range-composition-version inline)))
(puthash (etaf--semantic-inline-range-semantic-id inline) candidate
(etaf-runtime-candidate-graph-nodes runtime))
(puthash (etaf--semantic-inline-range-effect-id inline)
(etaf--generation-effect-create
:effect-id (etaf--semantic-inline-range-effect-id inline)
:kind 'inline
:semantic-id (etaf--semantic-inline-range-semantic-id inline)
:deps (etaf--semantic-inline-range-deps candidate)
:target (etaf--generation-effect-target effect))
(etaf-runtime-candidate-effects runtime))
(unless (equal-including-properties
(etaf--semantic-inline-range-output inline) output)
(cl-pushnew (etaf--semantic-inline-range-parent-id inline)
(etaf-runtime-candidate-inline-host-ids runtime)
:test #'eql)
(etaf--runtime-invalidate-semantic-ancestors
runtime (etaf--semantic-inline-range-parent-id inline))
(when-let* ((component-id
(etaf--semantic-inline-range-component-id inline))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
component-id)))
(cl-pushnew (etaf--semantic-component-identity component)
(etaf-runtime-candidate-updated-component-identities runtime)
:test #'equal)))
candidate)))
(defun etaf--runtime-render-dirty-slot-range (runtime effect slot-range)
"Evaluate dirty SLOT-RANGE for EFFECT in RUNTIME and stage its backend change."
(let* ((target (etaf--generation-effect-target effect))
(semantic-id (etaf--semantic-slot-range-semantic-id slot-range))
(effect-id (etaf--semantic-slot-range-effect-id slot-range))
(builder (ebox-source-builder-create)))
(let ((etaf--ebox-source-builder builder))
(cl-multiple-value-bind (value deps nodes context-deps)
(etaf--runtime-evaluate-slot-target
runtime target semantic-id
(etaf--semantic-slot-range-item-identity-index slot-range)
(etaf--semantic-slot-range-path slot-range))
(etaf--runtime-finish-slot-range-candidate
runtime (etaf-runtime-current-generation runtime) slot-range
(etaf--semantic-slot-range-identity slot-range) semantic-id effect-id
(etaf--semantic-slot-range-range-ref slot-range)
(etaf--semantic-slot-range-name slot-range)
(etaf--semantic-slot-range-token slot-range)
(plist-get target :owner-id) (plist-get target :consumer-id)
(plist-get target :style-stack)
(etaf--semantic-slot-range-path slot-range)
target value deps nodes context-deps)
(let ((candidate
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime))))
(unless (equal-including-properties
(etaf--semantic-slot-range-output-signature slot-range)
(etaf--semantic-slot-range-output-signature candidate))
(etaf--runtime-invalidate-semantic-ancestors
runtime (etaf--semantic-slot-range-parent-id slot-range))
(etaf--runtime-record-slot-owner-update runtime slot-range))
(list slot-range candidate
(etaf--runtime-committed-range-input runtime slot-range)
(etaf--runtime-range-input runtime candidate)
nil))))))
(defun etaf--runtime-record-slot-owner-update (runtime slot-range)
"Record SLOT-RANGE author lifecycle participation in RUNTIME."
(when-let* ((owner-id
(etaf--semantic-slot-range-owner-component-id slot-range))
(owner
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
owner-id)))
(cl-pushnew (etaf--semantic-component-identity owner)
(etaf-runtime-candidate-updated-component-identities runtime)
:test #'equal)))
(defun etaf--runtime-invalidate-range-ancestors (runtime range)
"Invalidate RUNTIME artifacts above changed RANGE without running effects."
(etaf--runtime-invalidate-semantic-ancestors
runtime (etaf--semantic-range-parent-id range)))
(defun etaf--runtime-range-change-has-backend-anchor-p (runtime change)
"Return whether CHANGE has a live Ebox publication anchor in RUNTIME."
(let* ((range (car change))
(ref (and range (etaf--semantic-backend-range-ref range))))
(and ref
(ebox-range-ref-present-p (etaf-runtime-buffer runtime) ref))))
(defun etaf--runtime-range-direct-node-signature
(runtime generation semantic-id candidate-p)
"Return SEMANTIC-ID's direct material signature in RUNTIME.
When CANDIDATE-P is non-nil, read the candidate overlay before GENERATION.
Nested Range identity is retained, but its internal artifact is deliberately
excluded so descendant-only work cannot masquerade as an ancestor change."
(let ((semantic
(or (and candidate-p
(gethash semantic-id
(etaf-runtime-candidate-graph-nodes runtime)))
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) semantic-id))))
(cond
((etaf--semantic-host-p semantic)
(list 'host
(etaf--semantic-host-identity semantic)
(etaf--semantic-host-name semantic)
(etaf--semantic-host-props-signature semantic)
(etaf--semantic-host-content semantic)
(mapcar
(lambda (part)
(if (integerp part)
(etaf--runtime-range-direct-node-signature
runtime generation part candidate-p)
part))
(etaf--semantic-host-content-parts semantic))
(mapcar
(lambda (child-id)
(etaf--runtime-range-direct-node-signature
runtime generation child-id candidate-p))
(etaf--semantic-host-child-ids semantic))))
((etaf--semantic-component-p semantic)
(list 'component
(etaf--semantic-component-identity semantic)
(etaf--semantic-component-publication-kind semantic)
(mapcar
(lambda (child-id)
(etaf--runtime-range-direct-node-signature
runtime generation child-id candidate-p))
(etaf--semantic-component-child-ids semantic))))
((or (etaf--semantic-range-p semantic)
(etaf--semantic-slot-range-p semantic))
(list 'range-anchor
(etaf--semantic-backend-range-semantic-id semantic)
(etaf--semantic-backend-range-ref semantic)))
((etaf--semantic-inline-range-p semantic)
(list 'inline (etaf--semantic-inline-range-output semantic)))
(t (list 'missing semantic-id)))))
(defun etaf--runtime-range-direct-payload-equal-p
(runtime generation old candidate)
"Return whether OLD and CANDIDATE own the same direct Range payload.
RUNTIME and GENERATION provide committed and candidate node signatures."
(and (equal
(etaf--semantic-backend-range-item-root-ids old)
(etaf--semantic-backend-range-item-root-ids candidate))
(equal-including-properties
(mapcar
(lambda (semantic-id)
(etaf--runtime-range-direct-node-signature
runtime generation semantic-id nil))
(etaf--semantic-backend-range-item-root-ids old))
(mapcar
(lambda (semantic-id)
(etaf--runtime-range-direct-node-signature
runtime generation semantic-id t))
(etaf--semantic-backend-range-item-root-ids candidate)))))
(defun etaf--runtime-normalize-range-changes (runtime generation changes)
"Normalize RUNTIME CHANGES against GENERATION in staged order.
Return a non-overlapping change list.
An ancestor absorbs descendants only when its own direct material payload
changed. If its root identity/cardinality and direct payload are stable, its
staged artifact differs solely because it contains a descendant candidate;
drop that ancestor and publish the deepest direct change instead."
(let ((changed (make-hash-table :test #'eql))
(direct-changed (make-hash-table :test #'eql))
normalized)
(dolist (change changes)
(when-let* ((range (car change)))
(puthash (etaf--semantic-backend-range-semantic-id range)
change changed)))
(maphash
(lambda (semantic-id change)
(unless (etaf--runtime-range-direct-payload-equal-p
runtime generation (car change) (cadr change))
(puthash semantic-id t direct-changed)))
changed)
(dolist (change changes)
(let* ((range (car change))
(semantic-id
(etaf--semantic-backend-range-semantic-id range))
(parent-id (etaf--generation-parent-id generation semantic-id))
absorbed-p)
(while (and parent-id (not absorbed-p))
(when (gethash parent-id direct-changed)
(setq absorbed-p t))
(unless absorbed-p
(setq parent-id
(etaf--generation-parent-id generation parent-id))))
(unless (or absorbed-p
(not (gethash semantic-id direct-changed))
(not (eq change (gethash semantic-id changed))))
(push change normalized))))
(nreverse normalized)))
(defun etaf--runtime-invalidate-semantic-ancestors (runtime parent-id)
"Invalidate RUNTIME artifacts from PARENT-ID through semantic ancestors."
(let* ((generation (etaf-runtime-current-generation runtime))
(nodes (etaf-generation-semantic-nodes generation)))
(while (and parent-id (> parent-id 0))
(let ((record (etaf--pvec-get nodes parent-id)))
(cond
((etaf--semantic-host-p record)
(let ((candidate (copy-sequence record)))
(cl-incf (etaf--semantic-host-composition-version candidate))
(puthash parent-id candidate
(etaf-runtime-candidate-graph-nodes runtime))
(setq parent-id (etaf--semantic-host-parent-id record))))
((etaf--semantic-component-p record)
(let ((candidate
(copy-sequence
(or (gethash (etaf--semantic-component-identity record)
(etaf-runtime-candidate-semantic-nodes runtime))
record))))
(when-let* ((key (etaf--semantic-component-artifact-key record)))
(push key
(etaf-runtime-candidate-invalidated-artifact-keys runtime)))
(setf (etaf--semantic-component-artifact-key candidate) nil)
(cl-incf (etaf--semantic-component-composition-version candidate))
(puthash (etaf--semantic-component-identity record) candidate
(etaf-runtime-candidate-semantic-nodes runtime))
(puthash parent-id candidate
(etaf-runtime-candidate-graph-nodes runtime))
(setq parent-id (etaf--semantic-component-parent-id record))))
(t (setq parent-id nil)))))))
(defun etaf--runtime-compose-inline-parts
(runtime generation parts &optional candidate-p)
"Compose inline PARTS from GENERATION and optional RUNTIME candidate nodes."
(apply
#'concat
(mapcar
(lambda (part)
(if (integerp part)
(let ((inline
(or (and candidate-p
(gethash part
(etaf-runtime-candidate-graph-nodes runtime)))
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) part))))
(etaf--semantic-inline-range-output inline))
part))
parts)))
(defun etaf--runtime-stage-inline-host (runtime generation host-id)
"Stage RUNTIME HOST-ID content after inline effects using GENERATION."
(let* ((old-host (etaf--pvec-get
(etaf-generation-semantic-nodes generation) host-id))
(host (or (gethash host-id
(etaf-runtime-candidate-graph-nodes runtime))
(copy-sequence old-host)))
(parts (etaf--semantic-host-content-parts old-host))
(old-content
(etaf--runtime-compose-inline-parts runtime generation parts nil))
(new-content
(etaf--runtime-compose-inline-parts runtime generation parts t)))
(setf (etaf--semantic-host-content host) (copy-sequence new-content))
(puthash host-id host (etaf-runtime-candidate-graph-nodes runtime))
(list host
(etaf--runtime-lower-semantic-host-content-input
old-host old-content)
(etaf--runtime-lower-semantic-host-content-input
host new-content))))
(defun etaf--runtime-inline-host-owner-rendered-p
(runtime generation host-id rendered-identities)
"Return whether RUNTIME HOST-ID owner rendered in GENERATION.
RENDERED-IDENTITIES names the Component render participants."
(let* ((host (or (gethash host-id
(etaf-runtime-candidate-graph-nodes runtime))
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) host-id)))
(inline-id (cl-find-if #'integerp
(etaf--semantic-host-content-parts host)))
(inline (and inline-id
(or (gethash inline-id
(etaf-runtime-candidate-graph-nodes runtime))
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
inline-id))))
(component-id
(and inline (etaf--semantic-inline-range-component-id inline)))
(component
(and component-id
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
component-id))))
(and component
(member (etaf--semantic-component-identity component)
rendered-identities))))
(defun etaf--generation-host-owner-component-identity (generation host)
"Return HOST's nearest Component identity in GENERATION, or nil."
(let ((semantic-id (etaf--semantic-host-semantic-id host)) owner)
(while (and semantic-id (not owner))
(setq semantic-id
(etaf--generation-parent-id generation semantic-id))
(when semantic-id
(let ((semantic
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
semantic-id)))
(when (etaf--semantic-component-p semantic)
(setq owner (etaf--semantic-component-identity semantic))))))
owner))
(defun etaf--runtime-restore-component-overlay-retry
(runtime retry-effect-ids)
"Restore failed RUNTIME overlay work for RETRY-EFFECT-IDS."
(etaf--runtime-clear-dirty-effects runtime)
(dolist (effect-id retry-effect-ids)
(etaf--runtime-enqueue-effect runtime effect-id))
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-rollback-behaviors runtime)
(etaf--runtime-clear-candidate runtime))
(defun etaf--runtime-component-overlay (runtime)
"Publish RUNTIME dirty Component effects without traversing Root."
(cl-block etaf--runtime-component-overlay
(let* ((old (etaf-runtime-current-generation runtime))
(queued-effect-ids
(copy-sequence (etaf-runtime-dirty-effect-queue runtime)))
(retry-effect-ids
(cl-remove-if-not
(lambda (effect-id)
(etaf--generation-effect old effect-id))
queued-effect-ids))
changes range-changes inline-changes host-property-semantics host-changes
backend-component-identities
journal resource-journal candidate-generation semantic-candidate
participant)
(let ((evaluation-completed-p nil))
(unwind-protect
(progn
(etaf--runtime-begin-component-overlay runtime old)
;; A source notification can race a generation promotion and leave an old
;; effect id in the FIFO. Keep the dirty-id set and FIFO coherent before
;; sorting; stale ids are retired by the candidate generation cleanup.
(dolist (effect-id queued-effect-ids)
(unless (etaf--generation-effect old effect-id)
(remhash effect-id (etaf-runtime-dirty-effect-ids runtime))))
(setf (etaf-runtime-dirty-effect-queue runtime)
(etaf--runtime-sort-dirty-effects old retry-effect-ids)
(etaf-runtime-dirty-effect-queue-tail runtime)
(last (etaf-runtime-dirty-effect-queue runtime)))
(while (etaf-runtime-dirty-effect-queue runtime)
(let* ((effect-id (etaf--runtime-pop-effect runtime))
(effect (etaf--generation-effect old effect-id))
(base-semantic
(and effect (etaf--generation-effect-semantic old effect-id)))
(semantic
(and base-semantic
(if (etaf--semantic-component-p base-semantic)
(or (gethash
(etaf--semantic-component-identity base-semantic)
(etaf-runtime-candidate-semantic-nodes runtime))
base-semantic)
(or (gethash
(etaf--generation-effect-semantic-id effect)
(etaf-runtime-candidate-graph-nodes runtime))
base-semantic)))))
(if (and effect semantic
(etaf--runtime-scheduled-semantic-live-p
old effect base-semantic))
(progn
(etaf--runtime-record-effect-input-version
runtime old effect-id)
(unless (and (memq (etaf--generation-effect-kind effect)
'(range fragment slot inline))
(etaf--runtime-range-owned-by-rendered-component-p
runtime old base-semantic))
(pcase (etaf--generation-effect-kind effect)
('component-input
(etaf--runtime-evaluate-component-input runtime semantic)
;; Input evaluation may enqueue the Component render while
;; lower-priority inline/Range effects are already waiting
;; in this turn. Restore the priority order immediately
;; so the render observes the final input before those
;; effects can seed a stale candidate.
(setf (etaf-runtime-dirty-effect-queue runtime)
(etaf--runtime-sort-dirty-effects
old
(etaf-runtime-dirty-effect-queue runtime))
(etaf-runtime-dirty-effect-queue-tail runtime)
(last (etaf-runtime-dirty-effect-queue runtime)))
;; `component-render' deliberately keeps its historical
;; sort class for the public priority contract, but a
;; render created by this input update must run before an
;; already queued child Range/inline effect. Move only
;; this known dependent to the front of the remaining
;; turn; the ordinary FIFO remains unchanged otherwise.
(let ((render-id
(etaf--semantic-component-effect-id semantic)))
(when (gethash render-id
(etaf-runtime-dirty-effect-ids runtime))
(setf (etaf-runtime-dirty-effect-queue runtime)
(cons
render-id
(delq render-id
(etaf-runtime-dirty-effect-queue runtime)))
(etaf-runtime-dirty-effect-queue-tail runtime)
(last (etaf-runtime-dirty-effect-queue runtime))))))
('component-render
(unless (member (etaf--semantic-component-identity semantic)
(etaf-runtime-candidate-rendered-identities
runtime))
(push (etaf--runtime-render-dirty-component runtime semantic)
changes)))
('host-properties
(push (etaf--runtime-render-dirty-host-properties
runtime effect semantic)
host-property-semantics))
((or 'range 'fragment)
(push (etaf--runtime-render-dirty-range
runtime effect semantic)
range-changes))
('slot
(push (etaf--runtime-render-dirty-slot-range
runtime effect semantic)
range-changes))
('inline
(etaf--runtime-render-dirty-inline-range
runtime effect semantic)))))
;; A route can deliver an effect queued by the previous generation
;; after that semantic subtree has already been removed. Retire the
;; effect from the next generation instead of evaluating a nil owner.
(cl-pushnew effect-id
(etaf-runtime-candidate-removed-effect-ids runtime)
:test #'eql))))
(setq evaluation-completed-p t))
(unless evaluation-completed-p
(etaf--runtime-restore-component-overlay-retry
runtime retry-effect-ids))))
(setq range-changes
(append (nreverse
(etaf-runtime-candidate-eager-range-changes runtime))
range-changes))
(setq range-changes
(cl-remove-if
(lambda (change)
(ebox-canonical-input-equal-p
(nth 2 change) (nth 3 change)))
range-changes))
(let (material-changes)
(dolist (change changes)
(let ((candidate (car change)))
(if (eq (etaf--semantic-component-publication-kind candidate)
'transparent)
(let* ((committed
(etaf--pvec-get
(etaf-generation-semantic-nodes old)
(etaf--semantic-component-semantic-id candidate)))
(old-range
(etaf--pvec-get
(etaf-generation-semantic-nodes old)
(etaf--semantic-component-output-range-id committed)))
(new-range
(gethash (etaf--semantic-component-output-range-id candidate)
(etaf-runtime-candidate-graph-nodes runtime))))
(unless (ebox-canonical-input-equal-p
(nth 1 change) (nth 2 change))
(push (list old-range new-range
(nth 1 change) (nth 2 change) nil)
range-changes)))
(push change material-changes))))
(setq changes
(cl-remove-if
(lambda (change)
(ebox-canonical-input-equal-p
(nth 1 change) (nth 2 change)))
(nreverse material-changes))))
(setq backend-component-identities
(mapcar (lambda (change)
(etaf--semantic-component-identity (car change)))
changes))
(dolist (host-id (etaf-runtime-candidate-inline-host-ids runtime))
(unless (etaf--runtime-inline-host-owner-rendered-p
runtime old host-id backend-component-identities)
(push (etaf--runtime-stage-inline-host runtime old host-id)
inline-changes)))
(setq range-changes
(cl-remove-if
(lambda (change)
(let* ((range (car change))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes old)
(etaf--semantic-backend-range-container-component-id
range))))
(member (etaf--semantic-component-identity component)
backend-component-identities)))
range-changes))
(setq range-changes
(etaf--runtime-normalize-range-changes runtime old range-changes))
;; A semantic Range may be nested below a material Component whose
;; backend publication exposes only the ancestor component-output anchor.
;; Never submit an address that Ebox cannot resolve against this base;
;; discard the local candidate and let the next branch publish one exact
;; root candidate. This is a proof miss, not an exception path.
(let (fallback-component-effect-ids fallback-p)
(dolist (change range-changes)
(unless (etaf--runtime-range-change-has-backend-anchor-p
runtime change)
(setq fallback-p t)
(when-let* ((range (car change))
(component-id
(etaf--semantic-backend-range-container-component-id
range))
(component
(etaf--pvec-get
(etaf-generation-semantic-nodes old) component-id)))
(cl-pushnew
(etaf--semantic-component-effect-id component)
fallback-component-effect-ids :test #'eql))))
(when fallback-p
;; Re-render the material owner during the root fallback. A root
;; rebuild may otherwise carry its old artifact and leave the source
;; value visually stale even though the invalid Range was discarded.
(etaf--runtime-mark-root-dirty runtime)
(etaf--runtime-clear-dirty-effects runtime)
(dolist (effect-id fallback-component-effect-ids)
(puthash effect-id t (etaf-runtime-dirty-effect-ids runtime)))
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-clear-candidate runtime)
(cl-return-from etaf--runtime-component-overlay :root-fallback)))
(setq candidate-generation (etaf--runtime-build-generation runtime old)
;; Component artifacts are first produced while dirty effects are
;; still being evaluated. Rebuild material publication roots from
;; the final candidate Generation so a same-turn Host property
;; effect cannot be hidden by its rendered ancestor Component.
changes
(mapcar
(lambda (change)
(let* ((semantic (car change))
(input
(etaf--runtime-component-artifact-from-generation
runtime candidate-generation semantic)))
(puthash (etaf--semantic-component-effect-id semantic) input
(etaf-runtime-candidate-artifacts runtime))
(list semantic (nth 1 change) input)))
changes))
(dolist (host (nreverse host-property-semantics))
(unless (member
(etaf--generation-host-owner-component-identity
candidate-generation host)
backend-component-identities)
(let* ((semantic-id (etaf--semantic-host-semantic-id host))
(old-host
(etaf--pvec-get (etaf-generation-semantic-nodes old)
semantic-id)))
(unless
(equal-including-properties
(etaf--semantic-host-props-signature old-host)
(etaf--semantic-host-props-signature host))
(push
(list old-host
(etaf--runtime-lower-semantic-host-shallow old-host)
(etaf--runtime-lower-semantic-host-shallow host)
semantic-id)
host-changes)))))
(setq host-changes (nreverse host-changes))
(setq semantic-candidate
(etaf--runtime-new-semantic-candidate
runtime candidate-generation))
(condition-case err
(progn
(setq resource-journal
(etaf--runtime-preinstall-resources
runtime old candidate-generation)
participant
(etaf--generation-participant-create
:runtime runtime :semantic-candidate semantic-candidate)
journal
(etaf--runtime-prearm-generation runtime candidate-generation))
(etaf--runtime-bind-semantic-inverse-journal
semantic-candidate runtime resource-journal journal)
(if (and (null changes)
(null range-changes)
(cl-every
(lambda (change)
(equal-including-properties
(nth 1 change) (nth 2 change)))
inline-changes)
(null host-changes))
(etaf--runtime-participant-publish participant)
(let ((candidate
(ebox-candidate-begin (etaf-runtime-buffer runtime))))
(dolist (change changes)
(ebox-candidate-replace-host-ref
candidate
(ebox-canonical-input-root-host-ref (nth 1 change))
(nth 2 change)))
(dolist (change range-changes)
(let ((reuse-map (nth 4 change))
(retain-item-identities-p (nth 5 change)))
;; Keep the optional identity-retention flag off the call
;; when it is not needed. Besides avoiding an unnecessary
;; argument on the common path, this preserves the stable
;; three/four-argument integration boundary for callers
;; which only observe ordinary Range replacement.
(if retain-item-identities-p
(ebox-candidate-replace-range-ref
candidate (etaf--semantic-backend-range-ref (car change))
(nth 3 change) reuse-map retain-item-identities-p)
(ebox-candidate-replace-range-ref
candidate (etaf--semantic-backend-range-ref (car change))
(nth 3 change) reuse-map))))
(dolist (change inline-changes)
(ebox-candidate-replace-host-ref
candidate (etaf--semantic-host-host-ref (car change))
(nth 2 change)))
(dolist (change host-changes)
(unless
(ebox-candidate-patch-host-paint
candidate (etaf--semantic-host-host-ref (car change))
(nth 1 change) (nth 2 change))
(ebox-candidate-replace-host-ref
candidate (etaf--semantic-host-host-ref (car change))
(etaf--runtime-lower-semantic-input
runtime candidate-generation (nth 3 change)))))
(etaf-render-port-update
(etaf-runtime-buffer runtime) candidate
(lambda (_report)
(etaf--runtime-participant-publish participant))
(lambda (_report)
(etaf--runtime-participant-rollback participant))))))
((error quit)
(when semantic-candidate
(etaf-semantic-candidate-rollback semantic-candidate)
(etaf--runtime-rollback-semantic-inverse-journal
semantic-candidate))
(etaf--runtime-rollback-prearm runtime journal)
(etaf--runtime-rollback-resource-journal runtime resource-journal)
(etaf--runtime-restore-component-overlay-retry
runtime retry-effect-ids)
(signal (car err) (cdr err))))
(etaf--runtime-participant-commit participant)
(let ((retirement
(etaf--runtime-new-retirement-journal
runtime (etaf-semantic-candidate-candidate-id semantic-candidate)))
updated first-condition public-condition)
(cl-labels
((run-step
(kind function)
(when-let* ((condition
(etaf--runtime-run-postcommit-step
retirement 'component-overlay kind function)))
(unless first-condition
(setq first-condition condition)))))
(run-step
'generation-completion
(lambda ()
(etaf--runtime-complete-generation runtime candidate-generation)))
(run-step
'generation-mirror-projection
(lambda ()
(etaf--runtime-install-generation-mirrors
runtime candidate-generation nil)))
(etaf--runtime-clear-dirty-effects runtime)
(unwind-protect
(progn
(run-step
'lifecycle-preparation
(lambda ()
(dolist (instance (etaf-runtime-candidate-created runtime))
(setf (etaf--component-instance-mounted-p instance) t))
(dolist (entry (etaf--generation-index-entries
candidate-generation 'lifecycle))
(let ((identity (car entry)))
(when-let*
((semantic (etaf--generation-semantic old identity))
(instance
(gethash
(etaf--semantic-component-resource-key semantic)
(etaf-runtime-resource-registry runtime))))
(push instance updated))))
(etaf--runtime-run-lifecycle
(list (etaf-runtime-candidate-created runtime)
(nreverse updated))
retirement)))
(setq public-condition
(etaf--runtime-drain-retirement runtime retirement t))
(when-let* ((condition (or first-condition public-condition)))
(etaf-retirement-resignal condition retirement)))
(etaf--runtime-clear-candidate runtime)))))))
(defun etaf--runtime-render-effect (runtime)
"Build and publish one Root-owned candidate for RUNTIME."
(setf (etaf-runtime-candidate-full-rebuild-p runtime) t)
(let ((old-generation (etaf-runtime-current-generation runtime))
next-root root-node candidate-generation semantic-candidate
journal resource-journal participant)
(condition-case err
(let* ((source-builder (ebox-source-builder-create))
(etaf--render-runtime runtime)
(etaf--ebox-source-builder source-builder)
(root-deps (copy-sequence
(etaf-runtime-candidate-root-deps runtime)))
(etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source root-deps :test #'eq)))
(etaf--active-effect nil)
(nodes (etaf--runtime-render-root runtime)))
(setf (etaf-runtime-candidate-root-deps runtime)
(nreverse root-deps))
(etaf--runtime-stage-root-range
runtime (etaf-runtime-candidate-root-deps runtime))
(setq root-node
(etaf--ebox-forest-root
nodes
(list 'etaf-runtime-root
(etaf-runtime-mount-epoch runtime)))
next-root
(ebox-canonical-input-create
(list root-node)
(ebox-source-builder-finish source-builder)))
(setq candidate-generation
(etaf--runtime-build-generation runtime old-generation)
semantic-candidate
(etaf--runtime-new-semantic-candidate
runtime candidate-generation)
resource-journal (etaf--runtime-preinstall-resources
runtime old-generation candidate-generation)
participant (etaf--generation-participant-create
:runtime runtime
:semantic-candidate semantic-candidate)
journal
(etaf--runtime-prearm-generation runtime candidate-generation))
(etaf--runtime-bind-semantic-inverse-journal
semantic-candidate runtime resource-journal journal)
(if old-generation
(let ((candidate (ebox-candidate-begin
(etaf-runtime-buffer runtime))))
(ebox-candidate-replace-root candidate next-root)
(etaf-render-port-update
(etaf-runtime-buffer runtime) candidate
(lambda (_report)
(etaf--runtime-participant-publish participant))
(lambda (_report)
(etaf--runtime-participant-rollback participant))))
(let* ((host-authority (etaf-runtime-host-authority runtime))
(legacy-p
(eq (etaf-render-port-route
(etaf-render-port-selected))
'v1)))
(etaf-render-port-initial
(etaf-runtime-buffer runtime) next-root
(lambda (_report)
(etaf--runtime-participant-publish participant)
(etaf-host-authority-stage-attach
host-authority legacy-p))
(lambda (_report)
(etaf-host-authority-rollback-attach host-authority)
(etaf--runtime-participant-rollback participant))
(and (etaf-runtime-observer runtime)
#'etaf--runtime-forward-ebox-report))
(etaf-host-authority-finish-attach host-authority))))
((error quit)
(when semantic-candidate
(etaf-semantic-candidate-rollback semantic-candidate)
(etaf--runtime-rollback-semantic-inverse-journal
semantic-candidate))
(etaf--runtime-rollback-prearm runtime journal)
(etaf--runtime-rollback-resource-journal runtime resource-journal)
(etaf--runtime-clear-dirty-effects runtime)
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-rollback-behaviors runtime)
(etaf--runtime-clear-candidate runtime)
(signal (car err) (cdr err))))
(etaf--runtime-participant-commit participant)
;; Publication has completed. Lifecycle and cleanup callbacks run after
;; the retained state is promoted; their errors remain visible without
;; incorrectly rolling back an already published Ebox tree.
(let ((retirement
(etaf--runtime-new-retirement-journal
runtime (etaf-semantic-candidate-candidate-id semantic-candidate)))
groups first-condition public-condition)
(cl-labels
((run-step
(kind function)
(when-let* ((condition
(etaf--runtime-run-postcommit-step
retirement 'root-render kind function)))
(unless first-condition
(setq first-condition condition)))))
(run-step
'generation-completion
(lambda ()
(etaf--runtime-complete-generation runtime candidate-generation)))
(run-step
'generation-mirror-projection
(lambda ()
(etaf--runtime-install-generation-mirrors
runtime candidate-generation t)))
(setf (etaf-runtime-root-node runtime) root-node
(etaf-runtime-root-dirty-p runtime) nil)
(etaf--runtime-clear-dirty-effects runtime)
(unwind-protect
(progn
(run-step
'authority-retirement-preparation
(lambda ()
(setq groups (etaf--runtime-promote runtime retirement))
(etaf--runtime-promote-behaviors runtime retirement)
(etaf--runtime-run-lifecycle groups retirement)))
(setq public-condition
(etaf--runtime-drain-retirement runtime retirement t))
(when-let* ((condition (or first-condition public-condition)))
(etaf-retirement-resignal condition retirement)))
(etaf--runtime-rollback-behaviors runtime)
(etaf--runtime-clear-candidate runtime))))
next-root))
(defun etaf--runtime-render-root-turn (runtime &optional force-components-p)
"Evaluate and publish one full root turn for RUNTIME.
When FORCE-COMPONENTS-P is non-nil, re-evaluate retained Components whose
backend anchor proof failed; ordinary root turns keep their artifact reuse."
(let ((etaf--runtime-force-full-component-render-p force-components-p))
(etaf--runtime-record-effect-input-version
runtime (etaf-runtime-current-generation runtime)
(etaf-runtime-root-effect-id runtime))
(etaf--runtime-begin-candidate runtime)
(setf (etaf-runtime-root-view-cache runtime)
(etaf--runtime-evaluate-root-candidate runtime))
(etaf--runtime-render-effect runtime)))
(defun etaf--runtime-request-flush-now (runtime)
"Flush RUNTIME now, or mark one follow-up flush while busy."
(let ((etaf--scheduler-context
(or (etaf-runtime-scheduler-context runtime)
etaf-scheduler-default-context)))
(when (etaf-runtime-mounted-p runtime)
(if (or (> (etaf-runtime-event-depth runtime) 0)
(etaf-runtime-flushing-p runtime))
(setf (etaf-runtime-pending-p runtime) t)
(setf (etaf-runtime-flushing-p runtime) t)
(let* ((etaf--runtime-fixed-point-stamps
(make-hash-table :test #'equal))
(etaf--runtime-fixed-point-steps 0)
(etaf--runtime-fixed-point-history nil)
(etaf--runtime-fixed-point-step-bound
(plist-get
(etaf--runtime-fixed-point-graph-size
runtime (etaf-runtime-current-generation runtime))
:bound)))
(unwind-protect
(progn
(if (etaf-runtime-root-dirty-p runtime)
(etaf--runtime-render-root-turn runtime)
(when (eq (etaf--runtime-component-overlay runtime)
:root-fallback)
(etaf--runtime-render-root-turn runtime t)))
(while (etaf-runtime-pending-p runtime)
(setf (etaf-runtime-pending-p runtime) nil)
(if (etaf-runtime-root-dirty-p runtime)
(etaf--runtime-render-root-turn runtime)
(when (eq (etaf--runtime-component-overlay runtime)
:root-fallback)
(etaf--runtime-render-root-turn runtime t)))))
(setf (etaf-runtime-flushing-p runtime) nil)))))))
(defun etaf--runtime-request-flush (runtime)
"Flush RUNTIME within one optional Runtime operation boundary."
(etaf--runtime-with-operation (runtime 'flush "reactive flush")
(etaf--runtime-request-flush-now runtime)))
;;;###autoload
(defun etaf-runtime-flush (&optional runtime)
"Flush mounted RUNTIME immediately and return its root Ebox node."
(let ((runtime (etaf-runtime-require-mounted runtime)))
(etaf--runtime-request-flush runtime)
(etaf-runtime-root-node runtime)))
(defun etaf--runtime-mount-now
(buffer-or-name view observer &optional scheduler-context)
"Mount VIEW into BUFFER-OR-NAME with OBSERVER and SCHEDULER-CONTEXT."
(setq scheduler-context
(or scheduler-context etaf-scheduler-default-context))
(let ((etaf--scheduler-context scheduler-context))
(let* ((buffer (get-buffer-create buffer-or-name))
(old (gethash buffer etaf--runtime-table)))
(when old
(etaf-runtime-unmount old))
(let* ((scope (etaf-effect-scope
:detached t :name buffer
:scheduler-context scheduler-context))
(mount-epoch (cl-incf etaf--mount-epoch-counter))
(host-authority
(etaf-host-authority-create
(list 'etaf-runtime mount-epoch) mount-epoch buffer))
(runtime (etaf--runtime-create
:buffer buffer
:root-view view
:scope scope
:scheduler-context scheduler-context
:instances (make-hash-table :test #'equal)
:resource-registry (make-hash-table :test #'equal)
:mount-epoch mount-epoch
:host-authority host-authority
:next-resource-id 0
:next-effect-id 0
:next-semantic-id 1
:generation-authority
(etaf-generation-authority-create)
:root-effect-id 0
:root-range-id 1
:artifact-registry (make-hash-table :test #'equal)
:range-artifact-registry (make-hash-table :test #'equal)
:candidate-artifacts (make-hash-table :test #'equal)
:candidate-range-artifacts (make-hash-table :test #'eql)
:route-sources (make-hash-table :test #'eq)
:dirty-effect-ids (make-hash-table :test #'eql)
:handlers (make-hash-table :test #'equal)
:host-props (make-hash-table :test #'equal)
:theme-paint-slots (make-hash-table :test #'eq)
:behaviors (make-hash-table :test #'equal)
:behavior-resource-keys (make-hash-table :test #'equal)
:observer observer
:root-dirty-p t)))
(etaf-host-authority-begin-attach host-authority)
(puthash buffer runtime etaf--runtime-table)
(with-current-buffer buffer
(add-hook 'kill-buffer-hook #'etaf--runtime-kill-buffer nil t))
(let ((route (etaf-runtime-route-create
:runtime-id (etaf-runtime-mount-epoch runtime)
:mount-epoch (etaf-runtime-mount-epoch runtime)
:authority-token
(etaf-host-authority-token host-authority)
:scheduler 'etaf--runtime-route-scheduler
:scheduler-context scheduler-context
:accepts-p 'etaf--runtime-authorized-route-runtime)))
(setf (etaf-runtime-route-token runtime) route)
(puthash (etaf-runtime-mount-epoch runtime) runtime
etaf--runtime-route-registry))
(condition-case err
(etaf--runtime-with-operation
(runtime 'mount
(format "mount %s" (buffer-name buffer)))
(etaf--runtime-begin-candidate runtime)
(setf (etaf-runtime-flushing-p runtime) t
(etaf-runtime-root-view-cache runtime)
(etaf--runtime-evaluate-root-candidate runtime))
(unwind-protect
(etaf--runtime-render-effect runtime)
(setf (etaf-runtime-flushing-p runtime) nil))
(when (etaf-runtime-pending-p runtime)
(setf (etaf-runtime-pending-p runtime) nil)
(etaf--runtime-request-flush runtime))
(when (fboundp 'etaf-events-enable-input)
(etaf-events-enable-input buffer))
buffer)
((error quit)
;; Postaccept lifecycle errors leave an attached Runtime queryable.
;; Preaccept failures have no Host authority and discard registration.
(unless (etaf-host-authority-attached-p host-authority)
(setf (etaf-runtime-mounted-p runtime) nil)
(when-let* ((route (etaf-runtime-route-token runtime)))
(setf (etaf-runtime-route-active-p route) nil))
(etaf-host-authority-rollback-attach host-authority)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(remove-hook 'kill-buffer-hook
#'etaf--runtime-kill-buffer t)))
(remhash buffer etaf--runtime-table)
(remhash (etaf-runtime-mount-epoch runtime)
etaf--runtime-route-registry)
(etaf-scope-stop scope))
(signal (car err) (cdr err))))
buffer))))
(defun etaf--runtime-validate-mount-options (options)
"Validate and return mount OPTIONS."
(let ((tail options))
(while tail
(let ((key (pop tail)))
(unless tail
(error "ETAF mount option %S has no value" key))
(pop tail)
(unless (memq key '(:viewport-width :viewport-height :observer
:scheduler-context))
(error "Unknown ETAF mount option: %S" key)))))
(when-let* ((width (plist-get options :viewport-width)))
(unless (and (numberp width) (> width 0))
(error "ETAF mount :viewport-width must be positive: %S" width)))
(when-let* ((height (plist-get options :viewport-height)))
(unless (and (numberp height) (> height 0))
(error "ETAF mount :viewport-height must be positive: %S" height)))
(when (and (plist-member options :observer)
(not (or (null (plist-get options :observer))
(functionp (plist-get options :observer)))))
(signal 'wrong-type-argument
(list 'functionp (plist-get options :observer))))
(when (and (plist-member options :scheduler-context)
(not (etaf-scheduler-context-p
(plist-get options :scheduler-context))))
(signal 'wrong-type-argument
(list 'etaf-scheduler-context-p
(plist-get options :scheduler-context))))
options)
;;;###autoload
(defun etaf-runtime-mount (buffer-or-name view &optional options)
"Mount VIEW into BUFFER-OR-NAME and return the live buffer.
Setup, reactive publication, Ebox rendering, and lifecycle work share one
framework render-burst allocation budget when the installed Ebox supports it.
OPTIONS may provide `:viewport-width' in pixels, `:viewport-height' in lines,
`:observer' as a one-argument flat-report sink, and `:scheduler-context' for
explicit dispatch isolation. The observer is installed before publication."
(etaf--assert-not-rendering 'mount-runtime)
(setq options (etaf--runtime-validate-mount-options options))
(let ((ebox-viewport-width (plist-get options :viewport-width))
(ebox-viewport-height (plist-get options :viewport-height)))
(ebox-call-with-render-burst
#'etaf--runtime-mount-now buffer-or-name view
(plist-get options :observer)
(or (plist-get options :scheduler-context)
etaf-scheduler-default-context))))
(defun etaf--runtime-unmount-now (runtime &optional cause)
"Unmount RUNTIME idempotently and retire its Component scopes.
CAUSE is `buffer-kill' for the contained dead-buffer path, or nil for explicit
unmount. Host authority is invalidated before any unbounded cleanup."
(unless (etaf-runtime-p runtime)
(signal 'wrong-type-argument (list 'etaf-runtime-p runtime)))
(if (not (etaf-runtime-mounted-p runtime))
runtime
(let* ((authority (etaf-runtime-host-authority runtime))
(retirement
(etaf--runtime-new-retirement-journal
runtime
(list 'host-detach
(etaf-runtime-mount-epoch runtime)
(etaf-host-authority-version authority)))))
(when (etaf-host-authority-attached-p authority)
(etaf-host-authority-begin-detach authority))
(unless (eq (etaf-host-authority-state authority) 'terminal)
(etaf-host-authority-invalidate authority))
(when-let* ((route (etaf-runtime-route-token runtime)))
(setf (etaf-runtime-route-active-p route) nil))
(setf (etaf-runtime-mounted-p runtime) nil)
(unwind-protect
(progn
(when (buffer-live-p (etaf-runtime-buffer runtime))
(with-current-buffer (etaf-runtime-buffer runtime)
(remove-hook 'kill-buffer-hook #'etaf--runtime-kill-buffer t)))
(when (fboundp 'etaf-events-disable-input)
(etaf-events-disable-input (etaf-runtime-buffer runtime)))
(unless (eq cause 'buffer-kill)
(when (etaf-render-port-mounted-p
(etaf-runtime-buffer runtime))
(let ((buffer (etaf-runtime-buffer runtime)))
(etaf-retirement-enqueue
retirement
:owner (list 'ebox (etaf-runtime-mount-epoch runtime))
:kind 'ebox-unmount
:payload (lambda () (etaf-render-port-unmount buffer))
:ordering-key '(0 0)
:policy 'retryable-idempotent
:max-attempts 2))))
(remhash (etaf-runtime-buffer runtime) etaf--runtime-table)
(remhash (etaf-runtime-mount-epoch runtime)
etaf--runtime-route-registry)
(maphash
(lambda (source _)
(remhash (etaf-runtime-route-token runtime)
(etaf--source-subscribers source)))
(etaf-runtime-route-sources runtime))
(clrhash (etaf-runtime-route-sources runtime))
(let (instances)
(maphash (lambda (_identity instance) (push instance instances))
(etaf-runtime-instances runtime))
(cl-loop
for instance in
(sort instances
(lambda (left right)
(> (length (etaf--component-instance-identity left))
(length
(etaf--component-instance-identity right)))))
for index from 0
do
(remhash (etaf--component-instance-identity instance)
(etaf-runtime-instances runtime))
(remhash (etaf--component-instance-resource-key instance)
(etaf-runtime-resource-registry runtime))
(etaf--runtime-dispose-instance
instance t retirement (list 1 index))))
(let ((scope (etaf-runtime-scope runtime)))
(etaf-retirement-enqueue
retirement
:owner (list 'runtime-scope
(etaf-runtime-mount-epoch runtime))
:kind 'runtime-scope-stop
:payload
(lambda ()
(when-let* ((errors (etaf-scope-stop scope)))
(signal (caar errors) (cdar errors))))
:ordering-key '(8 0)
:policy 'contained-once
:max-attempts 1))
(let (behavior-entries)
(maphash
(lambda (identity state)
(push (cons identity state) behavior-entries))
(etaf-runtime-behaviors runtime))
(clrhash (etaf-runtime-behaviors runtime))
(cl-loop for entry in behavior-entries
for index from 0
do
(when-let* ((resource-key
(gethash
(car entry)
(etaf-runtime-behavior-resource-keys
runtime))))
(remhash resource-key
(etaf-runtime-resource-registry runtime)))
(when-let* ((cleanup (cdr (cdr entry))))
(let ((callback cleanup))
(etaf-retirement-enqueue
retirement
:owner (copy-tree (car entry))
:kind 'behavior-unmount
:payload callback
:ordering-key (list 7 index)
:policy 'retryable-idempotent
:max-attempts 2)))))
(clrhash (etaf-runtime-instances runtime))
(clrhash (etaf-runtime-resource-registry runtime))
(etaf--runtime-drain-retirement
runtime retirement (eq cause 'buffer-kill))
runtime)
(etaf-host-authority-finish-detach authority)))))
;;;###autoload
(defun etaf-runtime-unmount (&optional runtime)
"Unmount RUNTIME, report the operation, and detach its observer."
(etaf--assert-not-rendering 'unmount-runtime)
(let* ((runtime (etaf-runtime-require-mounted runtime))
(observer (etaf-runtime-observer runtime))
(buffer (etaf-runtime-buffer runtime)))
(unwind-protect
(etaf--runtime-with-operation (runtime 'unmount "unmount")
(etaf--runtime-unmount-now runtime))
(when observer
(condition-case condition
(when (buffer-live-p buffer)
(ebox-buffer-set-observer buffer nil))
((error quit)
(etaf--runtime-record-observer-diagnostic
runtime (list :kind 'detach-failure :condition condition))))
(setf (etaf-runtime-observer runtime) nil)))))
;;;###autoload
(defun etaf-unmount (&optional runtime)
"Unmount RUNTIME, defaulting to the active or `current-buffer' Runtime."
(etaf-runtime-unmount runtime))
;;;###autoload
(defun etaf-on-mounted (callback)
"Run CALLBACK after the current Component is first published."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless (and etaf--current-component-instance
(eq etaf--component-phase 'setup))
(error "ETAF-on-mounted requires Component setup"))
(push callback
(etaf--component-instance-mounted-hooks
etaf--current-component-instance))
callback)
;;;###autoload
(defun etaf-on-updated (callback)
"Run CALLBACK after the current Component participates in an update."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless (and etaf--current-component-instance
(eq etaf--component-phase 'setup))
(error "ETAF-on-updated requires Component setup"))
(push callback
(etaf--component-instance-updated-hooks
etaf--current-component-instance))
callback)
;;;###autoload
(defun etaf-on-unmounted (callback)
"Run CALLBACK when the current Component is disposed."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless (and etaf--current-component-instance
(eq etaf--component-phase 'setup))
(error "ETAF-on-unmounted requires Component setup"))
(push callback
(etaf--component-instance-unmounted-hooks
etaf--current-component-instance))
callback)
(provide 'etaf-runtime)
;;; etaf-runtime.el ends here
Reference in New Issue View Git Blame Copy Permalink