parity: 14 features from opencode/aider/cline/codex/goose/etc
ober
a9e7b981fbedb9f8bdcd6f81e1b2178fece4fc12
--- a/build-binary.ss +++ b/build-binary.ss @@ -110,6 +110,14 @@ "lib/jcode/core/secrets" "lib/jcode/core/secrets-import" "lib/jcode/core/escalation" + "lib/jcode/core/permissions" + "lib/jcode/core/mentions" + "lib/jcode/core/agents-md" + "lib/jcode/core/hooks" + "lib/jcode/core/compaction" + "lib/jcode/core/sandbox" + "lib/jcode/core/repomap" + "lib/jcode/core/checkpoints" "lib/jcode/core/expert" "lib/jcode/core/agent" "lib/jcode/core/plugin" @@ -119,7 +127,10 @@ "lib/jcode/provider/provider" "lib/jcode/tool/registry" "lib/jcode/tool/file" + "lib/jcode/tool/apply-patch" "lib/jcode/tool/bash" + "lib/jcode/tool/task" + "lib/jcode/tool/repomap-tool" "lib/jcode/tool/web" "lib/jcode/tool/batch" "lib/jcode/tool/git" new file mode 100644 --- /dev/null +++ b/findings.md @@ -0,0 +1,342 @@ +# jerboa-code: Ideas from open-source AI coding harnesses + +Synthesis of features worth porting into jerboa-code, drawn from a review of: +**opencode, aider, cline, continue, codex, goose, plandex, gptme, crush**. + +Organized by impact/effort. Each item names its source and gives a brief +implementation sketch in Jerboa terms. + +--- + +## Tier 1 — high impact, moderate effort + +### 1. Aider-style SEARCH/REPLACE edit format +**Source:** aider (primary edit mode). +Cleaner than line-based edits for weaker models. Format: + +``` +path/to/file.ss +<<<<<<< SEARCH +old code +======= +new code +>>>>>>> REPLACE +``` + +Add as a new `edit_block` tool alongside existing `edit`/`multi-edit`. +Parser ~50 LOC. Models love it because they don't have to count lines — +they just match a unique string, the way they'd grep mentally. + +### 2. Repomap with PageRank +**Source:** aider's killer feature. +A condensed map of the codebase: file → top symbols, ranked by graph +centrality (PageRank over symbol-reference edges). Auto-injected into +system prompt up to a token budget. + +You have LSP integration — extract definitions via LSP, build a +symbol→file map, run PageRank, format as a `repo-map` block in the +system prompt. ~200 LOC plus tuning. Reduces grep loops dramatically +for unfamiliar repos. + +### 3. Prompt caching with cacheControl markers +**Source:** anthropic SDK, used by every harness with anthropic support. +You're paying full price on every turn's system prompt + history. Mark +system + recent tool results with `cache_control: {type: "ephemeral"}`. +90%+ cost cut on long sessions. ~30 LOC in `provider/anthropic.ss`. + +### 4. Permission rule engine +**Source:** opencode permissions + codex execpolicy (Starlark prefix_rule). +Replace binary plan/build with prefix-rule allowlists: + +```json +{ + "allow": ["git status", "ls *", "rg *"], + "prompt": ["git commit *", "git push"], + "deny": ["rm -rf *", "curl *", "sudo *"] +} +``` + +Per-command match against bash invocations. ~80 LOC. Lets users +autonomously approve common safe commands without dropping to plan mode. +Codex's prefix_rule syntax (pattern, decision, justification, match, +not_match) is directly portable to Scheme. + +### 5. Sub-agent / Task tool +**Source:** opencode, goose, cline. +Spawn a subordinate agent for research with its own context window. +Returns a summary to the main agent. Crucial for keeping main context +clean during exploration. + +You have most plumbing in `core/agent.ss` — wrap it as a tool that takes +`{description, prompt, subagent_type}`. ~120 LOC. Pairs well with skills: +each subagent_type can have a baked-in system prompt + tool allowlist. + +--- + +## Tier 2 — high impact, high effort + +### 6. Sandboxing for bash +**Source:** codex (seatbelt on macOS, landlock+bwrap on Linux). +Run bash tool inside macOS Seatbelt (`sandbox-exec` with sbpl profile) +or Linux bwrap/landlock. Deny network + writes outside cwd by default. + +Codex's `seatbelt_base_policy.sbpl` is **directly portable** — it's a +Scheme/Lisp DSL with deny-by-default + explicit `allow process-exec`, +`allow file-read*`, etc. ~150 LOC + policy files. Eliminates the biggest +blast-radius risk in autonomous mode. + +Codex also has a shell-escalation protocol — when the sandboxed shell +needs to break out, a wrapper FD forwards the request to a server that +decides Run/Escalate/Deny. Probably overkill for jerboa-code v1. + +### 7. Shadow-git checkpoint system +**Source:** cline, opencode. +On every agent file edit, snapshot to a hidden git worktree +(`~/.jcode/checkpoints/<session>/`). Adds `/undo` and `/redo` that work +even outside a real git repo. ~100 LOC around your edit/write tools. + +Implementation: shadow repo with `git init` in a hidden dir, copy-on-edit +into it, commit per turn. `/undo N` checks out `HEAD~N` of shadow, +copies files back. + +### 8. Auto-compaction with tool-output pruning +**Source:** opencode, goose. +Before hitting context limits: summarize older turns, replace large tool +outputs (file reads, bash stdout) with `[pruned: N lines, ref msg-#42]`. + +You have `core/session.ss` — add a `compact-session!` pass triggered at +80% context. ~150 LOC. Goose's approach: keep the last N turns verbatim, +replace older tool outputs with stubs, summarize the rest into a single +synthetic user message. + +### 9. Hook system +**Source:** codex (`HookFn`, `HookResult`), goose, cline. +Shell hooks at `PreToolUse`, `PostToolUse`, `PreAgent`, `PostAgent`, +`Stop`. Configured in `jcode.json`. Enables linting, secret-scanning, +custom approval flows. + +Codex's `HookResult{Success, FailedContinue, FailedAbort}` is the right +shape: Success = proceed, FailedContinue = log+proceed, +FailedAbort = block the action. Hook script gets JSON on stdin with +`{session_id, cwd, hook_event, tool_name, args}`. ~100 LOC. + +--- + +## Tier 3 — moderate impact, low effort + +### 10. @-mention context providers +**Source:** continue, cline. +In input parsing: `@file:src/foo.ss`, `@symbol:make-provider`, +`@url:https://…`, `@diff`, `@problems` (LSP diagnostics). +Resolved client-side before send, inlined as additional system context. +~80 LOC parser in `ui/cli.ss`. + +### 11. Hierarchical AGENTS.md / CLAUDE.md discovery +**Source:** opencode. +Walk from cwd → root, concat all `AGENTS.md` / `CLAUDE.md` / +`.cursorrules` files into the system prompt (parent first, child last +so local instructions win). You read one CLAUDE.md — generalize to walk. +~30 LOC. + +### 12. apply_patch envelope +**Source:** codex (`apply-patch` crate). +Single tool that takes a multi-file unified-diff-ish envelope and +applies all hunks atomically: + +``` +*** Begin Patch +*** Update File: path/to/foo.ss +@@ ... +-old ++new +*** End Patch +``` + +Replaces multi-tool round-trips for related edits. ~120 LOC; codex's +streaming parser is portable. Has an `APPLY_PATCH_TOOL_INSTRUCTIONS` +constant they inject into the system prompt explaining the format. + +### 13. Cost/token meter in TUI +**Source:** most harnesses. +Running `$0.043 · 12.4k in / 3.2k out · 18% ctx` in the status bar. You +track usage in provider stats already. ~40 LOC, plus a per-model price +table. + +### 14. Loop detection via result canonicalization +**Source:** cline, crush. +You have `detect-identical-loop` in `escalation.ss` — extend to detect +"same file edited 3+ times with no progress" via hashing the *result* +(file contents after edit), not just the tool call args. ~30 LOC tweak. + +--- + +## Tier 4 — nice-to-haves + +- **Recipes** (goose) — declarative agent personas in YAML, like skills + but with model/temp/tool-allow-list baked in. Could subsume skills. +- **MCP streamable HTTP transport** (opencode) — you have stdio; add + HTTP for remote MCP servers (with OAuth if you want to be fancy). +- **`/clear` that preserves system + first user message** (most) — + soft reset. +- **Tool result caching** (continue) — hash `(tool, args)` → result, + skip dupes within a session. +- **Multi-line paste detection in TUI** (opencode) — don't treat pasted + code as multiple submits. +- **Session branching** (plandex) — fork conversation at any turn, A/B + different approaches. Each branch is a separate SQLite row chain. +- **`/diff` showing all unstaged edits agent made this session** (cline) — + review before commit. +- **Image input** (most) — paste/drag screenshot into TUI. Encode as + base64, send as image content block. You'd need provider-side support + per model. +- **Web fetch with markdown extraction** (continue/aider) — you have + `fetch`; add a `readability`-style extraction so model gets clean + prose instead of HTML soup. +- **`/model` runtime switch** (most) — change provider+model mid-session + without restart. You have multi-provider config; just need a UI + command that re-resolves `current-provider`. +- **MCP server marketplace** (codex `core-plugins`) — central registry + of MCP servers, install with one command. Probably overkill; skills + cover most of this. + +--- + +## Suggested implementation order + +| # | Feature | Effort | Payoff | +|---|-------------------------------|----------|-----------------------------| +| 1 | Prompt caching | 1 day | Huge cost cut, immediate | +| 2 | SEARCH/REPLACE edit format | 1 day | Better weak-model edits | +| 3 | Permission rule engine | 1 day | Removes plan/build friction | +| 4 | @-mention providers | 1 day | UX win | +| 5 | Hierarchical AGENTS.md | half day | Instructions composability | +| 6 | Cost/token meter | half day | User trust + visibility | +| 7 | Hook system | 2 days | Integration story | +| 8 | Sub-agent tool | 2 days | Context discipline | +| 9 | Auto-compaction | 2 days | Long-session viability | +|10 | Sandboxing | 3-5 days | Security; biggest blast win | +|11 | Repomap+PageRank | 3-5 days | Largest UX win for novices | +|12 | Shadow-git checkpoints | 2 days | Safety net for risky tasks | + +**My recommendation for first cut:** prompt caching. It's localized to +`provider/anthropic.ss`, low risk, and the cost difference is immediate +and dramatic. Then SEARCH/REPLACE because it improves edit reliability +for the local-LoRA setups you care about. Then the permission engine +because plan/build is too coarse. + +--- + +## Per-harness review notes + +### opencode (~/mine/opencode, TypeScript) +- Hierarchical AGENTS.md discovery — parent-to-child concat +- Rule-based permission engine — allow/prompt/deny prefix lists +- Sub-agent system — `task` tool spawns subordinate with own context +- Auto-compaction with tool-output stubbing +- Shadow-git checkpoint per turn +- MCP streamable HTTP transport (in addition to stdio) +- TUI status bar with cost/tokens/context % +- Multi-line paste detection in input +- `/clear` preserving system + first user +- @-mention providers + +### aider (Python) +- SEARCH/REPLACE edit format (primary) +- Whole-file edit format (fallback) +- Unified-diff edit format (advanced) +- Repomap with PageRank over symbol graph +- Tree-sitter symbol extraction +- Git-commit-per-turn with auto-generated messages +- `/architect` mode — separate strong model for planning, weak model for editing +- Voice input (whisper integration) +- Linting hook after each edit +- Token-budget-aware context selection + +### cline (TypeScript, VS Code) +- Shadow-git checkpoints with `/undo` +- @-mentions: @file, @folder, @url, @problems, @terminal, @git-changes +- Canonical-signature loop detection +- Browser tool (puppeteer for testing web apps) +- MCP marketplace + installer UI +- Plan/Act mode toggle (similar to your plan/build) +- Per-tool approval with "always allow this command" +- Streaming diff view inline +- Settings UI for prompts/models + +### continue.dev (TypeScript) +- @-mention context providers as plugin architecture +- Embedded indexer with vector search over the repo +- Custom slash commands defined in `~/.continue/config.json` +- Inline edit (cmd-I) — small targeted edits without full chat +- Autocomplete via separate model +- Docs context provider (indexes external doc sites) +- Tool result caching by (tool, args) hash +- Multi-model config — different models for chat/edit/autocomplete/embed + +### codex (~/mine/codex, Rust) +- Sandboxing: seatbelt (macOS sbpl) + bwrap+landlock (Linux) +- shell-escalation protocol with FD forwarding +- Execpolicy: Starlark prefix_rule(pattern, decision, justification) +- apply-patch envelope with streaming parser +- Hooks: PreAgent/PostAgent with FailedAbort/FailedContinue +- Plugin marketplace via curated GitHub repo +- Skills with assets dir for reference docs +- agent-graph-store — persistent graph of agent runs +- analytics + otel instrumentation +- Patched zsh with EXEC_WRAPPER for sandbox escalation + +### goose (Rust, Block) +- Recipes — YAML agent personas with model/tools/prompt baked in +- Sub-agent (`task` tool) +- Hooks: pre_tool, post_tool, before_agent, after_agent +- Extension marketplace (their MCP equivalent) +- Multi-mode: smart_approve / auto / chat-only +- Token-budget-aware auto-compaction with summarization +- Slack/CLI/desktop frontends sharing same core +- Session-resume across frontend switches +- Built-in memory extension (stores facts across sessions) +- Provider abstraction with retry/backoff/rate-limit + +### plandex (Go) +- Session branching — fork at any turn +- Plan files — declarative multi-step plans the agent executes +- Streaming context updates — file changes streamed to model as they happen +- TUI with split panes (plan / chat / files) +- Background tasks — long operations off the main loop + +### gptme (Python) +- Tool-chaining via piped output (shell-like composition in chat) +- Browser tool with screenshot +- Image generation tool +- IPython tool (persistent REPL state across turns) +- Hooks via Python plugin system +- Minimal core, plugin-everything + +### crush (Go, Charm) +- Beautiful TUI with bubble-tea +- Multi-provider with quick model switcher +- Pretty diff rendering +- Session list with thumbnails of first message +- Loop detection canonical signature (lifted from cline) + +--- + +## What jerboa-code already has (so skip these) + +- Multi-provider (anthropic, openai, openrouter, mlx, google, ollama) +- Plan/build mode toggle with write-tool filtering +- Skills loader (claude-compatible: `.claude/skills/*/SKILL.md`) +- Expert escalation with 6 auto-signals (loop, no-text, error-streak, + low-logprob, high-entropy, truncated) +- MCP client (stdio transport) +- Secrets management with encrypted at-rest + import from opencode/ + claude-code/aider +- LSP integration as a tool +- Server mode (stdio + TCP JSONL) +- Plugin system +- Full TUI with collapsible `<think>` blocks +- SQLite session persistence +- Debug REPL +- Batch tool for parallel file reads +- text-format tool-call parsing for weak models +- Streaming with parameter-inheritance for spawned threads --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -19,6 +19,9 @@ ./message ./session ./expert + ./mentions + ./agents-md + ./compaction :jcode/provider/provider :jcode/tool/registry :jerboa/core @@ -54,12 +57,14 @@ When the user asks you to do something: 3. Make minimal targeted edits with the edit tool 4. Report back with results -Be concise. Prefer edit over write for modifying existing files." +Be concise. Prefer edit over write for modifying existing files. +~a" (current-directory) (mode-label (current-mode)) (format-tool-list) (mode-instructions (current-mode)) - (expert-prompt-instructions))) + (expert-prompt-instructions) + (collect-agent-instructions))) (def (format-tool-list) "Build a bullet list of all registered tools for the system prompt." @@ -92,13 +97,19 @@ Be concise. Prefer edit over write for modifying existing files." (def (refresh-system-prompt messages) "Replace the leading system message (if any) with a fresh one reflecting the current mode. Returns a NEW list — does not mutate. If there's no - leading system message, prepends one." - (let ((fresh (make-system-message (system-prompt)))) + leading system message, prepends one. Also runs auto-compaction when + the message list has grown close to the model's context window." + (let* ((fresh (make-system-message (system-prompt))) + (rebuilt + (cond + ((null? messages) (list fresh)) + ((equal? (message-role (car messages)) "system") + (cons fresh (cdr messages))) + (else (cons fresh messages)))) + (mdl (or (current-model-override) (config-ref "model") ""))) (cond - ((null? messages) (list fresh)) - ((equal? (message-role (car messages)) "system") - (cons fresh (cdr messages))) - (else (cons fresh messages))))) + ((should-compact? rebuilt mdl) (compact-messages rebuilt)) + (else rebuilt)))) (def (truncated-dir) "Return ~/.jcode/truncated/, creating it if needed." @@ -210,7 +221,7 @@ Be concise. Prefer edit over write for modifying existing files." (let ((existing (session-get-messages session-id))) (when (null? existing) (session-add-message session-id (make-system-message (system-prompt))))) - (session-add-message session-id (make-user-message user-input)) + (session-add-message session-id (make-user-message (expand-mentions user-input))) (if (current-stream-cb) (agent-loop-stream session-id (session-get-messages session-id) 0) (agent-loop session-id (session-get-messages session-id) 0))) new file mode 100644 --- /dev/null +++ b/src/jcode/core/agents-md.ss @@ -0,0 +1,98 @@ +;;; jcode hierarchical agent instructions +;;; +;;; Walk from cwd up to the filesystem root collecting any +;;; AGENTS.md CLAUDE.md .cursorrules .jcoderules +;;; files. Also pick up the global counterparts under ~/.claude/ and +;;; ~/.jcode/. Concatenate parent-first, child-last so the deepest +;;; (most-specific) instructions win when a model gets contradictory +;;; advice. +;;; +;;; The output is injected into the system prompt as a single labelled +;;; block. If no files are found we emit the empty string so the system +;;; prompt is unchanged. + +(export collect-agent-instructions) + +(import :std/os/path + :std/misc/string + :std/misc/ports + :jcode/core/log) + +(def logger (make-logger "agents-md")) + +(def *agent-file-names* + '("AGENTS.md" "CLAUDE.md" ".cursorrules" ".jcoderules")) + +(def (collect-agent-instructions) + "Return a single string with all discovered instructions blocks, + or the empty string if none were found." + (let* ((paths (discover-agent-files)) + (blocks (filter-map read-block paths))) + (cond + ((null? blocks) "") + (else + (string-append + "\n--- Project instructions (hierarchical AGENTS.md / CLAUDE.md / .cursorrules) ---\n" + (string-join blocks "\n\n") + "\n--- End project instructions ---\n"))))) + +(def (discover-agent-files) + "Return absolute paths to instruction files, ordered global-first then + parent-to-child so the most-specific (deepest cwd) come last." + (let* ((home (getenv "HOME")) + (dirs (walk-up-to-root (current-directory))) + ;; Globals first, then root-to-cwd + (search-dirs (append + (if home (list (path-join home ".claude") + (path-join home ".jcode")) + '()) + (reverse dirs))) + (seen (make-hash-table))) + (let loop ((ds search-dirs) (acc '())) + (cond + ((null? ds) (reverse acc)) + (else + (let ((ds-acc (collect-in-dir (car ds) seen))) + (loop (cdr ds) (append (reverse ds-acc) acc)))))))) + +(def (walk-up-to-root dir) + ;; Yield DIR and every ancestor up to the filesystem root. + (let loop ((d dir) (acc '())) + (let ((parent (path-directory d))) + (cond + ((or (string=? d "/") (string=? d "") (equal? d parent)) + (reverse (cons d acc))) + (else + (loop parent (cons d acc))))))) + +(def (collect-in-dir dir seen) + (let loop ((names *agent-file-names*) (acc '())) + (cond + ((null? names) (reverse acc)) + (else + (let* ((p (path-join dir (car names))) + (canon (canonicalize p))) + (cond + ((and canon (file-exists? p) + (not (file-directory? p)) + (not (hash-ref seen canon #f))) + (hash-put! seen canon #t) + (loop (cdr names) (cons p acc))) + (else (loop (cdr names) acc)))))))) + +(def (canonicalize p) + ;; Cheap dedup — full canonicalisation would require realpath; for our + ;; needs string equality on the absolute path is enough. + (and (string? p) p)) + +(def (read-block path) + (try + (let ((content (read-file-string path))) + (cond + ((string=? (string-trim (or content "")) "") #f) + (else + (log-debug logger "loaded" `((path . ,path) (bytes . ,(string-length content)))) + (format "### ~a\n~a" path content)))) + (catch (e) + (log-warn logger "read-failed" `((path . ,path) (err . ,(err->string e)))) + #f))) new file mode 100644 --- /dev/null +++ b/src/jcode/core/checkpoints.ss @@ -0,0 +1,162 @@ +;;; jcode shadow-git checkpoints +;;; +;;; Snapshot every agent file mutation to a hidden git repo at +;;; .jcode/checkpoints/, separate from the user's real repo. Enables +;;; /undo even when the project isn't under git. +;;; +;;; Implementation: we don't copy files; we point an alternate git-dir +;;; at the user's cwd via `--git-dir=...checkpoints/.git --work-tree=.`. +;;; Adds are bounded by .jcode/checkpoints/.gitignore (ignored) and the +;;; usual respect for the user's gitignore. +;;; +;;; Config in jcode.json: +;;; +;;; "checkpoints": { +;;; "enabled": true, +;;; "max_keep": 100 +;;; } +;;; +;;; Public API: +;;; (checkpoint-init!) +;;; (checkpoint-snapshot! reason) -> commit-hash or #f +;;; (checkpoint-undo! n) -> 'ok / 'no-history / message +;;; (checkpoint-list) -> list of (hash . message) + +(export checkpoints-enabled? + checkpoint-init! + checkpoint-snapshot! + checkpoint-undo! + checkpoint-list) + +(import :std/os/shell + :std/os/path + :std/misc/string + :jcode/core/config + :jcode/core/log) + +(def logger (make-logger "checkpoints")) + +(def (checkpoints-enabled?) + (let ((block (config-ref "checkpoints"))) + (cond + ((not block) #t) ;; default ON + ((not (hash-table? block)) #t) + (else (let ((v (hash-get block "enabled"))) + (cond ((eq? v #f) #f) + (else #t))))))) + +(def (checkpoint-dir) + (path-join (current-directory) ".jcode" "checkpoints")) + +(def (checkpoint-git-dir) + (path-join (checkpoint-dir) ".git")) + +(def (mkdir-p dir) + (unless (file-exists? dir) + (let ((parent (path-directory dir))) + (when (and parent (not (equal? parent "")) (not (file-exists? parent))) + (mkdir-p parent)) + (mkdir dir)))) + +(def (shell-q s) + (let ((parts (string-split s #\'))) + (string-append "'" (string-join parts "'\\''") "'"))) + +(def (run-git-or-fail args) + ;; Run `git <args>` with the shadow git-dir, return (stdout . exit). + (let ((cmd (format "git --git-dir=~a --work-tree=~a ~a" + (shell-q (checkpoint-git-dir)) + (shell-q (current-directory)) + args))) + (log-debug logger "git" `((cmd . ,cmd))) + (let-values (((out err code) + (try (shell/status cmd (current-directory)) + (catch (e) (values "" (err->string e) 1))))) + (cons (or out "") code)))) + +(def (checkpoint-init!) + "Create the shadow repo if it doesn't exist yet." + (cond + ((not (checkpoints-enabled?)) #f) + ((file-exists? (checkpoint-git-dir)) #t) + (else + (mkdir-p (checkpoint-dir)) + (let ((r (run-git-or-fail "init -q"))) + (cond + ((= (cdr r) 0) + (run-git-or-fail "config user.email jcode@local") + (run-git-or-fail "config user.name 'jcode checkpoints'") + (run-git-or-fail "config commit.gpgsign false") + ;; Initial commit captures the working tree at session start. + (run-git-or-fail "add -A") + (run-git-or-fail "commit -q --allow-empty -m 'session start'") + (log-info logger "init" `((dir . ,(checkpoint-git-dir)))) + #t) + (else + (log-warn logger "init-failed" `((err . ,(car r)))) + #f)))))) + +(def (checkpoint-snapshot! reason) + "Commit the current working tree to the shadow repo. Returns the + short commit hash, or #f if disabled / failed." + (cond + ((not (checkpoints-enabled?)) #f) + (else + (checkpoint-init!) + (run-git-or-fail "add -A") + (let* ((msg (format "~a" (or reason "snapshot"))) + ;; --allow-empty so we always have a marker, even when the + ;; tool didn't actually change anything (e.g. a `read`). + (r (run-git-or-fail (format "commit -q --allow-empty -m ~a" + (shell-q msg))))) + (cond + ((not (= (cdr r) 0)) + (log-warn logger "snapshot-failed" `((err . ,(car r)))) + #f) + (else + (let ((h (run-git-or-fail "rev-parse --short HEAD"))) + (string-trim (car h))))))))) + +(def (checkpoint-undo! n) + "Reset cwd to N commits before HEAD in the shadow repo. Files are + restored to their state at that snapshot. Returns 'ok, 'no-history, + or an error string." + (cond + ((not (checkpoints-enabled?)) + "checkpoints disabled in config") + ((not (file-exists? (checkpoint-git-dir))) + "no checkpoint repo yet") + (else + (let* ((target (format "HEAD~~~a" n)) + (probe (run-git-or-fail (format "rev-parse --verify ~a" target)))) + (cond + ((not (= (cdr probe) 0)) 'no-history + ) + (else + (let ((r (run-git-or-fail (format "checkout -- :/" )))) + ;; reset --hard <target> + (let ((r2 (run-git-or-fail (format "reset -q --hard ~a" target)))) + (cond + ((= (cdr r2) 0) 'ok) + (else (string-trim (car r2)))))))))))) + +(def (checkpoint-list) + "Return a list of (short-hash . message) for the shadow repo, newest + first. Empty list when disabled / not yet initialised." + (cond + ((not (checkpoints-enabled?)) '()) + ((not (file-exists? (checkpoint-git-dir))) '()) + (else + (let ((r (run-git-or-fail "log --max-count=30 --pretty=format:%h%x09%s"))) + (cond + ((not (= (cdr r) 0)) '()) + (else + (filter-map parse-log-line (string-split (car r) #\newline)))))))) + +(def (parse-log-line line) + (let ((tab (string-contains line "\t"))) + (cond + ((not tab) #f) + (else + (cons (substring line 0 tab) + (substring line (+ tab 1) (string-length line))))))) new file mode 100644 --- /dev/null +++ b/src/jcode/core/compaction.ss @@ -0,0 +1,129 @@ +;;; jcode auto-compaction +;;; +;;; When a session's token estimate approaches the model's context +;;; window, prune the message list so it can keep going: +;;; +;;; * Always keep the system message verbatim. +;;; * Always keep the last N messages verbatim (default 12). +;;; * For older tool results above PRUNE-BYTES, replace the content +;;; with a short stub like "[pruned: 8421 bytes, was N lines]" so +;;; the tool-call <-> tool-result chain stays intact. +;;; * For older assistant/user messages above PRUNE-BYTES, truncate +;;; their content with a stub suffix; tool calls on assistant +;;; messages are preserved (the model needs the call shape, not the +;;; bulky text it emitted alongside). +;;; +;;; Configurable under "compaction" in jcode.json: +;;; +;;; "compaction": { +;;; "auto": true, +;;; "trigger_pct": 80, // begin compacting at this % of ctx +;;; "keep_recent": 12, // last N msgs untouched +;;; "prune_bytes": 2000 // tool results larger than this get stubs +;;; } + +(export compact-messages + compaction-config + should-compact? + estimate-message-tokens) + +(import :std/misc/string + :jcode/core/config + :jcode/core/log + :jcode/core/message + :jcode/core/models) + +(def logger (make-logger "compaction")) + +(def *compaction-defaults* + '((auto . #t) + (trigger_pct . 80) + (keep_recent . 12) + (prune_bytes . 2000))) + +(def (compaction-config key) + (let* ((block (config-ref "compaction")) + (str-key (symbol->string key))) + (cond + ((and block (hash-table? block) (hash-key? block str-key)) + (hash-get block str-key)) + (else + (let ((pair (assq key *compaction-defaults*))) + (and pair (cdr pair))))))) + +(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) "")) + (string-length (or (tool-call-arguments tc) "")) + 24)) + tcs)))) + (loop (cdr ms) (+ acc (string-length c) tc-bytes))))))) + +(def (should-compact? messages model-id) + (let ((auto (compaction-config 'auto)) + (pct (compaction-config 'trigger_pct)) + (win (model-context-window model-id)) + (est (estimate-message-tokens messages))) + (and auto win pct (> est 0) + (>= (* 100 est) (* pct win))))) + +(def (compact-messages messages) + "Return a new message list with older bulky content stubbed out. Safe + on any list — preserves system, user/assistant/tool ordering, and + tool-call linkage." + (let* ((keep-n (or (compaction-config 'keep_recent) 12)) + (prune (or (compaction-config 'prune_bytes) 2000)) + (total (length messages)) + (cut (max 0 (- total keep-n)))) + (let loop ((msgs messages) (i 0) (acc '())) + (cond + ((null? msgs) + (let ((result (reverse acc))) + (log-info logger "compacted" + `((before . ,total) + (after . ,(length result)) + (cut . ,cut))) + result)) + ((< i cut) + (loop (cdr msgs) (+ i 1) (cons (prune-message (car msgs) prune) acc))) + (else + (loop (cdr msgs) (+ i 1) (cons (car msgs) acc))))))) + +(def (prune-message msg max-bytes) + (cond + ;; System messages: never prune. + ((equal? (message-role msg) "system") msg) + (else + (let ((c (or (message-content msg) ""))) + (cond + ((<= (string-length c) max-bytes) msg) + (else + (let* ((kind (message-role msg)) + (lines (length (string-split c #\newline))) + (stub (format "[pruned: ~a content, ~a bytes, ~a lines]" + kind (string-length c) lines)) + (head (substring c 0 (min 200 (string-length c)))) + (replacement (string-append head "\n...\n" stub))) + (cond + ((equal? kind "tool") + (make-tool-result (message-tool-call-id msg) replacement)) + ((equal? kind "assistant") + ;; Preserve tool calls so the next-turn pairing survives. + (let ((m (make-assistant-message replacement (message-tool-calls msg)))) + m)) + (else + (let ((m (make-message kind replacement + (message-tool-calls msg) + (message-tool-call-id msg) + (message-thinking msg)))) + m)))))))))) --- a/src/jcode/core/escalation.ss +++ b/src/jcode/core/escalation.ss @@ -15,6 +15,11 @@ ;;; thinking and is reflex-emitting tool calls. ;;; 3. tool-error-streak — last N tool results in a row started with ;;; "error" / "Error". Model failing to recover. +;;; 3b. no-progress — last N tool results, after canonicalization, +;;; collapse to the same value. Catches cases +;;; where the model is iterating without +;;; actually changing state (e.g. reading the +;;; same file or hitting the same edit failure). ;;; 4. low-mean-logprob — current response's mean token logprob below ;;; threshold. True low-confidence signal. ;;; 5. high-mean-entropy — top-k entropy averaged over response above @@ -42,6 +47,7 @@ '((max_identical_tool_calls . 3) ;; #f to disable (max_rounds_without_text . 5) ;; #f to disable (max_tool_errors . 3) ;; #f to disable + (max_identical_results . 3) ;; #f to disable (min_mean_logprob . #f) ;; e.g. -2.5; #f disables (no logprobs by default) (max_mean_entropy . #f) ;; e.g. 2.0; #f disables (request_logprobs . #f) ;; whether providers should request logprobs @@ -151,6 +157,53 @@ (run-length . ,run-length) (threshold . ,threshold))))))) +(def (canonicalize-result text) + ;; Make tool results comparable across cosmetic differences: lowercase, + ;; collapse runs of whitespace, strip trailing punctuation, truncate to + ;; 240 chars. We deliberately do not strip line/byte counts that often + ;; appear in tool result preambles — if those differ, real progress was + ;; made. + (cond + ((not (string? text)) "") + (else + (let* ((trimmed (string-trim text)) + (lower (string-downcase trimmed)) + (chars (string->list lower)) + (folded (let loop ((rest chars) (acc '()) (in-ws #f)) + (cond + ((null? rest) (list->string (reverse acc))) + ((char-whitespace? (car rest)) + (if in-ws + (loop (cdr rest) acc #t) + (loop (cdr rest) (cons #\space acc) #t))) + (else + (loop (cdr rest) (cons (car rest) acc) #f)))))) + (if (> (string-length folded) 240) + (substring folded 0 240) + folded))))) + +(def (detect-no-progress messages) + (let ((threshold (escalation-config 'max_identical_results))) + (if (not threshold) + #f + (let* ((tool-msgs (filter tool-result-message? messages)) + (rev (reverse tool-msgs)) + (newest (and (pair? rev) (canonicalize-result + (message-content (car rev)))))) + (cond + ((or (not newest) (string=? newest "")) #f) + (else + (let ((recent (last-n-where + (lambda (m) + (string=? (canonicalize-result (message-content m)) + newest)) + tool-msgs + threshold))) + (and (>= (length recent) threshold) + `((signal . no-progress) + (run-length . ,(length recent)) + (threshold . ,threshold)))))))))) + (def (detect-tool-error-streak messages) (let ((threshold (escalation-config 'max_tool_errors))) (if (not threshold) @@ -201,6 +254,7 @@ (or (detect-identical-loop messages response) (detect-no-text-rounds messages response) (detect-tool-error-streak messages) + (detect-no-progress messages) (detect-low-logprob stats) (detect-high-entropy stats) (detect-truncated stats))) @@ -220,6 +274,9 @@ ((tool-error-streak) (format "~a consecutive tool errors" (cdr (assq 'run-length reason)))) + ((no-progress) + (format "~a tool results in a row produced identical output — no progress" + (cdr (assq 'run-length reason)))) ((low-mean-logprob) (format "low confidence (mean logprob ~a < ~a)" (cdr (assq 'mean_logprob reason)) new file mode 100644 --- /dev/null +++ b/src/jcode/core/hooks.ss @@ -0,0 +1,191 @@ +;;; jcode hook system +;;; +;;; Shell hooks fired at agent lifecycle events. Configured in +;;; jcode.json under "hooks": +;;; +;;; { +;;; "hooks": { +;;; "PreToolUse": [{ "match": "bash", "command": "scripts/audit.sh" }], +;;; "PostToolUse": [{ "match": "edit*", "command": "scripts/lint.sh" }], +;;; "PreAgent": [{ "command": "scripts/notify.sh start" }], +;;; "PostAgent": [{ "command": "scripts/notify.sh stop" }], +;;; "Stop": [{ "command": "scripts/cleanup.sh" }] +;;; } +;;; } +;;; +;;; Each hook is invoked with a JSON payload on stdin: +;;; { "event": "...", "tool": "...", "args": {...}, +;;; "result": "...", "cwd": "...", "session_id": "..." } +;;; +;;; Hook result interpretation (mirrors codex): +;;; exit 0 -> Success (continue normally) +;;; exit 1 -> FailedContinue (log warning, proceed) +;;; exit 2 -> FailedAbort (block the action and surface stderr) +;;; other -> FailedContinue +;;; +;;; The match field is an optional glob over the tool name. Missing +;;; match means "fire for every tool" (only relevant for PreToolUse / +;;; PostToolUse). + +(export hook-run + hook-run-pre-tool + hook-run-post-tool + hook-run-pre-agent + hook-run-post-agent + hook-run-stop) + +(import :std/text/json + :std/os/shell + :std/misc/string + :jcode/core/config + :jcode/core/log) + +(def logger (make-logger "hooks")) + +(def (hooks-for event) + ;; Return the list of hook spec hashes for EVENT (a string like + ;; "PreToolUse"), or '() if not configured. + (let ((block (config-ref "hooks"))) + (cond + ((not (and block (hash-table? block))) '()) + (else + (let ((entries (hash-get block event))) + (cond + ((not entries) '()) + ((list? entries) entries) + (else (list entries)))))))) + +(def (matches-tool? spec tool-name) + (let ((m (and (hash-table? spec) (hash-get spec "match")))) + (cond + ((or (not m) (string=? m "")) #t) + ((not tool-name) #t) + (else (glob-match m tool-name))))) + +(def (glob-match pattern str) + (let* ((parts (string-split pattern #\*)) + (n (length parts))) + (cond + ((= n 1) (string=? pattern str)) + (else + (let loop ((parts parts) (s str) (first? #t)) + (cond + ((null? parts) (or (string=? s "") (not first?))) + ((null? (cdr parts)) + (or (string=? (car parts) "")