refactor: remove manual app precompilation
This commit is contained in:
Kinneyzhang
parent
f69f6889ff
commit
459098b074
60
DESIGN.md
60
DESIGN.md
@ -122,66 +122,6 @@ layout, scans no ancestor slot, and walks no complete fragment ledger. Real
|
||||
text or structure changes use a separate content/layout transaction; the
|
||||
parent ETAF operation still correlates and atomically commits both.
|
||||
|
||||
## Precompiled Operation Programs and performance composability
|
||||
|
||||
A compiled artifact cannot retain only View syntax or final text coordinates.
|
||||
An Operation Program that the Runtime can consume directly owns five facts as
|
||||
one indivisible contract:
|
||||
|
||||
1. stable Host/Box/Range topology templates and dynamic holes;
|
||||
2. `source/effect → OperationBatch` dependency routes;
|
||||
3. layout slots, containment, overflow, and revision invalidation edges;
|
||||
4. a closed style environment covering selectors, inheritance, and Theme
|
||||
contributions;
|
||||
5. TP object/ownership ranges/paint contribution addresses plus atomic
|
||||
rollback boundaries.
|
||||
|
||||
Retaining only a subset merely moves the same work downstream. Coordinates
|
||||
without style and TP objects require reconstruction; a View blueprint still
|
||||
requires lowering, layout, and paint; flattened final faces discard TP
|
||||
layering. Such partial artifacts are not App performance compilation.
|
||||
|
||||
The Runtime submits only precise operation batches:
|
||||
|
||||
```text
|
||||
OperationBatch = RangeReplace | HostPropertySet | InlineTextSet |
|
||||
LayoutInvalidate | PaintContributionSet
|
||||
```
|
||||
|
||||
Each layer consumes only its fields and forwards the remaining retained
|
||||
addresses. Data materializes once; a transaction performs at most one full
|
||||
walk; every module costs `O(changed)` or a documented small constant. If an
|
||||
extra module materially increases total latency, its interface discarded an
|
||||
upstream intermediate—the overhead is not an inherent cost of architecture.
|
||||
|
||||
The current `etaf-view-blueprint/0` caches only static View construction and
|
||||
is a migration artifact. A later ABI becomes an Operation Program only after
|
||||
a real App Range update avoids whole-tree Ebox projection/render and passes
|
||||
the formal Pagination budget.
|
||||
|
||||
### Root implementation order and acceptance
|
||||
|
||||
1. Theme vertical slice: add a Theme source→Host/property index and TP
|
||||
contributions. Color-consuming Component render count becomes zero while
|
||||
content consumers update separately.
|
||||
2. Generic property effects: compile reactive expressions written directly in
|
||||
Host property positions into stable property bindings; structural
|
||||
expressions remain Component/Range work.
|
||||
3. Exact incremental layout: Ebox retains property-impact and containment
|
||||
dependency edges, recomputes the dirty closure directly, and removes
|
||||
span/ancestor proofs from the normal path.
|
||||
4. TP paint plane: migrate precomposed fragment faces to ordered properties
|
||||
contributions and delete full-fragment palette recomposition.
|
||||
5. Converge: remove compatibility caches and proofs that are superseded while
|
||||
retaining the conservative root path for arbitrary candidates, rollback,
|
||||
and all existing semantics.
|
||||
|
||||
Acceptance requires GUI-visible completion timing, not batch alone; no layout
|
||||
stage or full-fragment recomposition for Theme paint; no regressions in
|
||||
structure, slots, lifecycle, inheritance, precedence, conflicts, or rollback;
|
||||
and representative warmed operations passing the scenario budgets in the
|
||||
performance evaluator.
|
||||
|
||||
## Visual language
|
||||
- Color: Warm canvas `#F8F5EE`, paper `#FFFDF8`, ink `#252A2E`, muted ink `#66706A`, terracotta `#F1D4C9`, sage `#DCEBDD`, blue `#D9EAF2`, and violet `#E7E2F1`, always with explicit dark text.
|
||||
- Typography: The configured Emacs monospace face; bold only for titles, actions, statuses, and important values.
|
||||
|
||||
@ -107,54 +107,6 @@ Theme source changed
|
||||
slot，或遍历完整 fragment ledger。只有真实文本/结构变化走独立的 content/layout
|
||||
事务；二者仍由同一个上层 ETAF operation 关联并原子提交。
|
||||
|
||||
## 预编译 Operation Program 与性能可组合性
|
||||
|
||||
预编译产物不能只保存 View 语法树或最终文本坐标。一个可以在运行时直接消费的
|
||||
Operation Program 必须把下面五项作为同一个不可拆分契约：
|
||||
|
||||
1. 稳定 Host/Box/Range 拓扑模板和动态 hole；
|
||||
2. `source/effect → OperationBatch` 的依赖路由；
|
||||
3. 布局 slot、containment、overflow 与 revision 失效边；
|
||||
4. 已闭合的样式计算环境，包括 selector/继承/Theme contribution；
|
||||
5. TP object/ownership range/paint contribution 地址和原子回滚边界。
|
||||
|
||||
只保留其中一部分会把工作转移到下一层：只保留坐标仍需重新建立 style 与 TP
|
||||
object；只保留 View blueprint 仍需重新 lower、layout 和 paint；只保留最终 face
|
||||
又会丢失 TP 分层。因此这种“局部预编译”不能宣称为 App 性能预编译。
|
||||
|
||||
运行时只允许提交精确操作批次：
|
||||
|
||||
```text
|
||||
OperationBatch = RangeReplace | HostPropertySet | InlineTextSet |
|
||||
LayoutInvalidate | PaintContributionSet
|
||||
```
|
||||
|
||||
每一层只消费属于自己的字段并保留其余地址。一次数据只 materialize 一次；同一
|
||||
事务的全量遍历最多一次；各模块成本必须是 `O(changed)` 或有明确小常数上界。
|
||||
如果增加一个模块后总耗时明显增加，说明接口丢失了上层中间产物，而不是架构
|
||||
层数本身应有的代价。
|
||||
|
||||
当前 `etaf-view-blueprint/0` 只缓存静态 View 构造，是迁移产物。下一 ABI 只有在
|
||||
真实 App 的 Range 操作无需重新进行整树 Ebox projection/render，并通过正式
|
||||
Pagination 预算后，才能称为 Operation Program。
|
||||
|
||||
### 根源实现顺序与验收
|
||||
|
||||
1. Theme 垂直切片：建立 Theme source→Host/property 索引和 TP contribution；
|
||||
Theme 颜色消费者的 Component render 次数为 0，内容消费者单独更新。
|
||||
2. 通用 property effect：把直接写在 Host 属性位置的响应式表达式编译为稳定
|
||||
property binding；结构表达式继续归 Component/Range。
|
||||
3. 精确 incremental layout：Ebox 持有 property impact 与 containment 依赖图，
|
||||
直接重算 dirty closure，移除正常路径的 span/ancestor proof。
|
||||
4. TP paint plane：将预合成 fragment face 迁移为有序 properties contribution，
|
||||
删除 palette 切换时的全 fragment recomposition。
|
||||
5. 收尾：删除已被替代的兼容缓存和 proof；保守 root 路径继续保证任意 candidate、
|
||||
rollback 和现有功能语义。
|
||||
|
||||
验收必须同时满足：GUI 可见完成计时而非只看 batch；Theme paint 操作没有 layout
|
||||
阶段和全 fragment 重组；结构、slot、lifecycle、继承、优先级、冲突与 rollback
|
||||
测试不退化；代表性 warmed 操作达到性能 evaluator 的场景预算。
|
||||
|
||||
## 视觉语言
|
||||
- 颜色：暖色画布 `#F8F5EE`、纸张 `#FFFDF8`、正文 `#252A2E`、弱化正文 `#66706A`、陶土色 `#F1D4C9`、鼠尾草绿 `#DCEBDD`、蓝色 `#D9EAF2` 与紫色 `#E7E2F1`，始终搭配明确的深色文字。
|
||||
- 字体：沿用 Emacs 当前等宽字体；粗体只用于标题、操作、状态和关键数值。
|
||||
|
||||
4
Makefile
4
Makefile
@ -1,8 +1,8 @@
|
||||
EMACS ?= emacs
|
||||
LOAD_PATH = -L . -L examples -L ../ebox -L ../tp -L ../ecss
|
||||
SOURCES = etaf-view.el etaf-compiler.el etaf-app.el etaf-component.el etaf-reactive.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el
|
||||
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-reactive.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el
|
||||
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-app-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-performance-tests.el
|
||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-performance-tests.el
|
||||
|
||||
.PHONY: test compile load checkdoc docs-check check clean
|
||||
|
||||
|
||||
31
README.md
31
README.md
@ -40,37 +40,6 @@ Define a Component:
|
||||
|
||||
`etaf-view` is the single public View constructor. Structural forms do not use quote; quote remains ordinary Elisp data syntax, such as `'bold`. A View returned from ordinary Elisp is explicitly constructed with `(etaf-view ...)` inside `expr`.
|
||||
|
||||
## App precompilation
|
||||
|
||||
App precompilation is an ETAF core capability and does not depend on
|
||||
Playground. An App or host first registers its source manifest and artifact
|
||||
location:
|
||||
|
||||
```elisp
|
||||
(etaf-register-app
|
||||
"my-app"
|
||||
:source "/path/to/my-app.el"
|
||||
:static "/path/to/my-app.etaf"
|
||||
:style "/path/to/my-app.ecss"
|
||||
:artifact "/path/to/build/my-app.etafc")
|
||||
```
|
||||
|
||||
The user then runs `M-x etaf-compile-app` once to select a registered App and
|
||||
atomically generate its standalone `.etafc` intermediate artifact. Use
|
||||
`M-x etaf-app-compile-status` to report `current`, `missing`, `stale`, or
|
||||
`invalid`.
|
||||
|
||||
ETAF records content hashes for the companion, `.etaf`, and `.ecss` sources;
|
||||
changing any of them rejects the old artifact. An App host calls
|
||||
`etaf-app-load-artifact-or-warn` before startup. A current artifact is loaded;
|
||||
a missing or stale artifact retains the complete source fallback and emits an
|
||||
explicit reminder to run `M-x etaf-compile-app`.
|
||||
|
||||
`etaf-compiler.el` owns blueprint and `.etafc` compilation/validation.
|
||||
`etaf-app.el` independently owns App registration, interactive commands,
|
||||
status, and fallback warnings. Playground is only an optional UI consumer of
|
||||
these core APIs.
|
||||
|
||||
## Performance records
|
||||
|
||||
ETAF includes an opt-in, application-neutral timing recorder. It recognizes
|
||||
|
||||
@ -40,41 +40,6 @@ Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
|
||||
|
||||
`etaf-view` 是唯一的公共 View 构造入口。结构 form 不使用 quote；quote 仍然是普通 Elisp 数据语法，例如 `'bold`。普通 Elisp 返回 View 时，必须在 `expr` 中显式使用 `(etaf-view ...)` 构造它。
|
||||
|
||||
## App 预编译
|
||||
|
||||
App 预编译是 ETAF core 的通用能力，不依赖 Playground。App 或宿主先注册文件
|
||||
清单和产物位置：
|
||||
|
||||
```elisp
|
||||
(etaf-register-app
|
||||
"my-app"
|
||||
:source "/path/to/my-app.el"
|
||||
:static "/path/to/my-app.etaf"
|
||||
:style "/path/to/my-app.ecss"
|
||||
:artifact "/path/to/build/my-app.etafc")
|
||||
```
|
||||
|
||||
用户手动执行一次：
|
||||
|
||||
```text
|
||||
M-x etaf-compile-app
|
||||
```
|
||||
|
||||
命令会选择已注册 App，并原子生成独立 `.etafc` 中间产物。查看状态使用：
|
||||
|
||||
```text
|
||||
M-x etaf-app-compile-status
|
||||
```
|
||||
|
||||
状态包括 `current`、`missing`、`stale` 和 `invalid`。ETAF 会记录 companion、
|
||||
`.etaf` 和 `.ecss` 的内容 hash；任一源码变化都会拒绝旧产物。宿主启动 App 时
|
||||
调用 `etaf-app-load-artifact-or-warn`：有效产物直接加载，缺失或过期则保持完整
|
||||
source fallback 功能，同时明确提醒用户运行 `M-x etaf-compile-app`。
|
||||
|
||||
`etaf-compiler.el` 只负责 blueprint 与 `.etafc` 的编译/校验；App 注册、交互
|
||||
命令、状态和回退提醒属于独立的 `etaf-app.el`。Playground 只是这个通用 API 的
|
||||
一个可选 UI consumer。
|
||||
|
||||
## 性能记录面板
|
||||
|
||||
ETAF 内置了一个按需启用、与具体应用无关的性能记录器。它自动识别公共
|
||||
|
||||
204
etaf-app.el
204
etaf-app.el
@ -1,204 +0,0 @@
|
||||
;;; etaf-app.el --- ETAF App registry and compile workflow -*- lexical-binding: t; -*-
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This module owns the user-facing App boundary. The compiler remains a pure
|
||||
;; engine; hosts such as etaf-playground register source manifests here and use
|
||||
;; the same compile/status/fallback workflow as any other ETAF application.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'etaf-compiler)
|
||||
|
||||
(cl-defstruct (etaf-app-spec (:constructor etaf-app--spec-create))
|
||||
name source-file static-file style-file artifact-file)
|
||||
|
||||
(defvar etaf-app--registry (make-hash-table :test #'equal))
|
||||
(defvar etaf-app--warning-state (make-hash-table :test #'equal))
|
||||
(defvar etaf-app--status-cache (make-hash-table :test #'equal))
|
||||
|
||||
(declare-function ebox-native-reflow-load "ebox-native-reflow" ())
|
||||
(declare-function ebox-native-reflow-layout-ready-p "ebox-native-reflow" ())
|
||||
|
||||
(defun etaf-app--prepare-runtime-accelerator ()
|
||||
"Load the optional compiled Ebox runtime and return its status."
|
||||
(if (not (require 'ebox-native-reflow nil t))
|
||||
'unavailable
|
||||
(condition-case _error
|
||||
(progn
|
||||
(ebox-native-reflow-load)
|
||||
(if (ebox-native-reflow-layout-ready-p) 'ready 'unavailable))
|
||||
(error 'unavailable))))
|
||||
|
||||
(defcustom etaf-app-warn-on-artifact-fallback t
|
||||
"Whether running an uncompiled or stale App emits a warning."
|
||||
:type 'boolean
|
||||
:group 'etaf)
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun etaf-register-app
|
||||
(name &key source static style artifact)
|
||||
"Register App NAME and its SOURCE, STATIC, STYLE, and ARTIFACT files."
|
||||
(setq name (if (symbolp name) (symbol-name name) name))
|
||||
(unless (and (stringp name) (stringp source) (stringp static)
|
||||
(stringp artifact))
|
||||
(signal 'wrong-type-argument
|
||||
(list 'etaf-app-manifest name source static style artifact)))
|
||||
(let ((spec (etaf-app--spec-create
|
||||
:name name
|
||||
:source-file (expand-file-name source)
|
||||
:static-file (expand-file-name static)
|
||||
:style-file (and style (expand-file-name style))
|
||||
:artifact-file (expand-file-name artifact))))
|
||||
(unless (equal spec (gethash name etaf-app--registry))
|
||||
(remhash name etaf-app--status-cache))
|
||||
(puthash name spec etaf-app--registry)
|
||||
spec))
|
||||
|
||||
(defun etaf-app-names ()
|
||||
"Return registered App names in stable order."
|
||||
(let (names)
|
||||
(maphash (lambda (name _spec) (push name names)) etaf-app--registry)
|
||||
(sort names #'string<)))
|
||||
|
||||
(defun etaf-app-spec (name)
|
||||
"Return registered App NAME or signal a user error."
|
||||
(setq name (if (symbolp name) (symbol-name name) name))
|
||||
(or (gethash name etaf-app--registry)
|
||||
(user-error "Unknown ETAF App: %s" name)))
|
||||
|
||||
(defun etaf-app--interactive-name (prompt)
|
||||
"Read a registered App name using PROMPT."
|
||||
(let ((names (etaf-app-names)))
|
||||
(unless names (user-error "No ETAF Apps are registered"))
|
||||
(completing-read prompt names nil t nil nil (car names))))
|
||||
|
||||
(defun etaf-app--file-fingerprint (file)
|
||||
"Return a cheap invalidation fingerprint for FILE."
|
||||
(when-let ((attributes (and file (file-attributes file 'string))))
|
||||
(list file
|
||||
(file-attribute-size attributes)
|
||||
(file-attribute-modification-time attributes)
|
||||
(file-attribute-inode-number attributes))))
|
||||
|
||||
(defun etaf-app--spec-fingerprint (spec)
|
||||
"Return source/artifact invalidation facts for SPEC."
|
||||
(mapcar #'etaf-app--file-fingerprint
|
||||
(list (etaf-app-spec-source-file spec)
|
||||
(etaf-app-spec-static-file spec)
|
||||
(etaf-app-spec-style-file spec)
|
||||
(etaf-app-spec-artifact-file spec))))
|
||||
|
||||
(defun etaf-app--status (name &optional use-cache)
|
||||
"Return App NAME's compilation status plist.
|
||||
USE-CACHE reuses a fully validated result while file fingerprints are stable."
|
||||
(let* ((spec (etaf-app-spec name))
|
||||
(file (etaf-app-spec-artifact-file spec))
|
||||
(fingerprint (etaf-app--spec-fingerprint spec))
|
||||
(cached (and use-cache (gethash name etaf-app--status-cache)))
|
||||
(source-directory
|
||||
(file-name-directory (etaf-app-spec-source-file spec))))
|
||||
(if (and cached (equal fingerprint (car cached)))
|
||||
(cdr cached)
|
||||
(let ((status
|
||||
(if (not (file-readable-p file))
|
||||
(list :app (etaf-app-spec-name spec)
|
||||
:status 'missing :file file)
|
||||
(condition-case err
|
||||
(let ((artifact
|
||||
(etaf-load-app-artifact file source-directory)))
|
||||
(list :app (etaf-app-spec-name spec)
|
||||
:status 'current :file file
|
||||
:blueprints
|
||||
(length (plist-get artifact :blueprints))
|
||||
:artifact artifact))
|
||||
(etaf-compiler-stale-artifact
|
||||
(list :app (etaf-app-spec-name spec) :status 'stale
|
||||
:file file :error err))
|
||||
(etaf-compiler-artifact-error
|
||||
(list :app (etaf-app-spec-name spec) :status 'invalid
|
||||
:file file :error err))
|
||||
(error
|
||||
(list :app (etaf-app-spec-name spec) :status 'invalid
|
||||
:file file :error err))))))
|
||||
(puthash name (cons fingerprint status) etaf-app--status-cache)
|
||||
(unless (eq (plist-get status :status) 'current)
|
||||
(etaf-compiler-deactivate-app-artifact name))
|
||||
status))))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-app-compile-status (&optional name)
|
||||
"Show and return compilation status for App NAME."
|
||||
(interactive (list (etaf-app--interactive-name "ETAF App status: ")))
|
||||
(setq name (or name (car (etaf-app-names))))
|
||||
(let* ((status (etaf-app--status name))
|
||||
(state (plist-get status :status))
|
||||
(detail
|
||||
(pcase state
|
||||
('current (format "compiled, current, %d blueprints"
|
||||
(plist-get status :blueprints)))
|
||||
('missing "not compiled")
|
||||
('stale "compiled artifact is stale")
|
||||
(_ "compiled artifact is invalid"))))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "ETAF App %s: %s (%s)"
|
||||
name detail (plist-get status :file)))
|
||||
status))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-compile-app (&optional name)
|
||||
"Compile registered App NAME into its standalone `.etafc' artifact."
|
||||
(interactive (list (etaf-app--interactive-name "Compile ETAF App: ")))
|
||||
(setq name (or name (car (etaf-app-names))))
|
||||
(let* ((spec (etaf-app-spec name))
|
||||
(output (etaf-app-spec-artifact-file spec)))
|
||||
(etaf-compiler-write-app-artifact
|
||||
:name (etaf-app-spec-name spec)
|
||||
:source (etaf-app-spec-source-file spec)
|
||||
:static (etaf-app-spec-static-file spec)
|
||||
:style (etaf-app-spec-style-file spec)
|
||||
:output output)
|
||||
(remhash name etaf-app--warning-state)
|
||||
(remhash name etaf-app--status-cache)
|
||||
(let ((status (etaf-app--status name)))
|
||||
(unless (eq (plist-get status :status) 'current)
|
||||
(error "ETAF App compilation produced an unusable artifact: %S"
|
||||
status))
|
||||
(when (called-interactively-p 'interactive)
|
||||
(message "Compiled ETAF App %s: %s (%d blueprints)"
|
||||
name output (plist-get status :blueprints)))
|
||||
(setq status
|
||||
(plist-put (copy-sequence status) :runtime-accelerator
|
||||
(etaf-app--prepare-runtime-accelerator)))
|
||||
status)))
|
||||
|
||||
(defun etaf-app--warn-fallback (name status)
|
||||
"Warn once that App NAME is using source fallback because of STATUS."
|
||||
(when (and etaf-app-warn-on-artifact-fallback
|
||||
(not noninteractive)
|
||||
(not (eq (gethash name etaf-app--warning-state) status)))
|
||||
(puthash name status etaf-app--warning-state)
|
||||
(display-warning
|
||||
'etaf
|
||||
(format (concat "ETAF App %s is %s; running the slower source fallback. "
|
||||
"Run M-x etaf-compile-app.")
|
||||
name status)
|
||||
:warning)))
|
||||
|
||||
(defun etaf-app-load-artifact-or-warn (name)
|
||||
"Return App NAME's current artifact, or warn and return nil."
|
||||
(let* ((status (etaf-app--status name t))
|
||||
(state (plist-get status :status)))
|
||||
(if (eq state 'current)
|
||||
(progn
|
||||
(etaf-app--prepare-runtime-accelerator)
|
||||
(plist-get status :artifact))
|
||||
(etaf-compiler-note-artifact-miss state)
|
||||
(etaf-app--warn-fallback name state)
|
||||
nil)))
|
||||
|
||||
(provide 'etaf-app)
|
||||
;;; etaf-app.el ends here
|
||||
237
etaf-compiler.el
237
etaf-compiler.el
@ -1,56 +1,27 @@
|
||||
;;; etaf-compiler.el --- AOT View blueprints for ETAF -*- lexical-binding: t; -*-
|
||||
;;; etaf-compiler.el --- Automatic View blueprint lowering -*- lexical-binding: t; -*-
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is the first compiler slice: structured View topology and literal
|
||||
;; values are emitted into an immutable blueprint during byte compilation.
|
||||
;; Runtime instantiation constructs only nodes on paths containing dynamic
|
||||
;; property holes. Unsupported structural forms use the existing View
|
||||
;; compiler unchanged.
|
||||
;; `etaf-view' lowers supported structured topology into an embedded blueprint
|
||||
;; as part of ordinary macro expansion. Runtime instantiation constructs only
|
||||
;; nodes on paths containing dynamic property holes. Unsupported structural
|
||||
;; forms use the existing View expansion unchanged. There is no standalone
|
||||
;; App artifact or user-managed precompilation workflow.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'etaf-view)
|
||||
|
||||
(defvar read-eval)
|
||||
|
||||
(defconst etaf-compiler-blueprint-abi "etaf-view-blueprint/1")
|
||||
(defconst etaf-compiler-app-artifact-abi "etaf-app/3")
|
||||
|
||||
(define-error 'etaf-compiler-artifact-error "Invalid ETAF App artifact")
|
||||
(define-error 'etaf-compiler-stale-artifact "Stale ETAF App artifact"
|
||||
'etaf-compiler-artifact-error)
|
||||
|
||||
(defvar etaf-compiler--static-cache (make-hash-table :test #'equal))
|
||||
(defvar etaf-compiler--artifact-blueprints (make-hash-table :test #'equal))
|
||||
(defvar etaf-compiler--artifact-blueprint-owners
|
||||
(make-hash-table :test #'equal))
|
||||
(defvar etaf-compiler--active-artifacts (make-hash-table :test #'equal))
|
||||
(defvar etaf-compiler--registry-epoch 0)
|
||||
(defvar etaf-compiler--instantiate-count 0)
|
||||
(defvar etaf-compiler--fallback-count 0)
|
||||
(defvar etaf-compiler--last-blueprint nil)
|
||||
(defvar etaf-compiler--artifact-hit-count 0)
|
||||
(defvar etaf-compiler--artifact-miss-count 0)
|
||||
(defvar etaf-compiler--last-artifact-status nil)
|
||||
|
||||
(defun etaf-compiler-deactivate-app-artifact (name)
|
||||
"Remove App NAME's active artifact and unowned blueprints."
|
||||
(when-let ((artifact (gethash name etaf-compiler--active-artifacts)))
|
||||
(dolist (entry (plist-get artifact :blueprints))
|
||||
(let* ((id (plist-get entry :id))
|
||||
(owners (delete name
|
||||
(copy-sequence
|
||||
(gethash id
|
||||
etaf-compiler--artifact-blueprint-owners)))))
|
||||
(if owners
|
||||
(puthash id owners etaf-compiler--artifact-blueprint-owners)
|
||||
(remhash id etaf-compiler--artifact-blueprint-owners)
|
||||
(remhash id etaf-compiler--artifact-blueprints))))
|
||||
(remhash name etaf-compiler--active-artifacts)))
|
||||
|
||||
(defun etaf-compiler-note-registry-change ()
|
||||
"Invalidate the static Component-call cache after a registry change."
|
||||
@ -62,19 +33,11 @@
|
||||
(interactive)
|
||||
(clrhash etaf-compiler--static-cache))
|
||||
|
||||
(defun etaf-compiler-note-artifact-miss (reason)
|
||||
"Record a rejected or unavailable App artifact REASON."
|
||||
(cl-incf etaf-compiler--artifact-miss-count)
|
||||
(setq etaf-compiler--last-artifact-status reason))
|
||||
|
||||
(defun etaf-compiler-statistics ()
|
||||
"Return a read-only snapshot of compiler runtime statistics."
|
||||
(list :abi etaf-compiler-blueprint-abi
|
||||
:instantiations etaf-compiler--instantiate-count
|
||||
:fallbacks etaf-compiler--fallback-count
|
||||
:artifact-hits etaf-compiler--artifact-hit-count
|
||||
:artifact-misses etaf-compiler--artifact-miss-count
|
||||
:last-artifact-status etaf-compiler--last-artifact-status
|
||||
:static-cache-entries (hash-table-count etaf-compiler--static-cache)
|
||||
:last-blueprint
|
||||
(and etaf-compiler--last-blueprint
|
||||
@ -87,146 +50,6 @@
|
||||
(plist-get etaf-compiler--last-blueprint :hole-count)))
|
||||
:registry-epoch etaf-compiler--registry-epoch))
|
||||
|
||||
(defun etaf-compiler--read-forms (file)
|
||||
"Read every inert Lisp form from FILE."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-min))
|
||||
(let ((read-eval nil) forms form done)
|
||||
(while (not done)
|
||||
(condition-case nil
|
||||
(progn (setq form (read (current-buffer))) (push form forms))
|
||||
(end-of-file (setq done t))))
|
||||
(nreverse forms))))
|
||||
|
||||
(defun etaf-compiler--read-single-form (file)
|
||||
"Read exactly one inert Lisp form from FILE."
|
||||
(let ((forms (etaf-compiler--read-forms file)))
|
||||
(unless (= (length forms) 1)
|
||||
(signal 'etaf-compiler-artifact-error
|
||||
(list :expected-one-form file (length forms))))
|
||||
(car forms)))
|
||||
|
||||
(defun etaf-compiler--collect-blueprints (form)
|
||||
"Return compiled blueprints found below source FORM."
|
||||
(let (blueprints)
|
||||
(cl-labels
|
||||
((visit (value)
|
||||
(when (consp value)
|
||||
(cond
|
||||
((memq (car value) '(quote function)) nil)
|
||||
((and (memq (car value) '(etaf-view etaf-compiled-view))
|
||||
(cadr value))
|
||||
(when-let* ((compiled (etaf-compiler--compile (cadr value)))
|
||||
(blueprint (car compiled))
|
||||
((etaf-compiler--beneficial-blueprint-p blueprint)))
|
||||
(push blueprint blueprints)))
|
||||
(t (visit (car value))
|
||||
(visit (cdr value)))))))
|
||||
(visit form))
|
||||
(nreverse blueprints)))
|
||||
|
||||
(defun etaf-compiler--source-record (file)
|
||||
"Return the content hash record for FILE."
|
||||
(list :file (file-name-nondirectory file)
|
||||
:sha256 (with-temp-buffer
|
||||
(insert-file-contents-literally file)
|
||||
(secure-hash 'sha256 (current-buffer)))))
|
||||
|
||||
(defun etaf-compiler--write-artifact (artifact output)
|
||||
"Atomically write data-only ARTIFACT to OUTPUT."
|
||||
(let* ((directory (file-name-directory (expand-file-name output)))
|
||||
(_ (make-directory directory t))
|
||||
(temporary (make-temp-file (expand-file-name ".etafc-" directory))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-temp-file temporary
|
||||
(let ((print-circle nil) (print-length nil) (print-level nil))
|
||||
(prin1 artifact (current-buffer))
|
||||
(insert "\n")))
|
||||
(rename-file temporary output t)
|
||||
(setq temporary nil)
|
||||
output)
|
||||
(when (and temporary (file-exists-p temporary))
|
||||
(delete-file temporary)))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun etaf-compiler-write-app-artifact
|
||||
(&key name source static style output)
|
||||
"Compile one App into data-only OUTPUT.
|
||||
NAME identifies the App. SOURCE is its Elisp companion, STATIC its inert
|
||||
`.etaf' input, and STYLE its optional `.ecss' input."
|
||||
(unless (and (stringp name) (file-readable-p source)
|
||||
(file-readable-p static) (stringp output))
|
||||
(signal 'wrong-type-argument
|
||||
(list 'etaf-app-source name source static output)))
|
||||
(let (blueprints)
|
||||
(dolist (form (etaf-compiler--read-forms source))
|
||||
(setq blueprints
|
||||
(append blueprints
|
||||
(etaf-compiler--collect-blueprints form))))
|
||||
(setq blueprints
|
||||
(delete-dups blueprints))
|
||||
(let ((artifact
|
||||
(list :kind 'etaf/app-artifact
|
||||
:abi etaf-compiler-app-artifact-abi
|
||||
:app name
|
||||
:sources
|
||||
(delq nil
|
||||
(list (etaf-compiler--source-record source)
|
||||
(etaf-compiler--source-record static)
|
||||
(and style (etaf-compiler--source-record style))))
|
||||
:static-form (etaf-compiler--read-single-form static)
|
||||
:style-form (and style
|
||||
(etaf-compiler--read-single-form style))
|
||||
:blueprints
|
||||
(mapcar (lambda (blueprint)
|
||||
(list :id (plist-get blueprint :id)
|
||||
:blueprint blueprint))
|
||||
blueprints))))
|
||||
(etaf-compiler--write-artifact artifact output))))
|
||||
|
||||
(defun etaf-compiler--validate-source-records (artifact base-directory)
|
||||
"Signal when ARTIFACT does not match BASE-DIRECTORY."
|
||||
(dolist (record (plist-get artifact :sources))
|
||||
(let ((file (expand-file-name (plist-get record :file) base-directory)))
|
||||
(unless (and (file-readable-p file)
|
||||
(equal (with-temp-buffer
|
||||
(insert-file-contents-literally file)
|
||||
(secure-hash 'sha256 (current-buffer)))
|
||||
(plist-get record :sha256)))
|
||||
(signal 'etaf-compiler-stale-artifact
|
||||
(list :source file))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-load-app-artifact (file base-directory)
|
||||
"Load FILE after validating it against BASE-DIRECTORY."
|
||||
(let ((artifact (etaf-compiler--read-single-form file)))
|
||||
(unless (and (eq (plist-get artifact :kind) 'etaf/app-artifact)
|
||||
(equal (plist-get artifact :abi)
|
||||
etaf-compiler-app-artifact-abi)
|
||||
(stringp (plist-get artifact :app)))
|
||||
(signal 'etaf-compiler-artifact-error (list :manifest file)))
|
||||
(etaf-compiler--validate-source-records artifact base-directory)
|
||||
(etaf-compiler-deactivate-app-artifact (plist-get artifact :app))
|
||||
(dolist (entry (plist-get artifact :blueprints))
|
||||
(let ((blueprint (plist-get entry :blueprint)))
|
||||
(unless (and (equal (plist-get entry :id) (plist-get blueprint :id))
|
||||
(equal (plist-get blueprint :abi)
|
||||
etaf-compiler-blueprint-abi))
|
||||
(signal 'etaf-compiler-artifact-error
|
||||
(list :blueprint entry)))
|
||||
(puthash (plist-get entry :id) blueprint
|
||||
etaf-compiler--artifact-blueprints)
|
||||
(cl-pushnew (plist-get artifact :app)
|
||||
(gethash (plist-get entry :id)
|
||||
etaf-compiler--artifact-blueprint-owners)
|
||||
:test #'equal)))
|
||||
(puthash (plist-get artifact :app) artifact
|
||||
etaf-compiler--active-artifacts)
|
||||
(setq etaf-compiler--last-artifact-status 'loaded)
|
||||
artifact))
|
||||
|
||||
(defun etaf-compiler--literal (form)
|
||||
"Return `(t . VALUE)' when FORM is a portable literal, otherwise nil."
|
||||
(cond
|
||||
@ -381,7 +204,7 @@ NAME identifies the App. SOURCE is its Elisp companion, STATIC its inert
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-compiler-instantiate (blueprint programs)
|
||||
"Instantiate compiled View BLUEPRINT with dynamic PROGRAMS."
|
||||
"Instantiate automatically lowered View BLUEPRINT with dynamic PROGRAMS."
|
||||
(unless (and (eq (plist-get blueprint :kind) 'etaf/view-blueprint)
|
||||
(equal (plist-get blueprint :abi)
|
||||
etaf-compiler-blueprint-abi)
|
||||
@ -389,49 +212,21 @@ NAME identifies the App. SOURCE is its Elisp companion, STATIC its inert
|
||||
(vectorp programs)
|
||||
(= (length programs) (plist-get blueprint :hole-count)))
|
||||
(error "Invalid or incompatible ETAF View blueprint"))
|
||||
(let ((artifact-blueprint
|
||||
(gethash (plist-get blueprint :id)
|
||||
etaf-compiler--artifact-blueprints)))
|
||||
(if artifact-blueprint
|
||||
(progn
|
||||
(cl-incf etaf-compiler--artifact-hit-count)
|
||||
(setq etaf-compiler--last-artifact-status 'hit
|
||||
blueprint artifact-blueprint))
|
||||
(cl-incf etaf-compiler--artifact-miss-count)
|
||||
(setq etaf-compiler--last-artifact-status 'embedded-fallback))
|
||||
(cl-incf etaf-compiler--instantiate-count)
|
||||
(setq etaf-compiler--last-blueprint blueprint)
|
||||
(etaf-compiler--materialize
|
||||
blueprint (plist-get blueprint :root) programs)))
|
||||
(cl-incf etaf-compiler--instantiate-count)
|
||||
(setq etaf-compiler--last-blueprint blueprint)
|
||||
(etaf-compiler--materialize
|
||||
blueprint (plist-get blueprint :root) programs))
|
||||
|
||||
(defun etaf-compiler-expand-view
|
||||
(form &optional slot-mode artifact-required count-fallback)
|
||||
(defun etaf-compiler-expand-view (form &optional slot-mode)
|
||||
"Return compiler expansion for View FORM.
|
||||
SLOT-MODE is forwarded to the legacy compiler. ARTIFACT-REQUIRED keeps the
|
||||
legacy path unless a manually loaded artifact contains the blueprint.
|
||||
COUNT-FALLBACK records an unsupported explicit compiler request."
|
||||
SLOT-MODE is forwarded to the legacy compiler."
|
||||
(let* ((compiled (etaf-compiler--compile form))
|
||||
(blueprint (car compiled))
|
||||
(legacy (etaf--compile-view-form form (or slot-mode :projection))))
|
||||
(if (and compiled (etaf-compiler--beneficial-blueprint-p blueprint))
|
||||
(let ((instantiate
|
||||
`(etaf-compiler-instantiate
|
||||
',blueprint (vector ,@(cdr compiled)))))
|
||||
(if artifact-required
|
||||
`(if (gethash ,(plist-get blueprint :id)
|
||||
etaf-compiler--artifact-blueprints)
|
||||
,instantiate
|
||||
,legacy)
|
||||
instantiate))
|
||||
(if count-fallback
|
||||
`(progn (cl-incf etaf-compiler--fallback-count) ,legacy)
|
||||
legacy))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro etaf-compiled-view (form)
|
||||
"Compatibility spelling for explicitly compiled View FORM."
|
||||
(declare (indent 1) (debug (form)))
|
||||
(etaf-compiler-expand-view form :projection nil t))
|
||||
`(etaf-compiler-instantiate
|
||||
',blueprint (vector ,@(cdr compiled)))
|
||||
`(progn (cl-incf etaf-compiler--fallback-count) ,legacy))))
|
||||
|
||||
(provide 'etaf-compiler)
|
||||
;;; etaf-compiler.el ends here
|
||||
|
||||
@ -66,7 +66,6 @@ ELAPSED is milliseconds; START-TIME and END-TIME are wall-clock seconds."
|
||||
(etaf-data-source-load-page data-prepare)
|
||||
(etaf-data-mutate data-mutate)
|
||||
(etaf-resource-load resource-load)
|
||||
(etaf-compile-app app-compile)
|
||||
(ebox-surface-update-buffer-viewport viewport)
|
||||
(ebox-rerender-buffer-with-context rerender)
|
||||
(etaf-focus focus)
|
||||
@ -86,8 +85,6 @@ ELAPSED is milliseconds; START-TIME and END-TIME are wall-clock seconds."
|
||||
(etaf--runtime-render-dirty-inline-range runtime inline-range-effect)
|
||||
(etaf--runtime-render-dirty-slot-range runtime slot-range-effect)
|
||||
(etaf-compiler-instantiate compiler blueprint-instantiate)
|
||||
(etaf-compiler-write-app-artifact compiler app-artifact-write)
|
||||
(etaf-load-app-artifact compiler app-artifact-load)
|
||||
(etaf-sqlite--call sqlite call)
|
||||
(etaf-sqlite--transaction sqlite transaction)
|
||||
(etaf-sqlite--select-items sqlite query)
|
||||
@ -428,7 +425,6 @@ When called interactively, suggest a timestamped `.eld' file in
|
||||
(if (etaf-performance--runtime-p first)
|
||||
first
|
||||
(and (boundp 'etaf--current-runtime) etaf--current-runtime)))
|
||||
((eq function 'etaf-compile-app) nil)
|
||||
((memq function '(ebox-surface-update-buffer-viewport
|
||||
ebox-rerender-buffer-with-context))
|
||||
(etaf-performance--runtime-for-buffer first))
|
||||
@ -484,7 +480,6 @@ FUNCTION received ARGUMENTS and produced RESULT when AFTER is non-nil."
|
||||
(or (nth 2 arguments) 1) (or (nth 3 arguments) 20)))
|
||||
('etaf-data-mutate (format "data %S" (nth 1 arguments)))
|
||||
('etaf-resource-load "resource load/reload")
|
||||
('etaf-compile-app (format "%s" (or (car arguments) "default App")))
|
||||
('ebox-surface-update-buffer-viewport
|
||||
(format "viewport %sx%s" (nth 1 arguments) (or (nth 2 arguments) "-")))
|
||||
('ebox-rerender-buffer-with-context
|
||||
|
||||
@ -442,7 +442,7 @@ ordinary Elisp expressions. `expr' is the only computation bridge in the
|
||||
child region and accepts only `:value'."
|
||||
(declare (indent 1) (debug (form)))
|
||||
(if (fboundp 'etaf-compiler-expand-view)
|
||||
(etaf-compiler-expand-view form :projection t)
|
||||
(etaf-compiler-expand-view form :projection)
|
||||
(etaf--compile-view-form form :projection)))
|
||||
|
||||
(defun etaf--component-prop-key (name)
|
||||
|
||||
1
etaf.el
1
etaf.el
@ -29,7 +29,6 @@
|
||||
|
||||
(require 'etaf-view)
|
||||
(require 'etaf-compiler)
|
||||
(require 'etaf-app)
|
||||
(require 'etaf-component)
|
||||
(require 'etaf-reactive)
|
||||
(require 'etaf-context)
|
||||
|
||||
@ -1,91 +0,0 @@
|
||||
;;; etaf-app-tests.el --- ETAF App workflow tests -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'etaf)
|
||||
|
||||
(defmacro etaf-app-test--with-files (bindings &rest body)
|
||||
"Create temporary App files named by BINDINGS and evaluate BODY."
|
||||
(declare (indent 1))
|
||||
`(let* ((directory (make-temp-file "etaf-app-test-" t))
|
||||
(source (expand-file-name "sample.el" directory))
|
||||
(static (expand-file-name "sample.etaf" directory))
|
||||
(style (expand-file-name "sample.ecss" directory))
|
||||
(artifact (expand-file-name "sample.etafc" directory))
|
||||
,@bindings)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-temp-file source
|
||||
(insert "(defun sample-view (color)\n"
|
||||
" (etaf-view\n"
|
||||
" (column :color color (text \"sample\"))))\n"))
|
||||
(with-temp-file static (insert "(sample :title \"Sample\")\n"))
|
||||
(with-temp-file style (insert "(styles (\"column\" :color red))\n"))
|
||||
,@body)
|
||||
(when (file-directory-p directory)
|
||||
(delete-directory directory t)))))
|
||||
|
||||
(ert-deftest etaf-app-interactive-workflow-produces-current-artifact ()
|
||||
"The public App command writes and loads a current standalone artifact."
|
||||
(etaf-app-test--with-files ()
|
||||
(etaf-register-app "sample" :source source :static static :style style
|
||||
:artifact artifact)
|
||||
(should (eq (plist-get (etaf-app-compile-status "sample") :status)
|
||||
'missing))
|
||||
(let ((status (etaf-compile-app "sample")))
|
||||
(should (file-readable-p artifact))
|
||||
(should (eq (plist-get status :status) 'current))
|
||||
(should (= (plist-get status :blueprints) 1)))
|
||||
(should (eq (plist-get (etaf-app-compile-status "sample") :status)
|
||||
'current))))
|
||||
|
||||
(ert-deftest etaf-app-artifact-becomes-stale-after-source-change ()
|
||||
"Changing any source hash rejects the previously compiled artifact."
|
||||
(etaf-app-test--with-files ()
|
||||
(etaf-register-app "sample-stale"
|
||||
:source source :static static :style style
|
||||
:artifact artifact)
|
||||
(etaf-compile-app "sample-stale")
|
||||
(with-temp-buffer
|
||||
(insert-file-contents source)
|
||||
(goto-char (point-max))
|
||||
(insert "\n;; changed\n")
|
||||
(write-region (point-min) (point-max) source nil 'silent))
|
||||
(should (eq (plist-get (etaf-app-compile-status "sample-stale") :status)
|
||||
'stale))))
|
||||
|
||||
(ert-deftest etaf-app-loaded-blueprint-is-consumed-at-runtime ()
|
||||
"Instantiation uses the manually compiled blueprint by artifact id."
|
||||
(etaf-app-test--with-files ()
|
||||
(etaf-register-app "sample-hit" :source source :static static :style style
|
||||
:artifact artifact)
|
||||
(let* ((status (etaf-compile-app "sample-hit"))
|
||||
(entry (car (plist-get (plist-get status :artifact) :blueprints)))
|
||||
(blueprint (plist-get entry :blueprint))
|
||||
(before (plist-get (etaf-compiler-statistics) :artifact-hits))
|
||||
(view (etaf-compiler-instantiate
|
||||
blueprint (vector (lambda () "purple")))))
|
||||
(should (etaf--view-node-p view))
|
||||
(should (> (plist-get (etaf-compiler-statistics) :artifact-hits) before)))))
|
||||
|
||||
(ert-deftest etaf-app-missing-artifact-warns-once-with-compile-command ()
|
||||
"Direct fallback tells an interactive user exactly how to compile the App."
|
||||
(etaf-app-test--with-files ()
|
||||
(etaf-register-app "sample-warning"
|
||||
:source source :static static :style style
|
||||
:artifact artifact)
|
||||
(let ((noninteractive nil)
|
||||
(etaf-app-warn-on-artifact-fallback t)
|
||||
warnings)
|
||||
(remhash "sample-warning" etaf-app--warning-state)
|
||||
(cl-letf (((symbol-function 'display-warning)
|
||||
(lambda (_type message &optional _level _buffer-name)
|
||||
(push message warnings))))
|
||||
(should-not (etaf-app-load-artifact-or-warn "sample-warning"))
|
||||
(should-not (etaf-app-load-artifact-or-warn "sample-warning")))
|
||||
(should (= (length warnings) 1))
|
||||
(should (string-match-p "M-x etaf-compile-app" (car warnings))))))
|
||||
|
||||
(provide 'etaf-app-tests)
|
||||
;;; etaf-app-tests.el ends here
|
||||
@ -35,17 +35,17 @@
|
||||
(text "static"))
|
||||
(text (expr :value text)))))
|
||||
|
||||
(defun etaf-compiler-test--compiled (color text)
|
||||
"Return a compiled fixture using COLOR and TEXT."
|
||||
(etaf-compiled-view
|
||||
(defun etaf-compiler-test--lowered (color text)
|
||||
"Return an automatically lowered fixture using COLOR and TEXT."
|
||||
(etaf-view
|
||||
(column :color color
|
||||
(column :padding '(1 2)
|
||||
(text "static"))
|
||||
(text (expr :value text)))))
|
||||
|
||||
(defun etaf-compiler-test--fallback-view ()
|
||||
"Return a View containing the not-yet-compiled slot grammar."
|
||||
(etaf-compiled-view
|
||||
"Return a View containing unsupported slot grammar."
|
||||
(etaf-view
|
||||
(column (slot (text "fallback")))))
|
||||
|
||||
(defun etaf-compiler-test--fallback-reference ()
|
||||
@ -53,7 +53,7 @@
|
||||
(etaf-compiler-test--legacy-view
|
||||
(column (slot (text "fallback")))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-fallback-is-exact ()
|
||||
(ert-deftest etaf-automatic-view-fallback-is-exact ()
|
||||
"An unsupported slot keeps the existing View semantics."
|
||||
(let ((before (plist-get (etaf-compiler-statistics) :fallbacks)))
|
||||
(should
|
||||
@ -64,9 +64,9 @@
|
||||
(should (= (1+ before)
|
||||
(plist-get (etaf-compiler-statistics) :fallbacks)))))
|
||||
|
||||
(defun etaf-compiler-test--compiled-supported (color)
|
||||
"Return a supported compiled fixture using COLOR."
|
||||
(etaf-compiled-view
|
||||
(defun etaf-compiler-test--lowered-supported (color)
|
||||
"Return a supported automatically lowered fixture using COLOR."
|
||||
(etaf-view
|
||||
(column :color color
|
||||
(column :padding '(1 2)
|
||||
(text "static-a")
|
||||
@ -82,35 +82,35 @@
|
||||
(text "static-b"))
|
||||
(text :color "blue" "tail"))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-supported-output-is-exact ()
|
||||
(ert-deftest etaf-automatic-view-supported-output-is-exact ()
|
||||
"A supported blueprint produces the same normalized View data."
|
||||
(should
|
||||
(equal (etaf-compiler-test--canonical
|
||||
(etaf-compiler-test--compiled-supported "green"))
|
||||
(etaf-compiler-test--lowered-supported "green"))
|
||||
(etaf-compiler-test--canonical
|
||||
(etaf-compiler-test--interpreted-supported "green")))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-reuses-static-subtrees ()
|
||||
(ert-deftest etaf-automatic-view-reuses-static-subtrees ()
|
||||
"Repeated instantiation reuses a static child while rebuilding its root."
|
||||
(etaf-compiler-clear-cache)
|
||||
(let* ((first (etaf-compiler-test--compiled-supported "red"))
|
||||
(second (etaf-compiler-test--compiled-supported "blue"))
|
||||
(let* ((first (etaf-compiler-test--lowered-supported "red"))
|
||||
(second (etaf-compiler-test--lowered-supported "blue"))
|
||||
(first-static (car (etaf--view-node-children first)))
|
||||
(second-static (car (etaf--view-node-children second))))
|
||||
(should-not (eq first second))
|
||||
(should (eq first-static second-static))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-reduces-runtime-construction-work ()
|
||||
(ert-deftest etaf-automatic-view-reduces-runtime-construction-work ()
|
||||
"A warmed blueprint constructs only its dynamic ancestor path."
|
||||
(etaf-compiler-clear-cache)
|
||||
(etaf-compiler-test--compiled-supported "warm")
|
||||
(etaf-compiler-test--lowered-supported "warm")
|
||||
(let ((calls 0)
|
||||
(original (symbol-function 'etaf--view-call)))
|
||||
(cl-letf (((symbol-function 'etaf--view-call)
|
||||
(lambda (&rest arguments)
|
||||
(cl-incf calls)
|
||||
(apply original arguments))))
|
||||
(etaf-compiler-test--compiled-supported "next"))
|
||||
(etaf-compiler-test--lowered-supported "next"))
|
||||
(should (= calls 1))
|
||||
(setq calls 0)
|
||||
(cl-letf (((symbol-function 'etaf--view-call)
|
||||
@ -120,7 +120,7 @@
|
||||
(etaf-compiler-test--interpreted-supported "next"))
|
||||
(should (> calls 1))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-exposes-blueprint-coverage ()
|
||||
(ert-deftest etaf-automatic-view-exposes-blueprint-coverage ()
|
||||
"The compiler reports static nodes, dynamic paths, and holes."
|
||||
(pcase-let* ((`(,blueprint . ,programs)
|
||||
(etaf-compiler--compile
|
||||
@ -135,7 +135,7 @@
|
||||
(should (= (length programs) 1))
|
||||
(should (= (plist-get blueprint :hole-count) 1))))
|
||||
|
||||
(ert-deftest etaf-compiled-view-expr-is-a-dynamic-child-hole ()
|
||||
(ert-deftest etaf-automatic-view-expr-is-a-dynamic-child-hole ()
|
||||
"Expr becomes one dynamic child program without forcing root fallback."
|
||||
(pcase-let* ((`(,blueprint . ,programs)
|
||||
(etaf-compiler--compile
|
||||
|
||||
Loading…
Reference in New Issue
Block a user