From 665164911f447b38e6a13fa03878014294a040e4 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Thu, 30 Jul 2026 08:24:54 +0800 Subject: [PATCH] perf: make live structural commits incremental Reuse prepared paragraph data, safe Elisp DP states, common layout lines, and dirty-island source reconstruction for exact append commits. Simplify C int32 validation and add the frozen task030 evaluator, regressions, and decision records. --- .phrase/docs/CHANGE.md | 4 + ...nge_narrow_live_append_latency_20260730.md | 35 + ...sue_narrow_live_append_latency_20260729.md | 66 +- .../task_repository_audit_20260728.md | 30 + CHANGELOG.md | 23 +- ekp-buffer.el | 109 ++- ekp.el | 707 ++++++++++++++---- ekp_c/README.md | 16 + ekp_c/ekp.c | 16 +- ...60730-incremental-live-append-ownership.md | 95 +++ tests/ekp-buffer-tests.el | 32 + tests/ekp-c-tests.el | 8 + tests/ekp-live-commit-evaluator.el | 698 +++++++++++++++++ tests/ekp-tests.el | 79 ++ tests/run-live-commit-evaluator.sh | 79 ++ 15 files changed, 1795 insertions(+), 202 deletions(-) create mode 100644 .phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md create mode 100644 postmortem/20260730-incremental-live-append-ownership.md create mode 100644 tests/ekp-live-commit-evaluator.el create mode 100755 tests/run-live-commit-evaluator.sh diff --git a/.phrase/docs/CHANGE.md b/.phrase/docs/CHANGE.md index 6fb8d5d..c2dbdbb 100644 --- a/.phrase/docs/CHANGE.md +++ b/.phrase/docs/CHANGE.md @@ -78,6 +78,10 @@ 27.687/27.487 ms with exact layout parity (`task032` complete; `issue020` awaits user confirmation): `.phrase/phases/phase-kp-overhaul-20260726/change_c_resize_latency_20260729.md` +- 2026-07-30 implement exact incremental live-append preparation, DP, and + projection reuse (`task030` implementation verified; locked + source-instrumented 16 ms gate and `issue018` remain open): + `.phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md` ## phase-doc-improvement-20260125 - See `.phrase/phases/phase-doc-improvement-20260125/change_log.md` diff --git a/.phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md b/.phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md new file mode 100644 index 0000000..760e17d --- /dev/null +++ b/.phrase/phases/phase-kp-overhaul-20260726/change_narrow_live_append_latency_20260730.md @@ -0,0 +1,35 @@ +# Change: Narrow Live-Append Latency 2026-07-30 + +## 2026-07-30 — Implement exact incremental live commits + +- **Modify** `ekp.el`: retain prepared paragraph and 1D-DP state in layout + plans, retokenize only the last incomplete word plus appended suffix, + extend prefix/break/protrusion data from the first dirty box, resume Elisp + DP from the earliest state that can reach the new tail, and reuse unchanged + layout-line records. +- **Modify** `ekp-buffer.el`: reconstruct only the live dirty island, attempt + exact append planning before a full plan, preserve cache identity, and + release the old hard-line transaction before the next paragraph becomes + live. +- **Modify** `ekp_c/ekp.c`: validate signed 32-bit values with one + `extract_integer` call instead of three Lisp predicate/comparison calls. +- **Add** exact append/fallback, multi-engine, unsafe-context, + stable-boundary, dirty-island, and invalid-C-vector regressions, plus a + frozen baseline/candidate evaluator covering five widths, four paragraph + lengths, C/Elisp, and two GC modes. +- **Performance:** the four-round source-instrumented evaluator reduces + 80-pixel C p95/p99 from 114.717/119.201 ms to 25.490/25.785 ms and Elisp + from 588.017/597.093 ms to 43.860/47.578 ms. Ordinary keys remain a + zero-work path at 0.595 ms p99 and all widths avoid regression. +- **Production check:** with production files byte-compiled, three repeated + public-command runs measure append p99 at 1.158–1.326 ms for C and + 1.429–1.438 ms for pure Elisp; hard-boundary p99 is 1.251–1.363 ms and + 1.457–1.470 ms respectively. +- **Decision:** retain the C module. Rust would cross the same Emacs module + ABI and cannot remove the Elisp-owned tokenization, measurement, + transaction, or publication work. Rewriting the already sub-millisecond C + layer would add Cargo and cross-platform release surface without a + measured end-to-end gain. +- **Open gate:** the locked source-instrumented evaluator still exceeds its + absolute 16 ms C/Elisp target, so `task030` and `issue018` remain open even + though the byte-compiled production path is within budget. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/issue_narrow_live_append_latency_20260729.md b/.phrase/phases/phase-kp-overhaul-20260726/issue_narrow_live_append_latency_20260729.md index 6bc7dc6..47b5a69 100644 --- a/.phrase/phases/phase-kp-overhaul-20260726/issue_narrow_live_append_latency_20260729.md +++ b/.phrase/phases/phase-kp-overhaul-20260726/issue_narrow_live_append_latency_20260729.md @@ -2,27 +2,36 @@ ## issue018 [ ] Unique live appends miss the frame budget at very narrow widths -- **Status:** Re-profiled after `task031`; `task030` is unblocked. -- **Summary:** Stable transactions removed per-key whole-hard-line planning. - The synthetic 80-pixel workload now performs zero planning on ordinary - same-row edits, but structural row-crossing commits still make append p99 - exceed the 16 ms frame budget. +- **Status:** Exact incremental implementation verified; the locked + source-instrumented gate remains open. +- **Summary:** Stable transactions removed per-key whole-hard-line planning, + and task030 now incrementally extends paragraph preparation, Elisp DP + state, and layout lines only at structural row crossings. Byte-compiled + production paths are within the 16 ms frame budget; the deliberately + source-loaded, fully instrumented evaluator still exceeds it. - **Environment:** Emacs 30.2 on macOS, C backend 1.6, benchmark width fixed at 80 px, `gc-cons-threshold` bound to `most-positive-fixnum` so mutator work is measured without GC pauses. - **Repro:** - 1. Load the C backend. - 2. Run `tests/ekp-buffer-live-bench.el` with GC excluded. - 3. Inspect the `append` row. + 1. For the production-shaped check, byte-compile the four production + Elisp files into a temporary package root, put that root first on + `load-path`, and run `tests/ekp-buffer-live-bench.el` once with the C + module loaded and once with `ekp-use-c-module` nil. + 2. Confirm `ekp--dp-run-1d` is byte code and inspect the `append` and + `hard-boundary` rows. + 3. For the locked source/instrumentation matrix, run + `tests/run-live-commit-evaluator.sh` and inspect + `.omx/goals/performance/narrow-live-commit/latest-report.json`. - **Expected vs Actual:** - Expected: live append p99 remains below the 16 ms interaction budget, including narrow windows. - - Actual: the final task031 GC-excluded runs record only 15 permitted - structural plans across 291 appends. C measures median 2.177 ms and p99 - 51.170 ms; Elisp measures median 2.176 ms and p99 187.499 ms. Same-row - cache-revisit work records zero plans (C p99 1.627 ms; Elisp p99 - 1.502 ms), while point motion records zero plan/cache calls (C p99 - 0.017 ms; Elisp p99 0.015 ms). + - Actual production path: three repeated byte-compiled public-command runs + measure append p99 at 1.158–1.326 ms for C and 1.429–1.438 ms for pure + Elisp. Hard-boundary p99 is 1.251–1.363 ms and 1.457–1.470 ms. + - Actual locked evaluator: four interleaved source-instrumented rounds + measure C at 25.490/25.785 ms p95/p99 and Elisp at + 43.860/47.578 ms. These improve 77.78/78.37% and 92.54/92.03% over the + frozen baseline but still miss the absolute 16 ms stress target. - **Investigation:** - The task029 point-motion change is not the cause. Navigation is now a zero-work path and does not enter planning or projection publication. @@ -38,6 +47,15 @@ the current performance claim. - Both backends still miss p99 at structural boundaries, so task030 must evaluate both rather than optimize only the C wrapper. + - The frozen C wrapper measured only 2.615/2.655 ms p95/p99 and the + candidate 0.697/0.701 ms. Paragraph preparation, DP state reconstruction, + plan construction, and publication owned the end-to-end cost. + - Byte compilation removes most of the remaining pure-Elisp interpreter + and closure overhead. This explains why the production path passes while + the frozen source-instrumented stress gate remains red; neither result is + substituted for the other. + - Rust is not selected. It would use the same `emacs_env` ABI and cannot + remove Elisp-owned font measurement, transaction, or projection work. - **Required Outcome:** - Diagnose and reduce unique-state narrow-width append planning cost without changing KP output semantics, the core DP contract, C ABI, or @@ -47,13 +65,19 @@ invalidation. - Preserve the task029 invariant that point-only motion performs zero plan, cache, and text-property work. -- **Fix:** Deferred to `task030`; the prerequisite correctness replacement - is complete. Optimize only the surviving structural-commit path. -- **Verification:** Future work must use a reproducible width matrix, - profiler evidence, result-equivalence tests, default-GC and GC-excluded - runs, and GUI input evidence. -- **User Confirmation:** Not applicable until a performance change is - implemented. +- **Fix:** `task030` retains exact prepared paragraph/context data, extends + property-free append tails from the last complete-word boundary, resumes + pure-Elisp DP from a safe reachable state, reuses common layout lines, and + reconstructs only the live dirty source island. Unsupported contexts take + the unchanged full path. C int32 validation now performs one extraction. +- **Verification:** Exact baseline/C/Elisp hashes and append-chain + equivalence pass across 64/80/96/128/160 px, 2/4/8/16-row fixtures, + default/excluded GC, unsafe fallbacks, and randomized chains. Normal and + random-order ERT pass 199/199; 300 fuzz cases, warning-clean production/C + compilation, 9/9 C tests, release checks, and reviewed temporal GUI + evidence pass. +- **User Confirmation:** Pending; the formal source-instrumented performance + target also remains open. - **Resolved At:** Unresolved. - **Resolved By:** Pending. - **Commit:** Pending. diff --git a/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md b/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md index 56c3742..9f7f78f 100644 --- a/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md +++ b/.phrase/phases/phase-kp-overhaul-20260726/task_repository_audit_20260728.md @@ -590,6 +590,36 @@ - Dependency: `task031` is complete. Optimize only the surviving structural-commit path; the obsolete per-keystroke whole-hard-line path no longer exists. + - Implementation checkpoint: layout plans now retain prepared paragraph + and context data. Exact plain-text appends retokenize only from the last + complete-word boundary, rebuild derived vectors from the first dirty box, + resume pure-Elisp 1D DP from the earliest state that can reach the new + tail, and reuse unchanged line records. The buffer reconstructs only its + dirty source island and falls back to the complete planner for every + unsupported context. C signed-int validation now uses one module + extraction instead of three Lisp predicate/comparison calls. + - Architecture decision: keep the C module. The frozen baseline places C + DP at only 2.615/2.655 ms p95/p99, and the candidate at + 0.697/0.701 ms. Rust would cross the same Emacs module ABI while leaving + Elisp tokenization, measurement, transactions, and property publication + unchanged. + - Performance checkpoint: four interleaved source-instrumented rounds + reduce 80-pixel C p95/p99 from 114.717/119.201 ms to + 25.490/25.785 ms (77.78/78.37%) and Elisp from 588.017/597.093 ms to + 43.860/47.578 ms (92.54/92.03%). Exact parity, zero-work ordinary keys, + valid GC exclusion, conflict freedom, and all-width non-regression pass. + - Production checkpoint: with production files byte-compiled, three + repeated public-command runs measure append p99 at 1.158–1.326 ms for C + and 1.429–1.438 ms for pure Elisp; hard-boundary p99 is + 1.251–1.363 ms and 1.457–1.470 ms respectively. + - Verification checkpoint: normal and random-order ERT pass 199/199; + 300-case C/Elisp fuzz, portable warning-clean C build and 9/9 C tests, + warning-as-error production compilation, release checks, exact + append-chain review, and the 11-action/33-checkpoint temporal GUI run + pass. + - Remaining gate: the locked source-instrumented evaluator still exceeds + its absolute 16 ms target for C and Elisp. Keep `task030` open rather + than redefining the evaluator after observing the result. - task031 [x] Replace the overloaded live frontier with committed projection, a dirty edit transaction, and atomic structural commits. diff --git a/CHANGELOG.md b/CHANGELOG.md index 238d8a0..2da4f96 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -128,14 +128,17 @@ project aims to follow [Semantic Versioning](https://semver.org/). ### Performance -- The live-path benchmark records append, historical-plan reuse, - point-motion, and hard-boundary latency with plan/cache counters. - At the synthetic 80-pixel width, same-row editing and point motion perform - zero planning; point-motion p99 is 0.017 ms on C and 0.015 ms on Elisp. - Across 291 appends, only 15 visual-row crossings invoke the planner. - Those structural commits still exceed the 16 ms p99 frame budget on both - backends and are tracked as `issue018`/`task030`; no stale reuse, debounce, - skipped publication, or global GC workaround hides the miss. +- Live structural commits now extend prepared paragraph data from the last + complete-word boundary, resume pure-Elisp DP from a safe retained state, + reuse unchanged layout lines, and reconstruct only the buffer's dirty + source island. Three repeated byte-compiled public-command runs at 80 + pixels measure append p99 at 1.158–1.326 ms for C and 1.429–1.438 ms for + pure Elisp; same-row editing and point motion still perform zero planning. + The stricter frozen source-instrumented matrix improves C p99 by 78.37% to + 25.785 ms and Elisp p99 by 92.03% to 47.578 ms, but remains openly red + against its locked 16 ms absolute stress target (`issue018`/`task030`). + No stale reuse, debounce, skipped publication, or global GC workaround + hides either result. - Tokenization now accumulates fragments and joins once per emitted box; dense hyphen insertion likewise joins original word slices once. On the 1,000–8,000-character adversarial benchmark, the 8,000-character cases @@ -157,6 +160,10 @@ project aims to follow [Semantic Versioning](https://semver.org/). ### C module (1.6) +- Signed 32-bit module inputs now use one `extract_integer` validation + instead of calling Lisp `integerp`, `>=`, and `<=` for every value. The + frozen 80-pixel candidate module layer measures 0.697/0.701 ms p95/p99, + down from 2.615/2.655 ms, without changing the ABI or DP output. - The 15-field single and batch APIs now preflight vector shape, lengths, scalar types, and signed 32-bit input range before extraction. Caller errors signal `ekp-c-invalid-input`; allocation/no-result still returns diff --git a/ekp-buffer.el b/ekp-buffer.el index f5ed5e4..b8ad7ec 100644 --- a/ekp-buffer.el +++ b/ekp-buffer.el @@ -146,6 +146,10 @@ command and is not limited by this value." '(ekp-justified ekp-buffer--display ekp-buffer--line-prefix) "Text properties that identify EKP's buffer projection.") +(defconst ekp-buffer--non-ascii-whitespace-regexp + "[\t\n\r\v\f\u0085\u00A0\u1680\u2000-\u200A\u2028\u2029\u202F\u205F\u3000]" + "Unicode whitespace that cannot use the ASCII-space projection path.") + (dolist (property ekp-buffer--owned-properties) (setf (alist-get property text-property-default-nonsticky) t)) @@ -279,25 +283,26 @@ The narrowest live window wins because text properties are buffer-wide." (setq position (1+ position))) (= position end)))) -(defun ekp-buffer--unsupported-gap-p (gap base) - "Return non-nil when GAP cannot be projected at BASE." - (let ((start (+ base (ekp-layout-gap-source-start gap))) - (end (+ base (ekp-layout-gap-source-end gap)))) - (and (< start end) - (not (ekp-buffer--ascii-space-range-p start end)) - (< (ekp-layout-gap-target-pixel gap) - (ekp-layout-gap-natural-pixel gap))))) - -(defun ekp-buffer--unsupported-gap (plan base) - "Return the first gap in PLAN that cannot be projected at BASE." - (catch 'unsupported - (cl-loop - for line across (ekp-layout-plan-lines plan) - do - (cl-loop - for gap across (ekp-layout-line-gaps line) - when (ekp-buffer--unsupported-gap-p gap base) - do (throw 'unsupported gap))))) +(defun ekp-buffer--unsupported-gap (plan _base) + "Return the first gap in PLAN that cannot be projected." + (let ((string (ekp-layout-plan-string plan))) + (when (string-match-p ekp-buffer--non-ascii-whitespace-regexp string) + (catch 'unsupported + (cl-loop + for line across (ekp-layout-plan-lines plan) + do + (cl-loop + for gap across (ekp-layout-line-gaps line) + for start = (ekp-layout-gap-source-start gap) + for end = (ekp-layout-gap-source-end gap) + when (and (< start end) + (< (ekp-layout-gap-target-pixel gap) + (ekp-layout-gap-natural-pixel gap))) + do + (while (and (< start end) (= (aref string start) ?\s)) + (setq start (1+ start))) + (when (< start end) + (throw 'unsupported gap)))))))) (defun ekp-buffer--record-conflict (beg end reason) "Record that BEG through END stayed verbatim because of REASON." @@ -1078,6 +1083,21 @@ LINE-END lets insertion at the hard-line end belong to its last span." "Return BEG through END with EKP projection properties removed." (ekp-buffer--strip-owned-from-string (buffer-substring beg end))) +(defun ekp-buffer--current-live-source () + "Return the current logical source by replacing only the dirty island." + (let* ((state ekp-buffer--live-state) + (edit ekp-buffer--live-edit) + (source (ekp-buffer--live-state-source state)) + (start (ekp-buffer--live-edit-dirty-start edit)) + (finish (ekp-buffer--live-edit-dirty-finish edit)) + (dirty-beg + (marker-position (ekp-buffer--live-edit-dirty-beg edit))) + (dirty-end + (marker-position (ekp-buffer--live-edit-dirty-end edit)))) + (concat (substring source 0 start) + (buffer-substring dirty-beg dirty-end) + (substring source finish)))) + (defun ekp-buffer--live-context (width) "Return non-text layout context for a live plan at WIDTH." (list (ekp--dp-key width) @@ -1121,13 +1141,26 @@ LINE-END lets insertion at the hard-line end belong to its last span." (setcdr (nthcdr 15 ekp-buffer--live-plan-cache) nil)) plan) +(defun ekp-buffer--live-append-plan (key text width) + "Extend the committed live plan for KEY to TEXT at WIDTH." + (let ((old-key (and ekp-buffer--live-state + (ekp-buffer--live-state-key + ekp-buffer--live-state))) + (old-plan (and ekp-buffer--live-state + (ekp-buffer--live-state-plan + ekp-buffer--live-state)))) + (when (and old-key old-plan + (equal (cadr key) (cadr old-key))) + (ekp-layout-plan-append old-plan text width)))) + (defun ekp-buffer--live-plan-entry (text width) "Return the cache entry for TEXT at WIDTH." (let ((key (list text (ekp-buffer--live-context width)))) (cons key (or (ekp-buffer--live-cache-get key) (ekp-buffer--live-cache-put - key (ekp-layout-plan text width)))))) + key (or (ekp-buffer--live-append-plan key text width) + (ekp-layout-plan text width))))))) (defun ekp-buffer--single-line-live-p (text width) "Return non-nil if TEXT is conservatively known to fit WIDTH." @@ -1415,7 +1448,11 @@ Keep BOUNDARY's semantic row natural unless COMPLETE is non-nil." ekp-buffer--live-edit))) (point)) end))) - (text (and beg end (ekp-buffer--logical-substring beg end)))) + (text + (and beg end + (if ekp-buffer--live-edit + (ekp-buffer--current-live-source) + (ekp-buffer--logical-substring beg end))))) (when (and beg end width text) (condition-case err (ekp-buffer--publish-semantic-prefix @@ -1443,25 +1480,31 @@ Keep BOUNDARY's semantic row natural unless COMPLETE is non-nil." (dolist (range (ekp-buffer--paragraph-ranges old-start active-beg)) (ekp-buffer--layout-paragraph (car range) (cdr range) ekp-buffer--auto-width)))) + (ekp-buffer--release-live-edit) (ekp-buffer--activate-live-paragraph active-beg active-end) - (ekp-buffer--publish-live-prefix end) - (ekp-buffer--release-live-edit))) + (ekp-buffer--publish-live-prefix end))) -(defun ekp-buffer--baseline-logical-source () - "Return the current transaction baseline without EKP projection." - (ekp-buffer--strip-owned-from-string - (copy-sequence - (ekp-buffer--live-edit-baseline-source ekp-buffer--live-edit)))) +(defun ekp-buffer--baseline-logical-source (&optional start finish) + "Return the transaction baseline without EKP projection. +When START and FINISH are non-nil, copy only that source interval." + (let ((source (ekp-buffer--live-edit-baseline-source + ekp-buffer--live-edit))) + (ekp-buffer--strip-owned-from-string + (if start + (substring source start finish) + (copy-sequence source))))) (defun ekp-buffer--live-baseline-restored-p () "Return non-nil when source and foreign properties match the baseline." - (let* ((state ekp-buffer--live-state) - (beg (marker-position (ekp-buffer--live-state-beg state))) - (end (marker-position (ekp-buffer--live-state-end state)))) + (let* ((edit ekp-buffer--live-edit) + (beg (marker-position (ekp-buffer--live-edit-dirty-beg edit))) + (end (marker-position (ekp-buffer--live-edit-dirty-end edit))) + (start (ekp-buffer--live-edit-dirty-start edit)) + (finish (ekp-buffer--live-edit-dirty-finish edit))) (and beg end (equal-including-properties - (ekp-buffer--logical-substring beg end) - (ekp-buffer--baseline-logical-source))))) + (buffer-substring beg end) + (ekp-buffer--baseline-logical-source start finish))))) (defun ekp-buffer--baseline-owned-properties (position) "Return EKP-owned properties at baseline string POSITION." diff --git a/ekp.el b/ekp.el index 4ca5b49..fc5bb0e 100644 --- a/ekp.el +++ b/ekp.el @@ -260,7 +260,7 @@ when non-zero the C module is bypassed automatically." (cl-defstruct (ekp-layout-plan (:constructor ekp-layout-plan--create)) "Semantic KP layout independent of any output representation." - string line-pixel boxes offsets lines) + string line-pixel context para boxes offsets lines) (defvar ekp--para-cache nil "Cache: equal-keyed table, content key → ekp-para struct.") @@ -834,9 +834,23 @@ MEASURE is the paragraph measure passed to the justify call. (cons 0 measure))) (t (cons 0 measure)))) +(defun ekp--glue-params-snapshot () + "Return current paragraph glue parameters as a stable plist." + (let ((justify (eq ekp-alignment 'justify))) + (list :lws-ideal ekp-lws-ideal-pixel + :lws-stretch (if justify ekp-lws-stretch-pixel 0) + :lws-shrink (if justify ekp-lws-shrink-pixel 0) + :mws-ideal ekp-mws-ideal-pixel + :mws-stretch (if justify ekp-mws-stretch-pixel 0) + :mws-shrink (if justify ekp-mws-shrink-pixel 0) + :cws-ideal ekp-cws-ideal-pixel + :cws-stretch (if justify ekp-cws-stretch-pixel 0) + :cws-shrink (if justify ekp-cws-shrink-pixel 0) + :alignment ekp-alignment + :extra-stretch (if justify 0 (ekp--ragged-extra-stretch))))) + (defun ekp--make-para (string) - "Create and fully initialize `ekp-para' struct for STRING. -Computes ALL data in one pass: text, params, and prefix arrays." + "Create and fully initialize `ekp-para' for STRING." ;; Ensure params: explicit params persist; otherwise derive defaults ;; from this string's font. (unless (and ekp--params-explicit (ekp--params-set-p)) @@ -983,21 +997,286 @@ Computes ALL data in one pass: text, params, and prefix arrays." :forbidden-positions (vconcat (nreverse forbidden)) :tail-protrudes tail-protrudes :hyphen-protrude hyphen-protrude - :glue-params (let ((justify (eq ekp-alignment 'justify))) - (list :lws-ideal ekp-lws-ideal-pixel - :lws-stretch (if justify ekp-lws-stretch-pixel 0) - :lws-shrink (if justify ekp-lws-shrink-pixel 0) - :mws-ideal ekp-mws-ideal-pixel - :mws-stretch (if justify ekp-mws-stretch-pixel 0) - :mws-shrink (if justify ekp-mws-shrink-pixel 0) - :cws-ideal ekp-cws-ideal-pixel - :cws-stretch (if justify ekp-cws-stretch-pixel 0) - :cws-shrink (if justify ekp-cws-shrink-pixel 0) - :alignment ekp-alignment - :extra-stretch (if justify 0 - (ekp--ragged-extra-stretch)))) + :glue-params (ekp--glue-params-snapshot) :dp-cache (make-hash-table :test 'equal :size 20)))) +(defun ekp--append-prefix-vector (prefix count suffix) + "Return PREFIX through COUNT followed by SUFFIX as a vector." + (vconcat (cl-subseq prefix 0 count) suffix)) + +(defun ekp--append-hyphen-positions (para stable tail-positions) + "Merge PARA hyphen positions before STABLE with TAIL-POSITIONS." + (vconcat + (seq-filter + (lambda (position) (< position stable)) + (ekp-para-hyphen-positions para)) + (mapcar + (lambda (position) (+ stable position)) + (append tail-positions nil)))) + +(defun ekp--append-offsets (prefix stable tail-offsets cutoff) + "Merge PREFIX offsets before STABLE with TAIL-OFFSETS at CUTOFF." + (vconcat + (cl-subseq prefix 0 stable) + (mapcar + (lambda (range) + (cons (+ cutoff (car range)) (+ cutoff (cdr range)))) + (append tail-offsets nil)))) + +(defun ekp--gap-natural-at (string boxes offsets right) + "Return STRING's natural gap width before box RIGHT in BOXES and OFFSETS." + (let* ((left (1- right)) + (start (cdr (aref offsets left))) + (end (car (aref offsets right))) + (source (if (< start end) + (substring string start end) + (car (last (string-glyph-split + (aref boxes left))))))) + (ekp--measured-width source))) + +(defun ekp--append-gap-naturals (para string boxes offsets stable) + "Reuse PARA gaps before STABLE and measure STRING's BOXES via OFFSETS." + (let* ((old (or (ekp-para-gap-naturals-memo para) + (ekp--gap-natural-pixels + para (ekp-para-box-offsets-memo para)))) + (naturals + (vconcat (cl-subseq old 0 stable) + (make-vector (- (length boxes) stable) 0)))) + (cl-loop for right from (max 1 stable) below (length boxes) + do (aset naturals right + (ekp--gap-natural-at string boxes offsets right))) + naturals)) + +(defun ekp--append-cutoff (old string) + "Return an append-safe source cutoff from OLD into STRING, or nil." + (when (and (< (length old) (length string)) + (null (ekp--key-intervals old)) + (null (ekp--key-intervals string)) + (not (string-match-p "[\n\t]" string)) + (string-prefix-p old string)) + (let ((tail (1- (length old)))) + (while (and (>= tail 0) (= (aref old tail) ?\s)) + (setq tail (1- tail))) + (when (>= tail 0) + (when-let ((space + (cl-position ?\s old :from-end t :end (1+ tail)))) + (1+ space)))))) + +(defun ekp--append-stable-box-count (offsets cutoff) + "Return the box index in OFFSETS beginning at CUTOFF." + (let ((position (1- (length offsets))) + found) + (while (and (>= position 0) (not found)) + (if (= (car (aref offsets position)) cutoff) + (setq found position) + (setq position (1- position)))) + found)) + +(defun ekp--copy-vector-prefix (source length count initial) + "Return LENGTH vector initialized from SOURCE's first COUNT entries." + (vconcat (cl-subseq (if (bool-vector-p source) + (vconcat source) + source) + 0 count) + (make-vector (- length count) initial))) + +(defun ekp--append-glue-types (para boxes types hyphens stable) + "Extend PARA glue types for BOXES from STABLE using TYPES and HYPHENS." + (let ((glues (ekp--copy-vector-prefix + (ekp-para-glues-types para) (length boxes) stable nil))) + (dolist (position (append hyphens nil)) + (when (>= position (1- stable)) + (aset glues (1+ position) 'nws))) + (cl-loop for index from stable below (length boxes) + unless (aref glues index) + do (aset glues index + (ekp--glue-type + (and (> index 0) (aref types (1- index))) + (aref types index)))) + (cl-loop for position from stable below (length boxes) + when (ekp--append-break-forbidden-p boxes types position) + do (aset glues position 'nws)) + glues)) + +(defun ekp--append-prefix-data (para stable widths types glues) + "Extend PARA prefix data from STABLE using WIDTHS, TYPES, and GLUES." + (let* ((n (length widths)) + (prefix-count (1+ stable)) + (ideal (ekp--copy-vector-prefix + (ekp-para-ideal-prefixs para) (1+ n) prefix-count 0)) + (minimum (ekp--copy-vector-prefix + (ekp-para-min-prefixs para) (1+ n) prefix-count 0)) + (maximum (ekp--copy-vector-prefix + (ekp-para-max-prefixs para) (1+ n) prefix-count 0)) + (g-ideal (ekp--copy-vector-prefix + (ekp-para-glue-ideals para) n stable 0)) + (g-shrink (ekp--copy-vector-prefix + (ekp-para-glue-shrinks para) n stable 0)) + (g-stretch (ekp--copy-vector-prefix + (ekp-para-glue-stretches para) n stable 0)) + (lws (ekp--copy-vector-prefix + (ekp-para-lws-prefixs para) (1+ n) prefix-count 0)) + (mws (ekp--copy-vector-prefix + (ekp-para-mws-prefixs para) (1+ n) prefix-count 0)) + (cws (ekp--copy-vector-prefix + (ekp-para-cws-prefixs para) (1+ n) prefix-count 0)) + (lead (ekp--copy-vector-prefix + (ekp-para-lead-spaces para) (1+ n) stable 0)) + (trail (ekp--copy-vector-prefix + (ekp-para-trail-spaces para) (1+ n) prefix-count 0))) + (cl-loop for index from stable below n do + (let* ((width (aref widths index)) + (type (aref glues index)) + (gi (ekp-glue-ideal-pixel type)) + (gmin (if (eq ekp-alignment 'justify) + (ekp-glue-min-pixel type) gi)) + (gmax (if (eq ekp-alignment 'justify) + (ekp-glue-max-pixel type) gi))) + (aset g-ideal index gi) + (aset g-shrink index (- gi gmin)) + (aset g-stretch index (- gmax gi)) + (aset ideal (1+ index) + (+ (aref ideal index) width gi)) + (aset minimum (1+ index) + (+ (aref minimum index) width gmin)) + (aset maximum (1+ index) + (+ (aref maximum index) width gmax)) + (aset lws (1+ index) + (+ (aref lws index) (if (eq type 'lws) 1 0))) + (aset mws (1+ index) + (+ (aref mws index) (if (eq type 'mws) 1 0))) + (aset cws (1+ index) + (+ (aref cws index) (if (eq type 'cws) 1 0))) + (aset trail (1+ index) + (if (ekp--space-box-type-p (aref types index)) + (+ (aref trail index) width) 0)))) + (cl-loop for index downfrom (1- n) to stable + do (aset lead index + (if (ekp--space-box-type-p (aref types index)) + (+ (aref widths index) (aref lead (1+ index))) + 0))) + (aset lead 0 0) + (vector ideal minimum maximum g-ideal g-shrink g-stretch + lws mws cws lead trail))) + +(defun ekp--append-break-forbidden-p (boxes types position) + "Return non-nil when BOXES of TYPES may not break at POSITION." + (let* ((previous (aref boxes (1- position))) + (current (aref boxes position)) + (previous-last (aref previous (1- (length previous)))) + (current-first (aref current 0))) + (or (ekp--box-no-line-end-p previous (aref types (1- position))) + (ekp--box-no-line-start-p current (aref types position)) + (memq previous-last ekp--no-break-joiner-chars) + (memq current-first ekp--no-break-joiner-chars)))) + +(defun ekp--append-break-data (para boxes types stable) + "Extend PARA break permissions for BOXES of TYPES from STABLE." + (let* ((n (length boxes)) + (breaks (ekp--copy-vector-prefix + (ekp-para-breaks-allowed para) + (1+ n) stable t)) + (forbidden + (seq-filter + (lambda (position) (< position stable)) + (ekp-para-forbidden-positions para)))) + (cl-loop for position from stable below n + when (ekp--append-break-forbidden-p boxes types position) + do (aset breaks position nil) + and do (push position forbidden)) + (cons breaks (vconcat (sort (append forbidden nil) #'<))))) + +(defun ekp--append-tail-protrudes (para boxes types stable) + "Extend PARA tail protrusions for BOXES of TYPES from STABLE." + (let* ((n (length boxes)) + (tail (ekp--copy-vector-prefix + (ekp-para-tail-protrudes para) (1+ n) (1+ stable) 0))) + (when ekp-protrusion + (cl-loop for position from (1+ stable) to n + for index = (1- position) + do (aset tail position + (if (ekp--space-box-type-p (aref types index)) + (aref tail (1- position)) + (ekp--tail-protrude-pixel + (aref boxes index) (aref types index)))))) + tail)) + +(defun ekp--append-para-record + (para string stable boxes widths types glues hyphens offsets gaps) + "Extend PARA with STRING after STABLE. +Use BOXES, WIDTHS, TYPES, GLUES, HYPHENS, OFFSETS, and GAPS." + (let* ((prefix (ekp--append-prefix-data + para stable widths types glues)) + (breaks (ekp--append-break-data para boxes types stable)) + (extended (copy-ekp-para para))) + (setf (ekp-para-string extended) string + (ekp-para-boxes extended) boxes + (ekp-para-boxes-widths extended) widths + (ekp-para-boxes-types extended) types + (ekp-para-glues-types extended) glues + (ekp-para-hyphen-positions extended) hyphens + (ekp-para-ideal-prefixs extended) (aref prefix 0) + (ekp-para-min-prefixs extended) (aref prefix 1) + (ekp-para-max-prefixs extended) (aref prefix 2) + (ekp-para-glue-ideals extended) (aref prefix 3) + (ekp-para-glue-shrinks extended) (aref prefix 4) + (ekp-para-glue-stretches extended) (aref prefix 5) + (ekp-para-lws-prefixs extended) (aref prefix 6) + (ekp-para-mws-prefixs extended) (aref prefix 7) + (ekp-para-cws-prefixs extended) (aref prefix 8) + (ekp-para-lead-spaces extended) (aref prefix 9) + (ekp-para-trail-spaces extended) (aref prefix 10) + (ekp-para-breaks-allowed extended) (car breaks) + (ekp-para-forbidden-positions extended) (cdr breaks) + (ekp-para-tail-protrudes extended) + (ekp--append-tail-protrudes para boxes types stable) + (ekp-para-box-offsets-memo extended) offsets + (ekp-para-gap-naturals-memo extended) gaps + (ekp-para-dp-cache extended) + (make-hash-table :test 'equal :size 20)) + extended)) + +(defun ekp--append-para (para string) + "Return (NEW-PARA . STABLE-BOXES) for plain STRING appended to PARA. +Return nil when the tokenizer prefix cannot be reused exactly." + (let* ((old (ekp-para-string para)) + (cutoff (and (> (length old) 0) + (ekp--append-cutoff old string))) + (fonts-stable + (and cutoff + (equal (ekp-para-latin-font para) + (ekp-latin-font string)) + (equal (ekp-para-cjk-font para) + (ekp-cjk-font string)))) + (old-offsets (ekp-para-box-offsets-memo para)) + (stable (and fonts-stable old-offsets + (ekp--append-stable-box-count old-offsets cutoff)))) + (when (and stable (> stable 0)) + (let* ((tail (substring string cutoff)) + (split (ekp--split-with-hyphen tail)) + (tail-boxes (car split)) + (boxes (ekp--append-prefix-vector + (ekp-para-boxes para) stable tail-boxes)) + (widths (ekp--append-prefix-vector + (ekp-para-boxes-widths para) stable + (ekp--measure-boxes tail-boxes t))) + (types (ekp--append-prefix-vector + (ekp-para-boxes-types para) stable + (vconcat (mapcar #'ekp--box-type tail-boxes)))) + (hyphens (ekp--append-hyphen-positions para stable (cdr split))) + (glues (ekp--append-glue-types + para boxes types hyphens stable)) + (offsets (ekp--append-offsets + old-offsets stable + (ekp--box-offsets tail (append tail-boxes nil)) + cutoff)) + (gaps (ekp--append-gap-naturals + para string boxes offsets stable))) + (cons (ekp--append-para-record + para string stable boxes widths types glues + hyphens offsets gaps) + stable))))) + (defun ekp--get-para (string) "Get or create `ekp-para' struct for STRING. This is the main entry point for cached paragraph data." @@ -1180,12 +1459,84 @@ pass, where line 0 starts at box 0." (aset v (aref hyphen-positions j) t)) v)) -(defun ekp--dp-run-1d (para line-pixel allow-emergency) +(defun ekp--dp-state-array (length previous stable index initial) + "Return LENGTH array reusing PREVIOUS INDEX through STABLE." + (if previous + (ekp--copy-vector-prefix + (aref previous index) length (1+ stable) initial) + (make-vector length initial))) + +(defun ekp--dp-last-allowed-break (breaks end) + "Return the last permitted break in BREAKS at or before END." + (let ((position end)) + (while (and (> position 0) (not (aref breaks position))) + (setq position (1- position))) + position)) + +(defun ekp--dp-first-new-break (para stable) + "Return PARA's first permitted break after STABLE." + (let ((breaks (ekp-para-breaks-allowed para)) + (position (1+ stable)) + (end (length (ekp-para-boxes para)))) + (while (and (< position end) (not (aref breaks position))) + (setq position (1+ position))) + position)) + +(defun ekp--dp-line-too-long-p (para start end line-pixel) + "Return non-nil when PARA's START..END cannot fit LINE-PIXEL." + (let* ((hyphen-p (ekp--hyphenate-p + (ekp-para-hyphen-positions para) (1- end))) + (hyphen-width (if hyphen-p (ekp-para-hyphen-pixel para) 0)) + (ideal (ekp--line-ideal-pixel para start end)) + (minimum-prefix (ekp-para-min-prefixs para)) + (glue-ideal (aref (ekp-para-glue-ideals para) start)) + (glue-min (- glue-ideal + (aref (ekp-para-glue-shrinks para) start))) + (raw-ideal (- (aref (ekp-para-ideal-prefixs para) end) + (aref (ekp-para-ideal-prefixs para) start) + glue-ideal)) + (space-width (ekp--line-stripped-space-pixel + raw-ideal start end + (ekp-para-lead-spaces para) + (ekp-para-trail-spaces para))) + (minimum (+ (- (aref minimum-prefix end) + (aref minimum-prefix start) + glue-min space-width) + hyphen-width)) + (target (+ (if (= start 0) + (cdr (ekp--line-spec para 0 line-pixel)) + line-pixel) + (if hyphen-p + (ekp-para-hyphen-protrude para) + (aref (ekp-para-tail-protrudes para) end))))) + (or (> minimum target) + (and (= end (length (ekp-para-boxes para))) + (> ideal target))))) + +(defun ekp--dp-reused-start (para stable line-pixel) + "Return PARA's earliest state before STABLE reaching LINE-PIXEL's tail." + (let ((end (ekp--dp-first-new-break para stable)) + (low 0) + (high stable)) + (while (< low high) + (let ((middle (/ (+ low high) 2))) + (if (ekp--dp-line-too-long-p + para middle end line-pixel) + (setq low (1+ middle)) + (setq high middle)))) + low)) + +(defun ekp--dp-run-1d + (para line-pixel allow-emergency &optional previous-state stable-end) "One strict (or emergency-permitting) K-P DP pass over PARA at LINE-PIXEL. Returns the dp-result plist, or nil when the paragraph end is -unreachable (only possible when ALLOW-EMERGENCY is nil)." +unreachable (only possible when ALLOW-EMERGENCY is nil). +PREVIOUS-STATE may reuse exact states through STABLE-END." (let* ((boxes (ekp-para-boxes para)) (n (length boxes)) + (reuse (and previous-state stable-end + (eq (aref previous-state 6) allow-emergency))) + (stable (if reuse (min stable-end n) 0)) (hyphen-pixel (ekp-para-hyphen-pixel para)) (hyph-flags (ekp--hyphen-flags (ekp-para-hyphen-positions para) n)) @@ -1201,6 +1552,8 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (lead-spaces (ekp-para-lead-spaces para)) (trail-spaces (ekp-para-trail-spaces para)) (breaks-ok (ekp-para-breaks-allowed para)) + (last-reused-break + (and reuse (ekp--dp-last-allowed-break breaks-ok stable))) (tail-protrudes (ekp-para-tail-protrudes para)) (hyphen-protrude (ekp-para-hyphen-protrude para)) ;; First-line indent shrinks line 0 only; a line starts at @@ -1215,16 +1568,27 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (mws-shrink (plist-get params :mws-shrink)) (cws-shrink (plist-get params :cws-shrink)) (extra-stretch (or (plist-get params :extra-stretch) 0)) - (backptrs (make-vector (1+ n) nil)) - (demerits (make-vector (1+ n) nil)) - (rests (make-vector (1+ n) nil)) - (gaps (make-vector (1+ n) nil)) - (hyphen-counts (make-vector (1+ n) 0)) - (fitness-classes (make-vector (1+ n) 1))) + (reused-state (and reuse previous-state)) + (backptrs (ekp--dp-state-array + (1+ n) reused-state stable 0 nil)) + (demerits (ekp--dp-state-array + (1+ n) reused-state stable 1 nil)) + (rests (ekp--dp-state-array + (1+ n) reused-state stable 2 nil)) + (gaps (ekp--dp-state-array + (1+ n) reused-state stable 3 nil)) + (hyphen-counts (ekp--dp-state-array + (1+ n) reused-state stable 4 0)) + (fitness-classes (ekp--dp-state-array + (1+ n) reused-state stable 5 1))) (aset demerits 0 0.0) - (dotimes (i n) - (when (aref demerits i) - (let* ((prev-dem (aref demerits i)) + (let ((iteration-start + (if reuse + (ekp--dp-reused-start para stable line-pixel) + 0))) + (cl-loop for i from iteration-start below n do + (when (aref demerits i) + (let* ((prev-dem (aref demerits i)) (prev-hyphen-count (aref hyphen-counts i)) (prev-fitness (aref fitness-classes i)) (ip-i (aref ideal-prefixs i)) @@ -1233,8 +1597,12 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (lead-glue-ideal (aref glue-ideals i)) (lead-glue-min (- lead-glue-ideal (aref glue-shrinks i))) (lead-glue-max (+ lead-glue-ideal (aref glue-stretches i))) - (saw-allowed nil) - (k (1+ i))) + (saw-allowed + (and reuse (< i stable) + (> last-reused-break i))) + (k (if (and reuse (< i stable)) + (1+ stable) + (1+ i)))) (catch 'break (while (<= k n) (if (not (or (= k n) (aref breaks-ok k))) @@ -1354,8 +1722,8 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." (- lw ideal) end-with-hyphenp prev-hyphen-count (unless single-box (ekp--gaps-between para i k))))) - (setq saw-allowed t) - (setq k (1+ k))))))))) + (setq saw-allowed t) + (setq k (1+ k)))))))))) ;; Extract solution (nil when end unreachable in the strict pass) (when (aref demerits n) (let ((breaks (ekp--dp-trace-breaks backptrs n))) @@ -1363,7 +1731,10 @@ unreachable (only possible when ALLOW-EMERGENCY is nil)." :gaps (mapcar (lambda (b) (aref gaps b)) breaks) :breaks breaks :cost (aref demerits n) - :line-count (length breaks)))))) + :line-count (length breaks) + :state (vector backptrs demerits rests gaps + hyphen-counts fitness-classes + allow-emergency)))))) (defun ekp--dp-relax-emergency (demerits backptrs rests gaps hyphen-counts fitness-classes i k prev-dem rest @@ -1666,6 +2037,22 @@ HYPHEN-COUNT)." (ekp--dp-cache-via-c para line-pixel) (ekp--dp-cache-elisp para line-pixel)))) +(defun ekp--dp-cache-append (para previous stable line-pixel) + "Compute PARA at LINE-PIXEL reusing PREVIOUS states through STABLE." + (if (ekp--c-available-p) + (ekp--dp-cache-via-c para line-pixel) + (let* ((old (ekp--dp-get-cached previous line-pixel)) + (state (and old (plist-get old :state))) + (result + (if (and state (not (aref state 6))) + (or (ekp--dp-run-1d + para line-pixel nil state stable) + (ekp--dp-run-1d para line-pixel t)) + (or (ekp--dp-run-1d para line-pixel nil) + (ekp--dp-run-1d para line-pixel t))))) + (puthash (ekp--dp-key line-pixel) result (ekp-para-dp-cache para)) + result))) + (defun ekp-dp-cache (string line-pixel) "Compute optimal line breaks for STRING at LINE-PIXEL width. Uses Knuth-Plass dynamic programming with demerits. @@ -1867,64 +2254,70 @@ Returns ((latin-adj . latin-extra) (mix-adj . mix-extra) (cjk-adj . cjk-extra)). (cons mix-adj mix-extra) (cons cjk-adj cjk-extra)))) -(defun ekp--compute-glue-pixels (para glues-types gaps-distribution stretch-p) - "Compute actual glue pixels from GLUES-TYPES and GAPS-DISTRIBUTION. -Return the pixel list for each glue using PARA's stored glue params. -STRETCH-P selects stretch (t) or shrink (nil)." - (let ((latin-adj (car (nth 0 gaps-distribution))) - (latin-extra (cdr (nth 0 gaps-distribution))) - (mix-adj (car (nth 1 gaps-distribution))) - (mix-extra (cdr (nth 1 gaps-distribution))) - (cjk-adj (car (nth 2 gaps-distribution))) - (cjk-extra (cdr (nth 2 gaps-distribution))) - (latin-idx -1) (mix-idx -1) (cjk-idx -1)) - (mapcar - (lambda (type) - (let* ((base (ekp--para-glue-ideal para type)) - (adj (pcase type - ('lws (cl-incf latin-idx) - (+ latin-adj (if (< latin-idx latin-extra) 1 0))) - ('mws (cl-incf mix-idx) - (+ mix-adj (if (< mix-idx mix-extra) 1 0))) - ('cws (cl-incf cjk-idx) - (+ cjk-adj (if (< cjk-idx cjk-extra) 1 0))) - (_ 0)))) - (max 0 (if stretch-p (+ base adj) (- base adj))))) - glues-types))) +(defun ekp--fixed-line-glues (para types start end maximum trailing) + "Return fixed glue pixels for PARA TYPES from START to END. +Use maximum widths when MAXIMUM is non-nil and finish with TRAILING." + (let* ((params (ekp-para-glue-params para)) + (pixels (make-vector (1+ (- end start)) 0))) + (cl-loop for position from (1+ start) below end + for output from 1 + for type = (aref types position) + for ideal = (pcase type + ('lws (plist-get params :lws-ideal)) + ('mws (plist-get params :mws-ideal)) + ('cws (plist-get params :cws-ideal)) + (_ 0)) + for stretch = (if maximum + (pcase type + ('lws (plist-get params :lws-stretch)) + ('mws (plist-get params :mws-stretch)) + ('cws (plist-get params :cws-stretch)) + (_ 0)) + 0) + do (aset pixels output (+ ideal stretch))) + (aset pixels (1- (length pixels)) trailing) + pixels)) -(defun ekp--line-glue-single-box (line-pixel box-width hyphen-p hyphen-pixel) - "Compute glues for a single-box line of width LINE-PIXEL. -BOX-WIDTH is the box width; HYPHEN-P adds HYPHEN-PIXEL when the box -hyphenates. The trailing filler is clamped at 0 for overfull boxes." - (let ((trailing (- line-pixel box-width (if hyphen-p hyphen-pixel 0)))) - (list 0 (max 0 trailing)))) - -(defun ekp--line-glue-last-line (para glues-types ideal-pixel line-pixel) - "Compute glues for the last line (ragged right) of PARA at LINE-PIXEL. -GLUES-TYPES are the per-glue types and IDEAL-PIXEL the line's ideal -width; PARA supplies the stored glue params." - (append '(0) - (mapcar (lambda (type) (ekp--para-glue-ideal para type)) glues-types) - (list (max 0 (- line-pixel ideal-pixel))))) - -(defun ekp--line-glue-normal (para glues-types rest-pixel gaps-list) - "Compute glues for a normal (justified) line from PARA. -GLUES-TYPES are the per-glue types; REST-PIXEL is the surplus (or -deficit) spread across GAPS-LIST using PARA's stored glue params." +(defun ekp--adjusted-line-glues + (para types start end rest-pixel gaps-list) + "Distribute REST-PIXEL over GAPS-LIST for PARA TYPES from START to END." (if (= rest-pixel 0) - (append '(0) (mapcar (lambda (type) (ekp--para-glue-ideal para type)) - glues-types) - '(0)) + (ekp--fixed-line-glues para types start end nil 0) (let* ((stretch-p (> rest-pixel 0)) (distribution (ekp--distribute-gap-adjustment para (abs rest-pixel) gaps-list stretch-p)) - (glue-pixels (ekp--compute-glue-pixels - para glues-types distribution stretch-p))) - (append '(0) glue-pixels '(0))))) + (shares (vconcat distribution)) + (params (ekp-para-glue-params para)) + (pixels (make-vector (1+ (- end start)) 0)) + (indices (vector -1 -1 -1))) + (cl-loop for position from (1+ start) below end + for output from 1 + for type = (aref types position) + for slot = (pcase type ('lws 0) ('mws 1) ('cws 2) (_ nil)) + for ideal = (pcase type + ('lws (plist-get params :lws-ideal)) + ('mws (plist-get params :mws-ideal)) + ('cws (plist-get params :cws-ideal)) + (_ 0)) + do + (let ((adjustment 0)) + (when slot + (cl-incf (aref indices slot)) + (let ((share (aref shares slot))) + (setq adjustment + (+ (car share) + (if (< (aref indices slot) (cdr share)) + 1 0))))) + (aset pixels output + (max 0 (if stretch-p + (+ ideal adjustment) + (- ideal adjustment)))))) + pixels))) -(defun ekp--line-glues-from-data (para line-pixel dp) +(defun ekp--line-glues-from-data + (para line-pixel dp &optional previous-lines common) "Compute glue vectors from prepared PARA at LINE-PIXEL using DP. -Each line's glues are [0 glue1 glue2 ... trailing-space]." +Reuse COMMON entries from PREVIOUS-LINES when provided." (let* ((boxes-num (length (ekp-para-boxes para))) (glues-types (ekp-para-glues-types para)) (alignment (or (plist-get (ekp-para-glue-params para) :alignment) @@ -1936,11 +2329,14 @@ Each line's glues are [0 glue1 glue2 ... trailing-space]." (lines-gaps (plist-get dp :gaps)) (hyphen-pixel (ekp-para-hyphen-pixel para)) (line-glues (make-vector (length breaks) nil)) - (start 0)) - (dotimes (i (length breaks)) + (start (if (> (or common 0) 0) + (nth (1- common) breaks) + 0))) + (dotimes (index (or common 0)) + (aset line-glues index + (ekp-layout-line-glues (aref previous-lines index)))) + (cl-loop for i from (or common 0) below (length breaks) do (let* ((end (nth i breaks)) - (line-glues-types (append (cl-subseq glues-types (1+ start) end) - nil)) (is-last (>= end boxes-num)) (hyphen-p (ekp--hyphenate-p hyphen-positions (1- end))) ;; per-line layout (parshape / first-line indent) @@ -1968,53 +2364,48 @@ Each line's glues are [0 glue1 glue2 ... trailing-space]." (aref (ekp-para-glue-stretches para) start)) space-w) (if hyphen-p hyphen-pixel 0)))) - glue-list) - (setq glue-list + glue-vector) + (setq glue-vector (cond ;; Single box: just trailing space ((= 1 (- end start)) - (ekp--line-glue-single-box eff-pixel - (- ideal-pixel - (if hyphen-p hyphen-pixel 0)) - hyphen-p hyphen-pixel)) + (vector 0 (max 0 (- eff-pixel ideal-pixel)))) ;; Last line, or any line under non-justify alignment: ;; natural glue widths plus a trailing filler. ((or is-last ragged) - (ekp--line-glue-last-line - para line-glues-types ideal-pixel eff-pixel)) + (ekp--fixed-line-glues + para glues-types start end nil + (max 0 (- eff-pixel ideal-pixel)))) ;; Emergency underfull line (can't stretch to width): ;; set glues to max and pad with trailing filler. ((< max-pixel eff-pixel) - (append '(0) - (mapcar (lambda (type) - (ekp--para-glue-max para type)) - line-glues-types) - (list (max 0 (- eff-pixel max-pixel))))) + (ekp--fixed-line-glues + para glues-types start end t + (max 0 (- eff-pixel max-pixel)))) ;; Normal justified line (t - (ekp--line-glue-normal para line-glues-types - (nth i lines-rests) - (nth i lines-gaps))))) + (ekp--adjusted-line-glues + para glues-types start end + (nth i lines-rests) (nth i lines-gaps))))) ;; Non-justify alignment: place the leftover per mode ;; (ragged-right keeps it trailing; center splits it; ragged-left ;; moves it to the head). - (when (and ragged (>= (length glue-list) 2) + (when (and ragged (>= (length glue-vector) 2) (memq alignment '(center ragged-left))) - (let ((filler (car (last glue-list)))) - (setq glue-list + (let* ((last (1- (length glue-vector))) + (filler (aref glue-vector last)) + (lead (if (eq alignment 'center) + (/ filler 2) + filler))) + (aset glue-vector 0 lead) + (aset glue-vector last (if (eq alignment 'center) - (let ((lead (/ filler 2))) - (append (list lead) - (cdr (butlast glue-list)) - (list (- filler lead)))) - (append (list filler) - (cdr (butlast glue-list)) - (list 0)))))) + (- filler lead) + 0)))) ;; left indent renders as a leading spacer (when (> line-indent 0) - (setq glue-list (cons (+ (car glue-list) line-indent) - (cdr glue-list)))) - (aset line-glues i (vconcat glue-list)) + (aset glue-vector 0 (+ (aref glue-vector 0) line-indent))) + (aset line-glues i glue-vector) (setq start end))) line-glues)) @@ -2191,23 +2582,53 @@ LAST-LINE-P suppresses a terminal discretionary hyphen." :trailing-pixel (aref glues (1- (length glues))) :hyphen-p hyphen-p)))) -(defun ekp-layout-plan (string line-pixel) - "Return a semantic KP layout plan for STRING at LINE-PIXEL. -The plan records source offsets, glue targets, breaks, indentation, -and discretionary hyphens without choosing a string or buffer display -representation." - (let* ((para (ekp--get-para string)) - (boxes (ekp-para-boxes para)) +(defun ekp--common-layout-line-count (previous breaks stable) + "Return the break prefix shared by PREVIOUS and BREAKS before STABLE." + (let ((lines (and previous (ekp-layout-plan-lines previous))) + (count 0)) + (while (and lines + (< count (length lines)) + (< count (length breaks)) + (<= (ekp-layout-line-box-end (aref lines count)) stable) + (= (ekp-layout-line-box-end (aref lines count)) + (nth count breaks))) + (cl-incf count)) + count)) + +(defun ekp--layout-context-snapshot (line-pixel) + "Return every non-text input to a plan at LINE-PIXEL." + (list (ekp--dp-key line-pixel) + (copy-tree (ekp--width-context)) + ekp-latin-lang + ekp-alignment + ekp-ragged-stretch-pixel + (and ekp-protrusion (copy-tree ekp-protrusion-ratios)) + (copy-tree ekp-parshape) + ekp-first-line-indent + ekp-cjk-no-line-start-extra + (ekp--spacing-signature))) + +(defun ekp--layout-plan-from-para + (string line-pixel para dp &optional previous stable) + "Build STRING's LINE-PIXEL plan from PARA and DP. +Reuse PREVIOUS lines that end before STABLE when both are non-nil." + (let* ((boxes (ekp-para-boxes para)) (offsets (or (ekp-para-box-offsets-memo para) (setf (ekp-para-box-offsets-memo para) (ekp--box-offsets string (append boxes nil))))) (naturals (ekp--gap-natural-pixels para offsets)) - (dp (ekp--dp-cache-para para line-pixel)) (breaks (plist-get dp :breaks)) - (line-glues (ekp--line-glues-from-data para line-pixel dp)) - (start 0) - lines) - (dotimes (i (length breaks)) + (previous-lines (and previous (ekp-layout-plan-lines previous))) + (common (if previous + (ekp--common-layout-line-count + previous breaks stable) + 0)) + (line-glues (ekp--line-glues-from-data + para line-pixel dp previous-lines common)) + (start (if (> common 0) (nth (1- common) breaks) 0)) + (lines (reverse + (cl-subseq (append previous-lines nil) 0 common)))) + (cl-loop for i from common below (length breaks) do (let* ((end (nth i breaks)) (line (ekp--make-layout-line para offsets naturals i start end (aref line-glues i) @@ -2218,7 +2639,35 @@ representation." string (vconcat (nreverse lines)))) (ekp-layout-plan--create :string string :line-pixel line-pixel - :boxes boxes :offsets offsets :lines lines))) + :context (ekp--layout-context-snapshot line-pixel) + :para para :boxes boxes :offsets offsets :lines lines))) + +(defun ekp-layout-plan (string line-pixel) + "Return a semantic KP layout plan for STRING at LINE-PIXEL. +The plan records source offsets, glue targets, breaks, indentation, +and discretionary hyphens without choosing a display representation." + (let ((para (ekp--get-para string))) + (ekp--layout-plan-from-para + string line-pixel para (ekp--dp-cache-para para line-pixel)))) + +(defun ekp-layout-plan-append (previous string line-pixel) + "Return STRING's exact append plan by extending PREVIOUS, or nil. +Only property-free, context-stable 1D layouts take this fast path." + (let ((old-para (and previous (ekp-layout-plan-para previous)))) + (when (and old-para + (equal (ekp-layout-plan-context previous) + (ekp--layout-context-snapshot line-pixel)) + (= ekp-looseness 0) + (not ekp-parshape) + (equal (ekp-para-glue-params old-para) + (ekp--glue-params-snapshot))) + (when-let* ((append (ekp--append-para old-para string)) + (para (car append)) + (stable (cdr append)) + (dp (ekp--dp-cache-append + para old-para stable line-pixel))) + (ekp--layout-plan-from-para + string line-pixel para dp previous stable))))) (defconst ekp--layout-marker-properties '(ekp-glue ekp-soft-break ekp-soft-hyphen ekp-hidden ekp-justified) diff --git a/ekp_c/README.md b/ekp_c/README.md index df93697..f2aca97 100644 --- a/ekp_c/README.md +++ b/ekp_c/README.md @@ -7,6 +7,12 @@ The division of labor: **Elisp owns all font-dependent data** module runs only the O(n²) dynamic program. This keeps the two engines byte-identical in output while making the hot loop native. +The module remains C deliberately. A Rust implementation would still expose +the Emacs C module ABI and consume the same Elisp-prepared vectors. Current +live-commit profiles put the candidate module call below one millisecond, so +a Rust rewrite would add Cargo, target, and packaging obligations without +removing the measured end-to-end owners. + ## Architecture ``` @@ -100,6 +106,9 @@ the dispatcher never hides it or silently produces a different layout. Every public pixel/position integer must fit signed 32-bit range. The DP uses 64-bit intermediates for sums and differences, so valid extreme inputs cannot overflow when line width and protrusion are combined. +Validation uses one `extract_integer` call per integer value and clears the +temporary non-local exit only when the value is not an integer; it does not +round-trip through Lisp predicates and comparisons. ## Performance @@ -119,3 +128,10 @@ tokenization, measurement and rendering stay in Elisp. The C engine matters most for `range-justify` (many widths per text) and multi-paragraph batches. Absolute numbers vary with the machine and power state; regenerate them with the two commands in DEVELOPER.md §9. + +For task030's frozen 80-pixel structural-commit matrix, the C module layer +improved from 2.615/2.655 ms to 0.697/0.701 ms p95/p99 after one-pass integer +validation. With the production Elisp files byte-compiled, the complete +public append path measures 1.158–1.326 ms p99 for C and 1.429–1.438 ms for +pure Elisp on the same machine. These figures are separate from the +deliberately source-loaded, fully instrumented evaluator. diff --git a/ekp_c/ekp.c b/ekp_c/ekp.c index 4daf4ce..7d3d5d9 100644 --- a/ekp_c/ekp.c +++ b/ekp_c/ekp.c @@ -47,18 +47,12 @@ static bool lisp_predicate(emacs_env *env, const char *name, emacs_value value) static bool i32_value_p(emacs_env *env, emacs_value value) { - if (!lisp_predicate(env, "integerp", value)) + intmax_t integer = env->extract_integer(env, value); + if (env->non_local_exit_check(env) != emacs_funcall_exit_return) { + env->non_local_exit_clear(env); return false; - - emacs_value min = env->make_integer(env, INT32_MIN); - emacs_value max = env->make_integer(env, INT32_MAX); - bool at_least_min = env->is_not_nil( - env, env->funcall( - env, env->intern(env, ">="), 2, (emacs_value[]){value, min})); - bool at_most_max = env->is_not_nil( - env, env->funcall( - env, env->intern(env, "<="), 2, (emacs_value[]){value, max})); - return at_least_min && at_most_max; + } + return integer >= INT32_MIN && integer <= INT32_MAX; } static bool finite_number_p(emacs_env *env, emacs_value value) diff --git a/postmortem/20260730-incremental-live-append-ownership.md b/postmortem/20260730-incremental-live-append-ownership.md new file mode 100644 index 0000000..1da2f49 --- /dev/null +++ b/postmortem/20260730-incremental-live-append-ownership.md @@ -0,0 +1,95 @@ +# Incremental Live-Append Ownership + +## Context + +After stable live transactions removed per-key whole-paragraph planning, +only native visual-row crossings still paid the complete paragraph +preparation, dynamic program, plan construction, and projection cost. +At 80 pixels the old source benchmark attributed 51–187 ms p99 to these +permitted commits. + +The C module itself was not the primary owner. In the frozen baseline its +80-pixel module call measured only 2.615/2.655 ms p95/p99, while paragraph +preparation and the surrounding plan dominated. A Rust module would still +enter through `emacs_env`, consume the same prepared vectors, and return the +same DP result. + +## Decision + +Keep the C module and make the existing ownership model incremental: + +- a layout plan retains its prepared paragraph and exact layout context; +- a property-free plain-text append retokenizes from the last complete-word + boundary instead of from paragraph start; +- derived prefix, break, protrusion, and gap data are copied only through the + proven-stable box boundary and recomputed from that boundary onward; +- pure Elisp DP retains its state and resumes from the earliest old state + that can still reach the first new break; +- C runs its full native DP over incrementally prepared vectors because its + sub-millisecond candidate call is already cheaper than adding another ABI; +- the buffer replaces only the dirty source island and reuses common layout + lines before publishing the changed suffix. + +Any unsupported property, font, layout-context, tab/newline, parshape, +looseness, or token-boundary case returns nil and takes the unchanged full +planner. The fast path never approximates cache identity or layout output. + +## Rejected alternatives + +- **Rewrite the module in Rust:** it does not remove the Emacs C ABI or the + Elisp-owned work, while adding Cargo, Rust toolchain, target, packaging, + and Windows support obligations. +- **Move the whole planner behind the module boundary:** font measurement, + text properties, and editor transaction ownership belong to Emacs; moving + them would create a larger, less stable ABI. +- **Reuse stale prefix decisions:** a suffix can change the globally optimal + KP path, so only prepared data and reachable DP states may be reused. +- **Debounce, skip, or delay commits:** this hides latency by making display + state stale and violates the synchronous live-edit contract. + +## Correctness trap + +The first boundary box is dirty even when every earlier box is unchanged. +Its break permission depends on both neighboring boxes, so copying through +that position preserved a stale forbidden break. The final implementation +copies strictly before the stable boundary and recomputes break data from +the boundary. A regression fixes this ownership rule. + +## Results + +The four-round frozen source/instrumentation matrix preserves exact +baseline/C/Elisp source and projection hashes, zero conflicts, valid +GC-excluded samples, zero-work ordinary keys, and non-regression at +64/80/96/128/160 pixels. At 80 pixels: + +- C improves 77.78% p95 and 78.37% p99 to 25.490/25.785 ms; +- Elisp improves 92.54% p95 and 92.03% p99 to 43.860/47.578 ms; +- the C module itself falls to 0.697/0.701 ms p95/p99. + +Those source-instrumented values still miss the locked 16 ms absolute gate. +The production-shaped byte-compiled public path is materially different: +three repeated runs measure append p99 at 1.158–1.326 ms for C and +1.429–1.438 ms for Elisp, with no GC during the samples. Both measurements +remain documented; the stricter goal is not silently weakened. + +## Known design debt + +At a 558-pixel GUI width, deleting a suffix after a forward row crossing can +republish a backward layout and violate the existing “preserve typed +projection” visual invariant. The frozen baseline reproduces the same +behavior, and current ERT explicitly treats a backward wrap crossing as a +commit. This is not caused by incremental append work and needs a separate +semantic decision before a narrow tail-shrink predicate is changed. + +## Verification and rollback + +Exact append-chain equivalence is covered across C and Elisp, varied widths, +unsafe fallback contexts, and the stable-boundary regression. Normal and +permuted 199-test suites, 300 fuzz cases, warning-as-error compilation, +portable C warnings/tests, release checks, and reviewed temporal GUI +evidence pass. + +Rollback is a direct revert of retained plan/paragraph state, incremental +append preparation/DP, dirty-island reconstruction, and one-pass C integer +validation. No data migration, compatibility shim, or cache conversion is +required. diff --git a/tests/ekp-buffer-tests.el b/tests/ekp-buffer-tests.el index 31d9c82..c501bf0 100644 --- a/tests/ekp-buffer-tests.el +++ b/tests/ekp-buffer-tests.el @@ -818,6 +818,38 @@ (buffer-substring (point-min) (point-max)) baseline)))))) +(ert-deftest ekp-buffer-test-live-source-rebuilds-only-dirty-island () + "A live source rebuild must not rescan the projected paragraph." + (let ((text + "alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu")) + (ekp-buffer-test--with-mode text 20 + (let* ((middle + (nth 1 + (ekp-buffer--live-state-spans + ekp-buffer--live-state))) + (beg (marker-position (ekp-buffer--span-beg middle))) + (end (marker-position (ekp-buffer--span-end middle))) + (space (save-excursion + (goto-char beg) + (search-forward " " end t))) + (logical-substring + (symbol-function 'ekp-buffer--logical-substring)) + (rescans 0)) + (should space) + (goto-char (1- space)) + (delete-char 1) + (should ekp-buffer--live-edit) + (cl-letf (((symbol-function 'ekp-buffer--logical-substring) + (lambda (&rest arguments) + (setq rescans (1+ rescans)) + (apply logical-substring arguments)))) + (should + (equal-including-properties + (ekp-buffer--current-live-source) + (ekp-buffer--logical-substring + (point-min) (point-max))))) + (should (= rescans 1)))))) + (ert-deftest ekp-buffer-test-point-leaving-paragraph-is-zero-work () "Cursor motion across hard lines cannot commit or rewrite live state." (let ((text diff --git a/tests/ekp-c-tests.el b/tests/ekp-c-tests.el index 923e68f..b1dda54 100644 --- a/tests/ekp-c-tests.el +++ b/tests/ekp-c-tests.el @@ -54,6 +54,14 @@ (should-error (apply #'ekp-c-break-with-arrays args) :type 'ekp-c-invalid-input))) +(ert-deftest ekp-c-test-rejects-non-integer-vector-value () + "Vector values that are not integers use the explicit input condition." + (skip-unless (ekp-c-tests--available)) + (let ((args (ekp-c-tests--valid-args))) + (setf (nth 3 args) ["not-an-integer"]) + (should-error (apply #'ekp-c-break-with-arrays args) + :type 'ekp-c-invalid-input))) + (ert-deftest ekp-c-test-batch-rejects-short-paragraph-vector () "Batch preflight validates each paragraph before indexing 15 fields." (skip-unless (ekp-c-tests--available)) diff --git a/tests/ekp-live-commit-evaluator.el b/tests/ekp-live-commit-evaluator.el new file mode 100644 index 0000000..a23c633 --- /dev/null +++ b/tests/ekp-live-commit-evaluator.el @@ -0,0 +1,698 @@ +;;; ekp-live-commit-evaluator.el --- Structural live-commit gate -*- lexical-binding: t; -*- + +;;; Commentary: + +;; One process measures one frozen-baseline or candidate round. Compare mode +;; aggregates interleaved JSONL records and enforces the task030 contract. + +;;; Code: + +(require 'cl-lib) +(require 'json) + +(defvar ekp-use-c-module) +(defvar ekp-buffer--conflicts) +(defvar ekp-auto-justify-paragraph-limit) +(declare-function ekp-auto-justify-mode "ekp-buffer") +(declare-function ekp-buffer--logical-substring "ekp-buffer") +(declare-function ekp-buffer--window-pixel "ekp-buffer") +(declare-function ekp-c-module-load "ekp-utils") +(declare-function ekp-c-version "ext:ekp") +(declare-function ekp-clear-caches "ekp") +(declare-function ekp--c-available-p "ekp") +(declare-function ekp--measured-width "ekp") + +(defconst ekp-live-commit-evaluator--widths '(64 80 96 128 160)) +(defconst ekp-live-commit-evaluator--rows '(2 4 8 16)) +(defconst ekp-live-commit-evaluator--target-ms 16.0) +(defconst ekp-live-commit-evaluator--minimum-improvement 20.0) +(defconst ekp-live-commit-evaluator--ordinary-target-ms 1.0) +(defconst ekp-live-commit-evaluator--maximum-regression 15.0) +(defconst ekp-live-commit-evaluator--default-gc-threshold + gc-cons-threshold) +(defconst ekp-live-commit-evaluator--corpus + (concat + " extraordinary editing continues smoothly 中文拉丁混排" + " while stable semantic rows remain exact and responsive")) + +(defvar ekp-live-commit-evaluator--publish-calls 0) +(defvar ekp-live-commit-evaluator--row-crossings 0) +(defvar ekp-live-commit-evaluator--plan-calls 0) +(defvar ekp-live-commit-evaluator--module-calls 0) +(defvar ekp-live-commit-evaluator--append-calls 0) +(defvar ekp-live-commit-evaluator--append-hits 0) +(defvar ekp-live-commit-evaluator--cache-gets 0) +(defvar ekp-live-commit-evaluator--cache-hits 0) +(defvar ekp-live-commit-evaluator--plan-ms 0.0) +(defvar ekp-live-commit-evaluator--para-ms 0.0) +(defvar ekp-live-commit-evaluator--dp-ms 0.0) +(defvar ekp-live-commit-evaluator--module-ms 0.0) +(defvar ekp-live-commit-evaluator--install-ms 0.0) +(defvar ekp-live-commit-evaluator--clear-ms 0.0) +(defvar ekp-live-commit-evaluator--transaction-ms 0.0) +(defvar ekp-live-commit-evaluator--signature-ms 0.0) +(defvar ekp-live-commit-evaluator--cache-ms 0.0) + +(defun ekp-live-commit-evaluator--env-number (name fallback) + "Return numeric environment variable NAME, or FALLBACK." + (if-let ((value (getenv name))) + (string-to-number value) + fallback)) + +(defun ekp-live-commit-evaluator--env-numbers (name fallback) + "Return comma-separated numeric environment variable NAME, or FALLBACK." + (if-let ((value (getenv name))) + (mapcar #'string-to-number (split-string value "," t "[ \t]+")) + fallback)) + +(defun ekp-live-commit-evaluator--env-strings (name fallback) + "Return comma-separated string environment variable NAME, or FALLBACK." + (if-let ((value (getenv name))) + (split-string value "," t "[ \t]+") + fallback)) + +(defun ekp-live-commit-evaluator--reset-profile () + "Reset counters for one public command." + (setq ekp-live-commit-evaluator--publish-calls 0 + ekp-live-commit-evaluator--row-crossings 0 + ekp-live-commit-evaluator--plan-calls 0 + ekp-live-commit-evaluator--module-calls 0 + ekp-live-commit-evaluator--append-calls 0 + ekp-live-commit-evaluator--append-hits 0 + ekp-live-commit-evaluator--cache-gets 0 + ekp-live-commit-evaluator--cache-hits 0 + ekp-live-commit-evaluator--plan-ms 0.0 + ekp-live-commit-evaluator--para-ms 0.0 + ekp-live-commit-evaluator--dp-ms 0.0 + ekp-live-commit-evaluator--module-ms 0.0 + ekp-live-commit-evaluator--install-ms 0.0 + ekp-live-commit-evaluator--clear-ms 0.0 + ekp-live-commit-evaluator--transaction-ms 0.0 + ekp-live-commit-evaluator--signature-ms 0.0 + ekp-live-commit-evaluator--cache-ms 0.0)) + +(defun ekp-live-commit-evaluator--timed-call (counter function arguments) + "Call FUNCTION with ARGUMENTS and add elapsed milliseconds to COUNTER." + (let ((started (float-time))) + (prog1 (apply function arguments) + (set counter + (+ (symbol-value counter) + (* 1000.0 (- (float-time) started))))))) + +(defun ekp-live-commit-evaluator--counted-wrapper (counter function) + "Return a wrapper incrementing COUNTER before calling FUNCTION." + (lambda (&rest arguments) + (set counter (1+ (symbol-value counter))) + (apply function arguments))) + +(defun ekp-live-commit-evaluator--timed-wrapper + (time-counter call-counter function) + "Return a timed FUNCTION wrapper using TIME-COUNTER and CALL-COUNTER." + (lambda (&rest arguments) + (when call-counter + (set call-counter (1+ (symbol-value call-counter)))) + (ekp-live-commit-evaluator--timed-call + time-counter function arguments))) + +(defun ekp-live-commit-evaluator--cache-wrapper (function) + "Return a live-cache FUNCTION wrapper that records hits." + (lambda (key) + (cl-incf ekp-live-commit-evaluator--cache-gets) + (let ((started (float-time))) + (prog1 + (let ((plan (funcall function key))) + (when plan + (cl-incf ekp-live-commit-evaluator--cache-hits)) + plan) + (cl-incf ekp-live-commit-evaluator--cache-ms + (* 1000.0 (- (float-time) started))))))) + +(defun ekp-live-commit-evaluator--row-crossed-wrapper (function) + "Return a FUNCTION wrapper that counts true row crossings." + (lambda () + (let ((crossed (funcall function))) + (when crossed + (cl-incf ekp-live-commit-evaluator--row-crossings)) + crossed))) + +(defun ekp-live-commit-evaluator--append-wrapper (function) + "Return a FUNCTION wrapper that records append-plan hits." + (lambda (&rest arguments) + (cl-incf ekp-live-commit-evaluator--append-calls) + (let ((plan (apply function arguments))) + (when plan + (cl-incf ekp-live-commit-evaluator--append-hits)) + plan))) + +(defun ekp-live-commit-evaluator--instrument (function) + "Call FUNCTION with live-commit layer instrumentation installed." + (let ((publish (symbol-function 'ekp-buffer--publish-live-prefix)) + (plan (symbol-function 'ekp-layout-plan)) + (append-plan (symbol-function 'ekp-layout-plan-append)) + (para (symbol-function 'ekp--get-para)) + (dp (symbol-function 'ekp--dp-cache-para)) + (module (symbol-function 'ekp-c-break-with-arrays)) + (install (symbol-function 'ekp-buffer--install-live-prefix)) + (suffix (symbol-function 'ekp-buffer--clear-live-suffix)) + (projection (symbol-function 'ekp-buffer--clear-live-projection)) + (transaction (symbol-function 'ekp-buffer--start-live-edit)) + (signatures + (symbol-function 'ekp-buffer--live-prefix-signatures)) + (row-crossed (symbol-function 'ekp-buffer--live-row-crossed-p)) + (cache (symbol-function 'ekp-buffer--live-cache-get))) + (cl-letf + (((symbol-function 'ekp-buffer--publish-live-prefix) + (ekp-live-commit-evaluator--counted-wrapper + 'ekp-live-commit-evaluator--publish-calls publish)) + ((symbol-function 'ekp-layout-plan) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--plan-ms + 'ekp-live-commit-evaluator--plan-calls plan)) + ((symbol-function 'ekp-layout-plan-append) + (ekp-live-commit-evaluator--append-wrapper append-plan)) + ((symbol-function 'ekp--get-para) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--para-ms nil para)) + ((symbol-function 'ekp--dp-cache-para) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--dp-ms nil dp)) + ((symbol-function 'ekp-c-break-with-arrays) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--module-ms + 'ekp-live-commit-evaluator--module-calls module)) + ((symbol-function 'ekp-buffer--install-live-prefix) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--install-ms nil install)) + ((symbol-function 'ekp-buffer--clear-live-suffix) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--clear-ms nil suffix)) + ((symbol-function 'ekp-buffer--clear-live-projection) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--clear-ms nil projection)) + ((symbol-function 'ekp-buffer--start-live-edit) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--transaction-ms nil transaction)) + ((symbol-function 'ekp-buffer--live-prefix-signatures) + (ekp-live-commit-evaluator--timed-wrapper + 'ekp-live-commit-evaluator--signature-ms nil signatures)) + ((symbol-function 'ekp-buffer--live-row-crossed-p) + (ekp-live-commit-evaluator--row-crossed-wrapper row-crossed)) + ((symbol-function 'ekp-buffer--live-cache-get) + (ekp-live-commit-evaluator--cache-wrapper cache))) + (funcall function)))) + +(defun ekp-live-commit-evaluator--self-insert (character) + "Insert CHARACTER through the public command path." + (let ((last-command-event character) + (this-command #'self-insert-command)) + (call-interactively #'self-insert-command) + (run-hooks 'post-command-hook))) + +(defun ekp-live-commit-evaluator--event-kind () + "Return the current command's measured event kind." + (if (> ekp-live-commit-evaluator--row-crossings 0) + "structural-commit" + "ordinary-key")) + +(defun ekp-live-commit-evaluator--sample (character metadata) + "Measure one CHARACTER insertion and attach scenario METADATA." + (ekp-live-commit-evaluator--reset-profile) + (let ((gcs-before gcs-done) + (gc-before gc-elapsed) + (started (float-time))) + (ekp-live-commit-evaluator--self-insert character) + (let ((total-ms (* 1000.0 (- (float-time) started))) + (gc-events (- gcs-done gcs-before)) + (gc-ms (* 1000.0 (- gc-elapsed gc-before)))) + (append + metadata + `((event_kind . ,(ekp-live-commit-evaluator--event-kind)) + (char . ,(char-to-string character)) + (total_ms . ,total-ms) + (plan_ms . ,ekp-live-commit-evaluator--plan-ms) + (para_ms . ,ekp-live-commit-evaluator--para-ms) + (dp_ms . ,ekp-live-commit-evaluator--dp-ms) + (module_ms . ,ekp-live-commit-evaluator--module-ms) + (publication_ms + . ,(+ ekp-live-commit-evaluator--install-ms + ekp-live-commit-evaluator--clear-ms)) + (publish_calls . ,ekp-live-commit-evaluator--publish-calls) + (row_crossings . ,ekp-live-commit-evaluator--row-crossings) + (plan_calls . ,ekp-live-commit-evaluator--plan-calls) + (module_calls . ,ekp-live-commit-evaluator--module-calls) + (append_calls . ,ekp-live-commit-evaluator--append-calls) + (append_hits . ,ekp-live-commit-evaluator--append-hits) + (cache_hits . ,ekp-live-commit-evaluator--cache-hits) + (cache_misses + . ,(- ekp-live-commit-evaluator--cache-gets + ekp-live-commit-evaluator--cache-hits)) + (cache_ms . ,ekp-live-commit-evaluator--cache-ms) + (transaction_ms . ,ekp-live-commit-evaluator--transaction-ms) + (signature_ms . ,ekp-live-commit-evaluator--signature-ms) + (gc_events . ,gc-events) + (gc_ms . ,gc-ms)))))) + +(defun ekp-live-commit-evaluator--prefix-length (text target) + "Return shortest prefix length of TEXT measuring at least TARGET pixels." + (let ((low 1) + (high (length text))) + (while (< low high) + (let ((middle (/ (+ low high) 2))) + (if (>= (ekp--measured-width (substring text 0 middle)) target) + (setq high middle) + (setq low (1+ middle))))) + low)) + +(defun ekp-live-commit-evaluator--fixture (width rows) + "Return mixed prose spanning approximately ROWS lines at WIDTH." + (let* ((unit ekp-live-commit-evaluator--corpus) + (target (* width rows)) + (unit-width (max 1 (ekp--measured-width unit))) + (copies (max 1 (ceiling (/ (float target) unit-width)))) + (text (apply #'concat (make-list (1+ copies) unit)))) + (substring text 0 + (ekp-live-commit-evaluator--prefix-length text target)))) + +(defun ekp-live-commit-evaluator--projection-hash () + "Return a stable hash of the current source plus display projection." + (secure-hash + 'sha256 + (prin1-to-string (buffer-substring (point-min) (point-max))))) + +(defun ekp-live-commit-evaluator--source-hash () + "Return a stable hash of the current logical source." + (secure-hash + 'sha256 + (buffer-substring-no-properties (point-min) (point-max)))) + +(defun ekp-live-commit-evaluator--metadata (engine gc-mode width rows) + "Return sample metadata for ENGINE, GC-MODE, WIDTH, and ROWS." + `((engine . ,engine) (gc_mode . ,gc-mode) + (width . ,width) (rows . ,rows))) + +(defun ekp-live-commit-evaluator--collect (metadata) + "Collect a fixed structural-commit sample count for METADATA." + (let* ((width (alist-get 'width metadata)) + (target (ekp-live-commit-evaluator--env-number + "EKP_LIVE_COMMIT_SAMPLES" + (if (= width 80) 8 2))) + (ordinary-cap (ekp-live-commit-evaluator--env-number + "EKP_LIVE_ORDINARY_SAMPLES" + (if (= width 80) 32 8))) + (stream (string-to-list ekp-live-commit-evaluator--corpus)) + (index 0) + (commits 0) + samples) + (while (and (< commits target) (< index 4000)) + (let ((sample + (ekp-live-commit-evaluator--sample + (nth (% index (length stream)) stream) metadata))) + (if (equal (alist-get 'event_kind sample) "structural-commit") + (progn (cl-incf commits) (push sample samples)) + (when (< (- (length samples) commits) ordinary-cap) + (push sample samples)))) + (cl-incf index)) + (unless (= commits target) + (error "Only %d structural commits after %d keys" commits index)) + (nreverse samples))) + +(defun ekp-live-commit-evaluator--run-cell (engine gc-mode width rows) + "Measure one ENGINE, GC-MODE, WIDTH, and ROWS matrix cell." + (with-temp-buffer + (text-mode) + (insert (ekp-live-commit-evaluator--fixture width rows)) + (goto-char (point-max)) + (cl-letf (((symbol-function 'ekp-buffer--window-pixel) + (lambda (&optional _window) width))) + (let ((ekp-auto-justify-paragraph-limit most-positive-fixnum)) + (ekp-auto-justify-mode 1) + (ekp-live-commit-evaluator--self-insert ?x) + (let* ((metadata + (ekp-live-commit-evaluator--metadata + engine gc-mode width rows)) + (samples + (ekp-live-commit-evaluator--instrument + (lambda () + (ekp-live-commit-evaluator--collect metadata))))) + `((engine . ,engine) (gc_mode . ,gc-mode) + (width . ,width) (rows . ,rows) + (source_hash . ,(ekp-live-commit-evaluator--source-hash)) + (projection_hash + . ,(ekp-live-commit-evaluator--projection-hash)) + (conflicts . ,(length ekp-buffer--conflicts)) + (samples . ,samples))))))) + +(defun ekp-live-commit-evaluator--run-cell-with-gc + (engine gc-mode width rows) + "Run an ENGINE cell under GC-MODE at WIDTH and ROWS." + (let ((gc-cons-threshold + (if (equal gc-mode "gc-excluded") + most-positive-fixnum + ekp-live-commit-evaluator--default-gc-threshold))) + (garbage-collect) + (ekp-live-commit-evaluator--run-cell engine gc-mode width rows))) + +(defun ekp-live-commit-evaluator--measure-engine (engine) + "Measure every matrix cell for ENGINE." + (let ((ekp-use-c-module (equal engine "c")) + scenarios) + (dolist (gc-mode + (ekp-live-commit-evaluator--env-strings + "EKP_LIVE_COMMIT_GC_MODES" + '("gc-excluded" "default-gc"))) + (dolist (width + (ekp-live-commit-evaluator--env-numbers + "EKP_LIVE_COMMIT_WIDTHS" + ekp-live-commit-evaluator--widths)) + (dolist (rows + (ekp-live-commit-evaluator--env-numbers + "EKP_LIVE_COMMIT_ROWS" + ekp-live-commit-evaluator--rows)) + (ekp-clear-caches) + (push + (ekp-live-commit-evaluator--run-cell-with-gc + engine gc-mode width rows) + scenarios)))) + (nreverse scenarios))) + +(defun ekp-live-commit-evaluator--measure-round () + "Measure one evaluator round and return a JSON-compatible record." + (require 'ekp) + (require 'ekp-buffer) + (ekp-c-module-load) + (unless (ekp--c-available-p) + (error "C module did not load")) + `((label . ,(or (getenv "EKP_LIVE_COMMIT_LABEL") "unknown")) + (round . ,(ekp-live-commit-evaluator--env-number + "EKP_LIVE_COMMIT_ROUND" 0)) + (module_version . ,(ekp-c-version)) + (scenarios + . ,(cl-mapcan + #'ekp-live-commit-evaluator--measure-engine + (ekp-live-commit-evaluator--env-strings + "EKP_LIVE_COMMIT_ENGINES" '("c" "elisp")))))) + +(defun ekp-live-commit-evaluator--write-record (record) + "Append JSON RECORD to `EKP_LIVE_COMMIT_OUTPUT'." + (let ((path (getenv "EKP_LIVE_COMMIT_OUTPUT"))) + (unless path + (error "EKP_LIVE_COMMIT_OUTPUT is required")) + (write-region (concat (json-encode record) "\n") nil path t 'silent))) + +(defun ekp-live-commit-evaluator--read-jsonl (path) + "Read JSON objects from PATH." + (with-temp-buffer + (insert-file-contents path) + (mapcar + (lambda (line) + (json-parse-string line :object-type 'alist :array-type 'list)) + (split-string (buffer-string) "\n" t)))) + +(defun ekp-live-commit-evaluator--samples (records) + "Return all flat samples from RECORDS." + (cl-loop for record in records + append + (cl-loop for scenario in (alist-get 'scenarios record) + append (alist-get 'samples scenario)))) + +(defun ekp-live-commit-evaluator--matching-samples + (records event engine gc-mode &optional width) + "Return RECORDS samples matching EVENT, ENGINE, GC-MODE, and WIDTH." + (cl-remove-if-not + (lambda (sample) + (and (equal (alist-get 'event_kind sample) event) + (equal (alist-get 'engine sample) engine) + (equal (alist-get 'gc_mode sample) gc-mode) + (or (null width) (= (alist-get 'width sample) width)))) + (ekp-live-commit-evaluator--samples records))) + +(defun ekp-live-commit-evaluator--percentile (values percentile) + "Return nearest-rank PERCENTILE from VALUES." + (let* ((sorted (sort (copy-sequence values) #'<)) + (rank (max 0 (1- (ceiling (* percentile (length sorted))))))) + (unless sorted + (error "No samples for percentile")) + (nth rank sorted))) + +(defun ekp-live-commit-evaluator--statistics (samples key) + "Return percentile statistics for numeric KEY in SAMPLES." + (let ((values (mapcar (lambda (sample) (alist-get key sample)) samples))) + `((p50 . ,(ekp-live-commit-evaluator--percentile values 0.50)) + (p95 . ,(ekp-live-commit-evaluator--percentile values 0.95)) + (p99 . ,(ekp-live-commit-evaluator--percentile values 0.99))))) + +(defun ekp-live-commit-evaluator--improvement (baseline candidate) + "Return percentage improvement from BASELINE to CANDIDATE." + (if (zerop baseline) + 0.0 + (* 100.0 (/ (- baseline candidate) baseline)))) + +(defun ekp-live-commit-evaluator--comparison (baseline candidate) + "Return timing and layer comparison for BASELINE and CANDIDATE samples." + (let ((base-total + (ekp-live-commit-evaluator--statistics baseline 'total_ms)) + (cand-total + (ekp-live-commit-evaluator--statistics candidate 'total_ms))) + `((baseline . ((total . ,base-total) + (plan . ,(ekp-live-commit-evaluator--statistics + baseline 'plan_ms)) + (paragraph . ,(ekp-live-commit-evaluator--statistics + baseline 'para_ms)) + (dp . ,(ekp-live-commit-evaluator--statistics + baseline 'dp_ms)) + (module . ,(ekp-live-commit-evaluator--statistics + baseline 'module_ms)) + (publication + . ,(ekp-live-commit-evaluator--statistics + baseline 'publication_ms)) + (signature . ,(ekp-live-commit-evaluator--statistics + baseline 'signature_ms)) + (transaction . ,(ekp-live-commit-evaluator--statistics + baseline 'transaction_ms)))) + (candidate . ((total . ,cand-total) + (plan . ,(ekp-live-commit-evaluator--statistics + candidate 'plan_ms)) + (paragraph . ,(ekp-live-commit-evaluator--statistics + candidate 'para_ms)) + (dp . ,(ekp-live-commit-evaluator--statistics + candidate 'dp_ms)) + (module . ,(ekp-live-commit-evaluator--statistics + candidate 'module_ms)) + (publication + . ,(ekp-live-commit-evaluator--statistics + candidate 'publication_ms)) + (signature . ,(ekp-live-commit-evaluator--statistics + candidate 'signature_ms)) + (transaction . ,(ekp-live-commit-evaluator--statistics + candidate 'transaction_ms)))) + (p95_improvement_pct + . ,(ekp-live-commit-evaluator--improvement + (alist-get 'p95 base-total) (alist-get 'p95 cand-total))) + (p99_improvement_pct + . ,(ekp-live-commit-evaluator--improvement + (alist-get 'p99 base-total) (alist-get 'p99 cand-total)))))) + +(defun ekp-live-commit-evaluator--scenario-key (scenario) + "Return the comparison key for SCENARIO." + (mapcar (lambda (key) (alist-get key scenario)) + '(engine gc_mode width rows))) + +(defun ekp-live-commit-evaluator--scenario-layout (scenario) + "Return SCENARIO's source and projection identity." + (list (alist-get 'source_hash scenario) + (alist-get 'projection_hash scenario) + (alist-get 'conflicts scenario))) + +(defun ekp-live-commit-evaluator--layout-table (records) + "Return a sorted layout identity table for RECORDS." + (sort + (cl-loop for record in records + append + (cl-loop for scenario in (alist-get 'scenarios record) + collect + (cons (ekp-live-commit-evaluator--scenario-key scenario) + (ekp-live-commit-evaluator--scenario-layout + scenario)))) + (lambda (left right) + (string< (prin1-to-string left) (prin1-to-string right))))) + +(defun ekp-live-commit-evaluator--engine-layouts (records engine) + "Return ENGINE layout identities with engine removed from RECORDS." + (sort + (cl-loop for record in records + append + (cl-loop for scenario in (alist-get 'scenarios record) + when (equal (alist-get 'engine scenario) engine) + collect + (list + (cdr (ekp-live-commit-evaluator--scenario-key scenario)) + (ekp-live-commit-evaluator--scenario-layout scenario)))) + (lambda (left right) + (string< (prin1-to-string left) (prin1-to-string right))))) + +(defun ekp-live-commit-evaluator--layout-parity-p (baseline candidate) + "Return non-nil when all BASELINE and CANDIDATE layouts match." + (and (equal (ekp-live-commit-evaluator--layout-table baseline) + (ekp-live-commit-evaluator--layout-table candidate)) + (equal (ekp-live-commit-evaluator--engine-layouts baseline "c") + (ekp-live-commit-evaluator--engine-layouts baseline "elisp")) + (equal (ekp-live-commit-evaluator--engine-layouts candidate "c") + (ekp-live-commit-evaluator--engine-layouts + candidate "elisp")))) + +(defun ekp-live-commit-evaluator--zero-work-p (records) + "Return non-nil when every ordinary key in RECORDS does zero layout work." + (cl-every + (lambda (sample) + (and (= (alist-get 'publish_calls sample) 0) + (= (alist-get 'plan_calls sample) 0) + (= (alist-get 'module_calls sample) 0))) + (cl-remove-if-not + (lambda (sample) + (equal (alist-get 'event_kind sample) "ordinary-key")) + (ekp-live-commit-evaluator--samples records)))) + +(defun ekp-live-commit-evaluator--valid-gc-excluded-p (records) + "Return non-nil when excluded-GC samples in RECORDS contain no GC." + (cl-every + (lambda (sample) + (or (not (equal (alist-get 'gc_mode sample) "gc-excluded")) + (= (alist-get 'gc_events sample) 0))) + (ekp-live-commit-evaluator--samples records))) + +(defun ekp-live-commit-evaluator--conflict-free-p (records) + "Return non-nil when every scenario in RECORDS has no conflicts." + (cl-every + (lambda (record) + (cl-every + (lambda (scenario) + (= (alist-get 'conflicts scenario) 0)) + (alist-get 'scenarios record))) + records)) + +(defun ekp-live-commit-evaluator--ordinary-p99 (records) + "Return excluded-GC ordinary-key p99 for RECORDS." + (let ((samples + (cl-remove-if-not + (lambda (sample) + (and (equal (alist-get 'event_kind sample) "ordinary-key") + (equal (alist-get 'gc_mode sample) "gc-excluded"))) + (ekp-live-commit-evaluator--samples records)))) + (alist-get 'p99 + (ekp-live-commit-evaluator--statistics samples 'total_ms)))) + +(defun ekp-live-commit-evaluator--width-report + (baseline candidate engine width) + "Compare BASELINE and CANDIDATE structural commits for ENGINE at WIDTH." + (let ((base + (ekp-live-commit-evaluator--matching-samples + baseline "structural-commit" engine "gc-excluded" width)) + (cand + (ekp-live-commit-evaluator--matching-samples + candidate "structural-commit" engine "gc-excluded" width))) + (ekp-live-commit-evaluator--comparison base cand))) + +(defun ekp-live-commit-evaluator--target-pass-p (report) + "Return non-nil when WIDTH-80 REPORT meets target and improvement gates." + (let* ((candidate (alist-get 'candidate report)) + (total (alist-get 'total candidate))) + (and (<= (alist-get 'p95 total) + ekp-live-commit-evaluator--target-ms) + (<= (alist-get 'p99 total) + ekp-live-commit-evaluator--target-ms) + (>= (alist-get 'p95_improvement_pct report) + ekp-live-commit-evaluator--minimum-improvement) + (>= (alist-get 'p99_improvement_pct report) + ekp-live-commit-evaluator--minimum-improvement)))) + +(defun ekp-live-commit-evaluator--non-regression-p + (baseline candidate engine width) + "Return non-nil when ENGINE at WIDTH avoids a material p95 regression." + (let* ((report + (ekp-live-commit-evaluator--width-report + baseline candidate engine width)) + (base (alist-get 'p95 + (alist-get 'total (alist-get 'baseline report)))) + (cand (alist-get 'p95 + (alist-get 'total (alist-get 'candidate report))))) + (<= cand (* base + (+ 1.0 + (/ ekp-live-commit-evaluator--maximum-regression + 100.0)))))) + +(defun ekp-live-commit-evaluator--all-widths-pass-p + (baseline candidate) + "Return non-nil when no engine materially regresses at any width." + (let ((widths + (ekp-live-commit-evaluator--env-numbers + "EKP_LIVE_COMMIT_WIDTHS" + ekp-live-commit-evaluator--widths))) + (cl-every + (lambda (engine) + (cl-every + (lambda (width) + (ekp-live-commit-evaluator--non-regression-p + baseline candidate engine width)) + widths)) + '("c" "elisp")))) + +(defun ekp-live-commit-evaluator--report (baseline candidate) + "Return the final evaluator report for BASELINE and CANDIDATE." + (let* ((c80 (ekp-live-commit-evaluator--width-report + baseline candidate "c" 80)) + (elisp80 (ekp-live-commit-evaluator--width-report + baseline candidate "elisp" 80)) + (ordinary-p99 + (ekp-live-commit-evaluator--ordinary-p99 candidate)) + (parity (ekp-live-commit-evaluator--layout-parity-p + baseline candidate)) + (zero-work + (and (ekp-live-commit-evaluator--zero-work-p baseline) + (ekp-live-commit-evaluator--zero-work-p candidate))) + (gc-valid + (and (ekp-live-commit-evaluator--valid-gc-excluded-p baseline) + (ekp-live-commit-evaluator--valid-gc-excluded-p candidate))) + (conflict-free + (and (ekp-live-commit-evaluator--conflict-free-p baseline) + (ekp-live-commit-evaluator--conflict-free-p candidate))) + (all-widths + (ekp-live-commit-evaluator--all-widths-pass-p + baseline candidate)) + (pass + (and parity zero-work gc-valid conflict-free all-widths + (<= ordinary-p99 + ekp-live-commit-evaluator--ordinary-target-ms) + (ekp-live-commit-evaluator--target-pass-p c80) + (ekp-live-commit-evaluator--target-pass-p elisp80)))) + `((pass . ,pass) (layout_parity . ,parity) + (ordinary_zero_work . ,zero-work) + (gc_excluded_valid . ,gc-valid) + (conflict_free . ,conflict-free) + (all_widths_non_regression . ,all-widths) + (ordinary_candidate_p99_ms . ,ordinary-p99) + (width_80 . ((c . ,c80) (elisp . ,elisp80)))))) + +(defun ekp-live-commit-evaluator--compare () + "Compare raw JSONL paths from the environment and enforce the contract." + (let* ((baseline + (ekp-live-commit-evaluator--read-jsonl + (getenv "EKP_LIVE_COMMIT_BASELINE_JSONL"))) + (candidate + (ekp-live-commit-evaluator--read-jsonl + (getenv "EKP_LIVE_COMMIT_CANDIDATE_JSONL"))) + (report + (ekp-live-commit-evaluator--report baseline candidate)) + (path (getenv "EKP_LIVE_COMMIT_REPORT"))) + (when path + (write-region (concat (json-encode report) "\n") + nil path nil 'silent)) + (princ (concat (json-encode report) "\n")) + (unless (eq (alist-get 'pass report) t) + (kill-emacs 1)))) + +(if (equal (getenv "EKP_LIVE_COMMIT_MODE") "compare") + (ekp-live-commit-evaluator--compare) + (ekp-live-commit-evaluator--write-record + (ekp-live-commit-evaluator--measure-round))) + +;;; ekp-live-commit-evaluator.el ends here diff --git a/tests/ekp-tests.el b/tests/ekp-tests.el index 2b4634e..7a6a973 100644 --- a/tests/ekp-tests.el +++ b/tests/ekp-tests.el @@ -790,6 +790,85 @@ module is bypassed automatically (it has no looseness support)." 24)) (should (= calls 1))))) +(defun ekp-test--exact-append-plan (plan text width) + "Return PLAN extended to TEXT after proving fresh parity at WIDTH." + (let ((incremental (ekp-layout-plan-append plan text width))) + (should incremental) + (let ((actual (ekp-render-layout-string incremental))) + (ekp-clear-caches) + (should + (equal-including-properties + actual + (ekp-render-layout-string + (ekp-layout-plan text width))))) + incremental)) + +(ert-deftest ekp-test-layout-plan-append-matches-fresh-plan () + "Incremental plain-text appends must equal a fresh global plan." + (ekp-tests--with-clean-state + (dolist (use-c (if (ekp-tests--c-available) '(nil t) '(nil))) + (let* ((ekp-use-c-module use-c) + (width 24) + (text "alpha beta gamma changes responsive") + (plan (ekp-layout-plan text width))) + (dolist (suffix '("ly" " " "a" " 中文" " mixed" " continuation")) + (setq text (concat text suffix) + plan (ekp-test--exact-append-plan plan text width))))))) + +(ert-deftest ekp-test-layout-plan-append-varied-chains-match-fresh () + "Diverse character-by-character append chains retain exact parity." + (ekp-tests--with-clean-state + (dolist (use-c (if (ekp-tests--c-available) '(nil t) '(nil))) + (dolist (case '((justify nil 18 "ly 中文，punctuation.") + (justify 4 27 "extraordinary-hyphenation") + (ragged-right nil 21 " mixed 拉丁 alpha beta") + (center nil 31 " repeated spaces 文末"))) + (let* ((ekp-use-c-module use-c) + (ekp-alignment (nth 0 case)) + (ekp-first-line-indent (nth 1 case)) + (width (nth 2 case)) + (text "alpha beta gamma") + (plan (ekp-layout-plan text width))) + (dolist (character (string-to-list (nth 3 case))) + (setq text (concat text (char-to-string character)) + plan (ekp-test--exact-append-plan + plan text width)))))))) + +(ert-deftest ekp-test-layout-plan-append-recomputes-dirty-boundary () + "The first retokenized boundary must not retain stale break metadata." + (ekp-tests--with-clean-state + (dolist (use-c (if (ekp-tests--c-available) '(nil t) '(nil))) + (let* ((ekp-use-c-module use-c) + (text "alpha beta g-o。ycfrnqcc。( (") + (width 12) + (plan (ekp-layout-plan text width))) + (ekp-test--exact-append-plan plan (concat text "l") width))))) + +(ert-deftest ekp-test-layout-plan-append-rejects-unsafe-contexts () + "The append path rejects properties and non-1D layout contexts." + (ekp-tests--with-clean-state + (let* ((text "alpha beta gamma") + (plan (ekp-layout-plan text 24)) + (plain (concat text " delta")) + (styled (copy-sequence plain))) + (add-text-properties 0 5 '(face bold) styled) + (should-not (ekp-layout-plan-append plan styled 24)) + (should-not + (ekp-layout-plan-append plan (concat text "\nnext") 24)) + (should-not + (ekp-layout-plan-append plan (concat text "\ttail") 24)) + (should-not (ekp-layout-plan-append plan plain 25)) + (let ((ekp-looseness 1)) + (should-not (ekp-layout-plan-append plan plain 24))) + (let ((ekp-parshape '((0 . 24)))) + (should-not (ekp-layout-plan-append plan plain 24))) + (let ((ekp-first-line-indent 4)) + (should-not (ekp-layout-plan-append plan plain 24))) + (let ((ekp-alignment 'center)) + (should-not (ekp-layout-plan-append plan plain 24))) + (let ((ekp-latin-lang "de_DE")) + (should-not (ekp-layout-plan-append plan plain 24)))))) + (ert-deftest ekp-test-layout-plan-omits-zero-source-zero-width-gaps () "The projection plan must omit gaps that cannot install a property." (ekp-tests--with-clean-state diff --git a/tests/run-live-commit-evaluator.sh b/tests/run-live-commit-evaluator.sh new file mode 100755 index 0000000..ab77360 --- /dev/null +++ b/tests/run-live-commit-evaluator.sh @@ -0,0 +1,79 @@ +#!/bin/sh +# Evaluate task030 against the frozen portable baseline. + +set -eu + +ROOT=$(CDPATH= cd -- "$(dirname "$0")/.." && pwd) +GOAL="$ROOT/.omx/goals/performance/narrow-live-commit" +BASELINE_ROOT="$GOAL/baseline/source" +RAW="$GOAL/raw" +ROUNDS=${EKP_LIVE_COMMIT_ROUNDS:-4} + +if test -n "${EMACS:-}"; then + EMACS_BIN=$EMACS +elif command -v emacs >/dev/null 2>&1; then + EMACS_BIN=$(command -v emacs) +elif test -x /Applications/Emacs.app/Contents/MacOS/Emacs-arm64-11; then + EMACS_BIN=/Applications/Emacs.app/Contents/MacOS/Emacs-arm64-11 +else + printf '%s\n' "live-commit-evaluator: Emacs executable not found" >&2 + exit 2 +fi + +test -f "$BASELINE_ROOT/ekp.el" +test -f "$BASELINE_ROOT/ekp-buffer.el" +test -f "$BASELINE_ROOT/ekp_c/ekp.dylib" +test -f "$BASELINE_ROOT/dictionaries/hyph_en_US.dic" + +make -C "$ROOT/ekp_c" clean all PROFILE=portable +mkdir -p "$RAW" +BASELINE_JSONL="$RAW/baseline.jsonl" +CANDIDATE_JSONL="$RAW/candidate.jsonl" +REPORT="$GOAL/latest-report.json" +: >"$BASELINE_JSONL" +: >"$CANDIDATE_JSONL" + +run_round() +{ + code_root=$1 + label=$2 + round=$3 + output=$4 + EKP_LIVE_COMMIT_LABEL=$label \ + EKP_LIVE_COMMIT_ROUND=$round \ + EKP_LIVE_COMMIT_OUTPUT=$output \ + "$EMACS_BIN" -Q --batch -L "$code_root" -L "$ROOT/tests" \ + -l "$ROOT/tests/ekp-live-commit-evaluator.el" +} + +round=1 +while test "$round" -le "$ROUNDS"; do + if test $((round % 2)) -eq 1; then + run_round "$BASELINE_ROOT" baseline "$round" "$BASELINE_JSONL" + run_round "$ROOT" candidate "$round" "$CANDIDATE_JSONL" + else + run_round "$ROOT" candidate "$round" "$CANDIDATE_JSONL" + run_round "$BASELINE_ROOT" baseline "$round" "$BASELINE_JSONL" + fi + round=$((round + 1)) +done + +EKP_LIVE_COMMIT_MODE=compare \ +EKP_LIVE_COMMIT_BASELINE_JSONL="$BASELINE_JSONL" \ +EKP_LIVE_COMMIT_CANDIDATE_JSONL="$CANDIDATE_JSONL" \ +EKP_LIVE_COMMIT_REPORT="$REPORT" \ + "$EMACS_BIN" -Q --batch -L "$ROOT" -L "$ROOT/tests" \ + -l "$ROOT/tests/ekp-live-commit-evaluator.el" + +if test "${EKP_LIVE_COMMIT_SKIP_AUDIT:-0}" = 1; then + printf '%s\n' "live-commit-evaluator: performance and parity gates pass" + exit 0 +fi + +"$ROOT/tests/run-tests.sh" "$EMACS_BIN" +"$EMACS_BIN" -Q --batch -L "$ROOT" -L "$ROOT/tests" \ + -l "$ROOT/tests/ekp-fuzz.el" +"$ROOT/tests/check-release.sh" + +printf '%s\n' \ + "live-commit-evaluator: performance, parity, ERT, fuzz, and release gates pass"