geekinney/etaf-playground
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

perf: isolate latency gate from regression load

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-26 00:10:17 +08:00
parent 7eaee90798
commit cbbd5122ba
4 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile
View File

@ -63,9 +63,11 @@ perf-regressions:
$(MAKE) -C ../etaf-sqlite test EMACS="$(EMACS)" $(MAKE) -C ../etaf-sqlite test EMACS="$(EMACS)"
$(MAKE) test EMACS="$(EMACS)" $(MAKE) test EMACS="$(EMACS)"
# Measure absolute latency before the CPU-heavy regression graph. Regressions
# still gate the same target, but cannot thermally contaminate product samples.
perf-check: perf-check:
$(MAKE) perf-regressions EMACS="$(EMACS)"
$(MAKE) perf-evaluator EMACS="$(EMACS)" $(MAKE) perf-evaluator EMACS="$(EMACS)"
$(MAKE) perf-regressions EMACS="$(EMACS)"
load: compile load: compile
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-playground))' \ $(EMACS) -Q --batch $(LOAD_PATH) --eval '(require (quote etaf-playground))' \

20
etaf-playground.el
View File

@ -333,7 +333,7 @@ rejecting executable forms and private runtime heads."
(defun etaf-playground--file-content (file session extension) (defun etaf-playground--file-content (file session extension)
"Return FILE content, preferring SESSION's unsaved EXTENSION buffer." "Return FILE content, preferring SESSION's unsaved EXTENSION buffer."
(if-let ((buffer (etaf-playground--source-buffer session extension))) (if-let* ((buffer (etaf-playground--source-buffer session extension)))
(with-current-buffer buffer (with-current-buffer buffer
(buffer-substring-no-properties (point-min) (point-max))) (buffer-substring-no-properties (point-min) (point-max)))
(with-temp-buffer (with-temp-buffer
@ -485,7 +485,7 @@ only file evaluated by the framework."
SESSION supplies authoritative source buffers. MOUNT-OPTIONS is forwarded to SESSION supplies authoritative source buffers. MOUNT-OPTIONS is forwarded to
`etaf-mount'. The caller owns the complete framework render burst." `etaf-mount'. The caller owns the complete framework render burst."
(let ((buffer (get-buffer-create buffer-name))) (let ((buffer (get-buffer-create buffer-name)))
(when-let ((runtime (etaf-runtime-for-buffer buffer))) (when-let* ((runtime (etaf-runtime-for-buffer buffer)))
(with-current-buffer buffer (with-current-buffer buffer
(etaf-unmount runtime))) (etaf-unmount runtime)))
;; Root factories and lifecycle callbacks are application code. Run them ;; Root factories and lifecycle callbacks are application code. Run them
@ -532,7 +532,7 @@ public framework render burst so GC cannot split an interactive mount."
(let ((preview (etaf-playground-session-preview-buffer session))) (let ((preview (etaf-playground-session-preview-buffer session)))
(condition-case err (condition-case err
(progn (progn
(when-let ((runtime (etaf-runtime-for-buffer preview))) (when-let* ((runtime (etaf-runtime-for-buffer preview)))
(with-current-buffer preview (with-current-buffer preview
(etaf-unmount runtime))) (etaf-unmount runtime)))
(with-current-buffer preview (with-current-buffer preview
@ -644,7 +644,7 @@ the preview instead of destroying the source workspace."
" ETAF Source " " ETAF Source "
(mapconcat (mapconcat
(lambda (extension) (lambda (extension)
(when-let ((buffer (etaf-playground--source-buffer (when-let* ((buffer (etaf-playground--source-buffer
session extension))) session extension)))
(let* ((active (equal extension (let* ((active (equal extension
(etaf-playground-session-active-extension (etaf-playground-session-active-extension
@ -695,7 +695,7 @@ the preview instead of destroying the source workspace."
(position (posn-point start))) (position (posn-point start)))
(when (and (window-live-p window) (integer-or-marker-p position)) (when (and (window-live-p window) (integer-or-marker-p position))
(with-current-buffer (window-buffer window) (with-current-buffer (window-buffer window)
(when-let ((extension (when-let* ((extension
(get-text-property position (get-text-property position
'etaf-playground-extension))) 'etaf-playground-extension)))
(etaf-playground-switch-source extension)))))) (etaf-playground-switch-source extension))))))
@ -720,7 +720,7 @@ the preview instead of destroying the source workspace."
(defun etaf-playground--source-example-name (&optional buffer) (defun etaf-playground--source-example-name (&optional buffer)
"Return the discovered example name owning BUFFER's source file." "Return the discovered example name owning BUFFER's source file."
(when-let ((file (buffer-file-name (or buffer (current-buffer))))) (when-let* ((file (buffer-file-name (or buffer (current-buffer)))))
(let ((file (file-truename file))) (let ((file (file-truename file)))
(cl-loop for spec in etaf-playground-scenario-manifest (cl-loop for spec in etaf-playground-scenario-manifest
for name = (plist-get spec :pair) for name = (plist-get spec :pair)
@ -758,7 +758,7 @@ the preview instead of destroying the source workspace."
(user-error "No live ETAF Playground source %s" extension)) (user-error "No live ETAF Playground source %s" extension))
(setf (etaf-playground-session-active-extension session) extension) (setf (etaf-playground-session-active-extension session) extension)
(etaf-playground--refresh-source-headers session) (etaf-playground--refresh-source-headers session)
(when-let ((window (etaf-playground--source-window session))) (when-let* ((window (etaf-playground--source-window session)))
(set-window-buffer window buffer) (set-window-buffer window buffer)
(select-window window)) (select-window window))
buffer)) buffer))
@ -955,7 +955,7 @@ default example there."
(defun etaf-playground-reset (&optional target) (defun etaf-playground-reset (&optional target)
"Refresh TARGET's workspace or remount its direct preview." "Refresh TARGET's workspace or remount its direct preview."
(interactive) (interactive)
(if-let ((session (etaf-playground--session-for-target target))) (if-let* ((session (etaf-playground--session-for-target target)))
(etaf-playground-refresh session) (etaf-playground-refresh session)
(let* ((buffer (cond ((bufferp target) target) (let* ((buffer (cond ((bufferp target) target)
((stringp target) (get-buffer target)) ((stringp target) (get-buffer target))
@ -971,7 +971,7 @@ default example there."
(defun etaf-playground-close (&optional target) (defun etaf-playground-close (&optional target)
"Close TARGET's workspace, or unmount and kill a direct preview buffer." "Close TARGET's workspace, or unmount and kill a direct preview buffer."
(interactive) (interactive)
(if-let ((session (etaf-playground--session-for-target target))) (if-let* ((session (etaf-playground--session-for-target target)))
(let* ((preview (etaf-playground-session-preview-buffer session)) (let* ((preview (etaf-playground-session-preview-buffer session))
(preview-window (preview-window
(etaf-playground-session-preview-window session)) (etaf-playground-session-preview-window session))
@ -982,7 +982,7 @@ default example there."
(window-frame preview-window))) (window-frame preview-window)))
(configuration (configuration
(etaf-playground-session-previous-window-configuration session))) (etaf-playground-session-previous-window-configuration session)))
(when-let ((runtime (and (buffer-live-p preview) (when-let* ((runtime (and (buffer-live-p preview)
(etaf-runtime-for-buffer preview)))) (etaf-runtime-for-buffer preview))))
(with-current-buffer preview (with-current-buffer preview
(etaf-unmount runtime))) (etaf-unmount runtime)))

14
examples/research-shelf.el
View File

@ -332,7 +332,7 @@ user's prior local additions cannot collide with the generated dataset."
(defun etaf-research-shelf--update-selected (model fields message) (defun etaf-research-shelf--update-selected (model fields message)
"Update selected MODEL record with FIELDS and show MESSAGE." "Update selected MODEL record with FIELDS and show MESSAGE."
(when-let ((row (etaf-research-shelf--selected model))) (when-let* ((row (etaf-research-shelf--selected model)))
(etaf-research-shelf--mutate (etaf-research-shelf--mutate
model 'update model 'update
(append (list :id (plist-get row :id)) fields) (append (list :id (plist-get row :id)) fields)
@ -387,7 +387,7 @@ user's prior local additions cannot collide with the generated dataset."
(etaf-action-define etaf-research-shelf-star (runtime model) (etaf-action-define etaf-research-shelf-star (runtime model)
"Toggle the selected reading's star." "Toggle the selected reading's star."
(ignore runtime) (ignore runtime)
(when-let ((current (etaf-research-shelf--selected model))) (when-let* ((current (etaf-research-shelf--selected model)))
(let ((starred (= 1 (or (plist-get current :starred) 0)))) (let ((starred (= 1 (or (plist-get current :starred) 0))))
(etaf-research-shelf--update-selected (etaf-research-shelf--update-selected
model (list :starred (if starred 0 1) :updated "Just now") model (list :starred (if starred 0 1) :updated "Just now")
@ -552,24 +552,24 @@ user's prior local additions cannot collide with the generated dataset."
:color (etaf-theme-token :accent)) :color (etaf-theme-token :accent))
(text :face 'bold (text :face 'bold
(expr :value (expr :value
(if-let ((row (etaf-research-shelf--selected model))) (if-let* ((row (etaf-research-shelf--selected model)))
(plist-get row :title) (plist-get row :title)
"Choose a record"))) "Choose a record")))
(text :color (etaf-theme-token :muted) (text :color (etaf-theme-token :muted)
(expr :value (expr :value
(if-let ((row (etaf-research-shelf--selected model))) (if-let* ((row (etaf-research-shelf--selected model)))
(format "%s · %s" (plist-get row :author) (format "%s · %s" (plist-get row :author)
(plist-get row :kind)) (plist-get row :kind))
"Select one row to inspect it."))) "Select one row to inspect it.")))
(spacer :height 1) (spacer :height 1)
(text :face 'bold (text :face 'bold
(expr :value (expr :value
(if-let ((row (etaf-research-shelf--selected model))) (if-let* ((row (etaf-research-shelf--selected model)))
(etaf-research-shelf--status-label (plist-get row :status)) (etaf-research-shelf--status-label (plist-get row :status))
"○ No selection"))) "○ No selection")))
(text (text
(expr :value (expr :value
(if-let ((row (etaf-research-shelf--selected model))) (if-let* ((row (etaf-research-shelf--selected model)))
(format "Progress %d%% · Priority %s" (format "Progress %d%% · Priority %s"
(or (plist-get row :progress) 0) (or (plist-get row :progress) 0)
(plist-get row :priority)) (plist-get row :priority))
@ -584,7 +584,7 @@ user's prior local additions cannot collide with the generated dataset."
(spacer :height 1) (spacer :height 1)
(text :color (etaf-theme-token :muted) (text :color (etaf-theme-token :muted)
(expr :value (expr :value
(if-let ((row (etaf-research-shelf--selected model))) (if-let* ((row (etaf-research-shelf--selected model)))
(concat "“" (or (plist-get row :note) "No note yet.") "”") (concat "“" (or (plist-get row :note) "No note yet.") "”")
"Your notes and actions will appear here."))) "Your notes and actions will appear here.")))
(spacer :height 1) (spacer :height 1)

15
tests/etaf-playground-tests.el
View File

@ -145,6 +145,21 @@ database and mounts a test buffer before running BODY."
"$(MAKE) -C ../etaf-sqlite compile")) "$(MAKE) -C ../etaf-sqlite compile"))
(should (string-match-p (regexp-quote dependency) makefile))))) (should (string-match-p (regexp-quote dependency) makefile)))))
(ert-deftest etaf-playground-performance-gate-runs-before-regressions ()
"CPU-heavy regressions must not contaminate absolute latency samples."
(let* ((makefile (with-temp-buffer
(insert-file-contents "Makefile")
(buffer-string)))
(target (string-match "^perf-check:" makefile))
(evaluator (and target
(string-match "perf-evaluator" makefile target)))
(regressions (and target
(string-match "perf-regressions" makefile target))))
(should target)
(should evaluator)
(should regressions)
(should (< evaluator regressions))))
(ert-deftest etaf-playground-static-reader-is-inert-and-strict () (ert-deftest etaf-playground-static-reader-is-inert-and-strict ()
"Read pair structure as inert data and reject executable AST nodes." "Read pair structure as inert data and reject executable AST nodes."
(let* ((form (etaf-playground-read-static "research-shelf")) (let* ((form (etaf-playground-read-static "research-shelf"))