updates
ober
e90bbd581061de4842ca9bf0828bf6548dce2f68
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -1798,6 +1798,7 @@ Be concise. Prefer edit over write for modifying existing files. (def (agent-chat user-input) (reset-turn-tool-calls!) + (invalidate-token-estimate-cache!) (let ((provider (get-current-provider))) (with-provider-prompt-context provider (lambda () --- a/src/jcode/core/compaction.ss +++ b/src/jcode/core/compaction.ss @@ -27,7 +27,8 @@ effective-compaction-budget should-compact? should-compact-for-budget? - estimate-message-tokens) + estimate-message-tokens + invalidate-token-estimate-cache!) (import :std/misc/string :jcode/core/config @@ -53,31 +54,42 @@ (let ((pair (assq key *compaction-defaults*))) (and pair (cdr pair))))))) + +;; --- Token estimation cache --- +(def *token-estimate-cache* (make-parameter (make-hash-table))) + +(def (invalidate-token-estimate-cache!) + (*token-estimate-cache* (make-hash-table))) + (def (estimate-message-tokens messages) ;; ~4 bytes per token across English/code, biased low so we trigger ;; compaction a little early rather than late. Tool calls add a - ;; small fixed overhead. - (let loop ((ms messages) (acc 0)) - (cond - ((null? ms) (quotient acc 4)) - (else - (let* ((m (car ms)) - (c (or (message-content m) "")) - (tcs (or (message-tool-calls m) '())) - (tc-bytes (apply + (map (lambda (tc) - (+ (string-length (or (tool-call-name tc) "")) - (let ((args (tool-call-arguments tc))) - (cond - ((not args) 0) - ((string? args) (string-length args)) - (else - (string-length - (call-with-string-output-port - (lambda (p) (write args p))))))) - 24)) - tcs)))) - (loop (cdr ms) (+ acc (string-length c) tc-bytes))))))) - + ;; small fixed overhead. Results are cached per message via eq?. + (let ((cache (*token-estimate-cache*))) + (let loop ((ms messages) (acc 0)) + (cond + ((null? ms) (quotient acc 4)) + (else + (let ((m (car ms))) + (if (hash-key? cache m) + (loop (cdr ms) (+ acc (hash-ref cache m))) + (let* ((c (or (message-content m) "")) + (tcs (or (message-tool-calls m) '())) + (tc-bytes (apply + (map (lambda (tc) + (+ (string-length (or (tool-call-name tc) "")) + (let ((args (tool-call-arguments tc))) + (cond + ((not args) 0) + ((string? args) (string-length args)) + (else + (string-length + (call-with-string-output-port + (lambda (p) (write args p))))))) + 24)) + tcs))) + (msg-bytes (+ (string-length c) tc-bytes))) + (hash-put! cache m msg-bytes) + (loop (cdr ms) (+ acc msg-bytes)))))))))) (def (effective-compaction-budget win) "Return the message-history budget after reserving fixed prompt overhead. Small local tool-calling models spend most of every request on the system