tools: loop kill-switch — warn at 3 identical calls, block at 5
ober
2603532363f96b11a79086789c27d40b4d5e98de
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -1782,6 +1782,7 @@ Be concise. Prefer edit over write for modifying existing files. (make-provider provider-name api-key model))) (def (agent-chat user-input) + (reset-turn-tool-calls!) (let ((provider (get-current-provider))) (with-provider-prompt-context provider (lambda () --- a/src/jcode/tool/registry.ss +++ b/src/jcode/tool/registry.ss @@ -22,7 +22,8 @@ tool-signature user-disable-tool! user-enable-tool! - user-disabled-tools-list) + user-disabled-tools-list + reset-turn-tool-calls!) (import :std/text/json :std/misc/string @@ -42,6 +43,23 @@ (def current-mode (make-parameter 'build)) (def current-disabled-tools (make-parameter '())) (def *user-disabled-tools* (make-parameter '())) +(def *turn-tool-calls* (make-parameter '())) +(def (record-tool-call! name args) + (let* ((canonical (json-object->string args)) + (entry (cons name canonical)) + (history (*turn-tool-calls*)) + (matches (filter (lambda (x) (equal? x entry)) history))) + (*turn-tool-calls* (cons entry history)) + (let ((count (+ (length matches) 1))) + (cond + ((>= count 5) + "Tool blocked — same call made 5+ times in this turn. Change strategy or report blockage.") + ((>= count 3) + (format "⚠ Loop warning: you've made this exact call ~a times. Change approach or report blockage." count)) + (else #f))))) + +(def (reset-turn-tool-calls!) + (*turn-tool-calls* '())) (def current-tool-allowlist (make-parameter #f)) (def current-compact-tool-schemas (make-parameter #f)) @@ -148,17 +166,20 @@ (cond ((not tool) (format "Unknown tool: ~a" name)) (else - (let ((result (try - ((hash-ref tool "handler") args) - (catch (e) - (format "Error executing ~a: ~a" name (err->string e)))))) - (let ((truncated (truncate-result result))) - (hook-run-post-tool name args truncated #f) - (when (and (write-tool-name? name) - (not (checkpoint-error-result? truncated))) - (try (checkpoint-snapshot! (format "~a: ~a" name (checkpoint-tool-label args))) - (catch (_e) #f))) - truncated))))))))))) + (let ((loop-err (record-tool-call! name args))) + (if loop-err + loop-err + (let ((result (try + ((hash-ref tool "handler") args) + (catch (e) + (format "Error executing ~a: ~a" name (err->string e)))))) + (let ((truncated (truncate-result result))) + (hook-run-post-tool name args truncated #f) + (when (and (write-tool-name? name) + (not (checkpoint-error-result? truncated))) + (try (checkpoint-snapshot! (format "~a: ~a" name (checkpoint-tool-label args))) + (catch (_e) #f))) + truncated))))))))))))) (def (get-tool-schemas) (let ((mapper (if (current-compact-tool-schemas)