Fix repomap stalls and show active tools
ober
10b20fbda56cb0ce3f4ffdea3f1ae1f759cc29df
--- a/src/jcode/core/repomap.ss +++ b/src/jcode/core/repomap.ss @@ -298,6 +298,8 @@ (def (collect-file-refs file defining-file) ;; Scan FILE once, return distinct target-files whose defined ;; symbols appear in FILE (excluding FILE's own definitions). + ;; Do not iterate over every known symbol for every source line; large + ;; repos can have thousands of symbols, which makes repomap CPU-bound. (let ((seen (make-hash-table))) (try (call-with-input-file file @@ -305,17 +307,40 @@ (let loop () (let ((line (get-line p))) (unless (eof-object? line) - (hash-for-each - (lambda (sym owner) - (when (and (not (equal? owner file)) - (not (hash-ref seen owner #f)) - (string-contains line sym)) - (hash-put! seen owner #t))) - defining-file) + (scan-line-refs! line file defining-file seen) (loop)))))) (catch (e) #f)) (hash-keys seen))) +(def (scan-line-refs! line file defining-file seen) + (let* ((n (string-length line))) + (let emit ((i 0) (start #f)) + (cond + ((>= i n) + (when start + (record-token-ref! line start i file defining-file seen))) + ((repomap-token-char? (string-ref line i)) + (emit (+ i 1) (or start i))) + (start + (record-token-ref! line start i file defining-file seen) + (emit (+ i 1) #f)) + (else + (emit (+ i 1) #f)))))) + +(def (record-token-ref! line start end file defining-file seen) + (when (>= (- end start) 3) + (let* ((tok (substring line start end)) + (owner (hash-get defining-file tok))) + (when (and owner + (not (equal? owner file)) + (not (hash-ref seen owner #f))) + (hash-put! seen owner #t))))) + +(def (repomap-token-char? c) + (or (char-alphabetic? c) + (char-numeric? c) + (member c '(#\_ #\- #\? #\! #\* #\/ #\< #\> #\= #\+ #\% #\$ #\. #\:)))) + (def (pagerank nodes out-edges damping iterations) (let* ((n (length nodes)) (init (if (= n 0) 0 (/ 1.0 n))) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -134,6 +134,7 @@ sidebar ;; sidebar-state dialog ;; #f or active dialog tool-counts ;; hash-table: name → count + active-tools ;; list of tool names currently executing sysmon ;; system utilization sampler memstats ;; local-model RAM breakdown sampler tabs ;; list of tab (snapshots; active tab's slot is stale) @@ -182,6 +183,7 @@ (make-fresh-sidebar) #f ;; dialog (make-hash-table) + '() ;; active tools mon mem '() ;; tabs (lazily seeded on first switch) @@ -562,7 +564,8 @@ (app-state-cache-read-set! state 0) (app-state-cache-creation-set! state 0) (app-state-cost-set! state 0.0) - (app-state-tool-counts-set! state (make-hash-table)))) + (app-state-tool-counts-set! state (make-hash-table)) + (app-state-active-tools-set! state '()))) ((equal? cmd "tools") (add-message! state (msg-block-system (string-append "Tools: " (string-join (list-tools) ", "))))) @@ -997,11 +1000,13 @@ (tui-log "apply-agent-event: agent-error ~a" msg) (add-message! state (msg-block-error msg)) (app-state-agent-busy?-set! state #f) + (app-state-active-tools-set! state '()) (app-state-dirty?-set! state #t)) ((list 'agent-done) (tui-log "apply-agent-event: agent-done") ;; Clear busy FIRST: a finalize error must never leave the spinner stuck. (app-state-agent-busy?-set! state #f) + (app-state-active-tools-set! state '()) (guard (e (#t (log-debug "tui" (format "agent-done finalize ERROR: ~a" (with-output-to-string (lambda () (display-condition e))))))) @@ -1012,6 +1017,7 @@ (tui-log "apply-agent-event: agent-cancelled") (add-message! state (msg-block-system "(interrupted)")) (app-state-agent-busy?-set! state #f) + (app-state-active-tools-set! state '()) (app-state-dirty?-set! state #t)) ((list 'ask-result provider result) (tui-log "apply-agent-event: ask-result ~a" provider) @@ -1060,6 +1066,7 @@ (def (run-agent! state text) (app-state-agent-busy?-set! state #t) (app-state-stream-buf-set! state "") + (app-state-active-tools-set! state '()) (set-car! *tui-stream-abort* #f) (bump-tui-run-gen!) ;; Add empty assistant message that will be filled by streaming @@ -1501,11 +1508,22 @@ ;; Track tool counts in sidebar only — no inline message block (let ((tc (app-state-tool-counts state))) (hash-put! tc name (+ 1 (or (hash-get tc name) 0)))) + (app-state-active-tools-set! state + (cons name (app-state-active-tools state))) (update-sidebar-tools! state) (app-state-dirty?-set! state #t)) ((end) + (app-state-active-tools-set! state + (remove-one-string name (app-state-active-tools state))) (app-state-dirty?-set! state #t)))) +(def (remove-one-string name items) + (let loop ((rest items) (acc '())) + (cond + ((null? rest) (reverse acc)) + ((equal? (car rest) name) (append (reverse acc) (cdr rest))) + (else (loop (cdr rest) (cons (car rest) acc)))))) + (def (tui-escalation! state prov model reason sentinel?) "An expert model was called. Finalize the primary reply, then open a distinctly-coloured 'expert block headed by an escalation notice; the @@ -1790,7 +1808,12 @@ (bg (face-bg-attr 'default)) (y (agent-status-y state)) (w (msg-area-width state)) - (text (string-append " " frame " thinking..."))) + (active (app-state-active-tools state)) + (label (if (pair? active) + (format "running ~a..." (car active)) + "thinking...")) + (text (string-append " " frame " " + (fit-spinner-label label (max 0 (- w 3)))))) ;; Dedicated status row, so clearing it never touches the message area. (let clear ((col 0)) (when (< col w) @@ -1798,6 +1821,16 @@ (clear (+ col 1)))) (tb-print! 0 y fg bg text))) +(def (fit-spinner-label label width) + (cond + ((<= width 0) "") + ((<= (string-length label) width) label) + ((<= width 1) "…") + (else + (string-append + (substring label 0 (- width 1)) + "…")))) + (def (make-prompt-text) (let ((model (or (current-model-override) (config-model) "?"))) (string-append (model-short-name model) " > ")))