From 459098b0749d19046b705b647980dd795ef6b453 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Tue, 25 Aug 2026 20:03:06 +0800 Subject: [PATCH] refactor: remove manual app precompilation --- DESIGN.md | 60 --------- DESIGN.zh-CN.md | 48 ------- Makefile | 4 +- README.md | 31 ----- README.zh-CN.md | 35 ------ etaf-app.el | 204 ------------------------------ etaf-compiler.el | 237 +++-------------------------------- etaf-performance.el | 5 - etaf-view.el | 2 +- etaf.el | 1 - tests/etaf-app-tests.el | 91 -------------- tests/etaf-compiler-tests.el | 38 +++--- 12 files changed, 38 insertions(+), 718 deletions(-) delete mode 100644 etaf-app.el delete mode 100644 tests/etaf-app-tests.el diff --git a/DESIGN.md b/DESIGN.md index ecf45e4..ec02dca 100644 --- a/DESIGN.md +++ b/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. diff --git a/DESIGN.zh-CN.md b/DESIGN.zh-CN.md index 9964782..365839e 100644 --- a/DESIGN.zh-CN.md +++ b/DESIGN.zh-CN.md @@ -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 当前等宽字体;粗体只用于标题、操作、状态和关键数值。 diff --git a/Makefile b/Makefile index fdff000..7dd0000 100644 --- a/Makefile +++ b/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 diff --git a/README.md b/README.md index 80d956b..98c9c72 100644 --- a/README.md +++ b/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 diff --git a/README.zh-CN.md b/README.zh-CN.md index 0798cfe..21d376f 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -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 内置了一个按需启用、与具体应用无关的性能记录器。它自动识别公共 diff --git a/etaf-app.el b/etaf-app.el deleted file mode 100644 index 9baee0f..0000000 --- a/etaf-app.el +++ /dev/null @@ -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 diff --git a/etaf-compiler.el b/etaf-compiler.el index ef92e23..51a8ee8 100644 --- a/etaf-compiler.el +++ b/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 diff --git a/etaf-performance.el b/etaf-performance.el index c96c867..de385e9 100644 --- a/etaf-performance.el +++ b/etaf-performance.el @@ -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 diff --git a/etaf-view.el b/etaf-view.el index f481541..dee7efe 100644 --- a/etaf-view.el +++ b/etaf-view.el @@ -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) diff --git a/etaf.el b/etaf.el index 5f2e217..9965cfc 100644 --- a/etaf.el +++ b/etaf.el @@ -29,7 +29,6 @@ (require 'etaf-view) (require 'etaf-compiler) -(require 'etaf-app) (require 'etaf-component) (require 'etaf-reactive) (require 'etaf-context) diff --git a/tests/etaf-app-tests.el b/tests/etaf-app-tests.el deleted file mode 100644 index df8e454..0000000 --- a/tests/etaf-app-tests.el +++ /dev/null @@ -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 diff --git a/tests/etaf-compiler-tests.el b/tests/etaf-compiler-tests.el index 16c7c2c..537c2d9 100644 --- a/tests/etaf-compiler-tests.el +++ b/tests/etaf-compiler-tests.el @@ -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