TUI: fix frozen spinner during streaming (coalesce token reflows)
ober
da3e7d9eb3ff628d0f937a3722caf3013b4c7161
--- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -894,15 +894,46 @@ (send-agent-event! (cons gen ev))) (def (drain-agent-events! state) - "Drain all pending agent events from the main thread's mailbox. - Apply them to state synchronously. Returns the number drained." - (let loop ((n 0)) + "Drain all pending agent events from the main thread's mailbox and apply + them synchronously. Consecutive stream-token events of the current + generation are COALESCED into one update: each token's buffer is + cumulative, so applying the concatenation of a run is identical to applying + them one by one — but it reflows the assistant block once per drain instead + of once per token. That removes the streaming O(n^2) reflow that saturated + the main thread and froze the spinner (tick advances once per loop + iteration; under a token flood the old drain never returned). Returns the + number of raw events drained." + (let collect ((evs '()) (n 0)) (let ((ev (guard (e (#t 'EMPTY)) (thread-receive 0)))) (if (eq? ev 'EMPTY) - n - (begin - (apply-agent-event! state ev) - (loop (+ n 1))))))) + (begin (apply-agent-events! state (reverse evs)) n) + (collect (cons ev evs) (+ n 1)))))) + +(def (stream-token-event? ev gen) + ;; #t when EV is a current-generation streaming token: (gen stream-token tok). + (and (pair? ev) (eqv? (car ev) gen) + (let ((body (cdr ev))) + (and (pair? body) (eq? (car body) 'stream-token))))) + +(def (apply-agent-events! state evs) + ;; Apply a drained event list in order, merging maximal runs of + ;; current-generation stream-token events into a single tui-stream-token! + ;; call (one reflow for the whole run). Non-token events — and stale-gen + ;; tokens — go through apply-agent-event! unchanged. + (let ((gen (tui-run-gen))) + (let loop ((evs evs)) + (cond + ((null? evs) (void)) + ((stream-token-event? (car evs) gen) + (let run ((evs evs) (toks '())) + (if (and (pair? evs) (stream-token-event? (car evs) gen)) + (run (cdr evs) (cons (caddr (car evs)) toks)) + (begin + (tui-stream-token! state (apply string-append (reverse toks))) + (loop evs))))) + (else + (apply-agent-event! state (car evs)) + (loop (cdr evs))))))) (def (apply-agent-event! state ev) ;; New-style events are (gen . body). Drop stale generations silently. @@ -1512,6 +1543,24 @@ (for-each (lambda (m) (reflow-message! m w)) (app-state-messages state)))) +;; Width at which the message blocks were last wrapped. draw-messages! checks +;; this and re-wraps when the usable width has changed since. +(def *last-reflow-width* (make-parameter #f)) + +(def (ensure-reflow-width! state) + ;; Re-wrap guard, run at draw time on the main thread. Every reflow — the + ;; per-token streaming update (via drain-agent-events!) and resize / sidebar + ;; toggle — now runs on the main thread, so a block can only drift from the + ;; width we draw at when the usable width itself changes (resize or sidebar + ;; show/hide). Re-wrap every block when that happens; this guarantees the + ;; wrap width always matches the draw width, so render-msg-block! never + ;; hard-clips a word mid-stream ("review fo" instead of wrapping "review + ;; for"). Cheap: fires only on an actual width change, never per frame. + (let ((w (msg-area-width state))) + (unless (eqv? w (*last-reflow-width*)) + (reflow-all! state) + (*last-reflow-width* w)))) + ;; ---- Sidebar updates ---- (def (update-sidebar-tools! state) @@ -1592,6 +1641,7 @@ (toast-render! (app-state-width state) (app-state-height state))))) (def (draw-messages! state) + (ensure-reflow-width! state) (let* ((x (msg-area-x state)) (y (msg-area-y state)) (w (msg-area-width state))