Remove jerboa-emacs untouchable policy
ober
60426408a53f9eb16db9b548efdf300bcdedb6a6
--- a/cpt_corpus.jsonl +++ b/cpt_corpus.jsonl @@ -6,7 +6,7 @@ {"text": "<!-- FILE: README.md -->\n# Jerboa\n\nA Gerbil-syntax, Clojure-compatible Scheme dialect for production\nconcurrent systems, running on stock [Chez Scheme](https://cisco.github.io/ChezScheme/).\n\nJerboa implements Gerbil's user-facing language (`def`, `defstruct`,\n`match`, hash tables, `:std/*` libraries) **and** a substantial Clojure\ncompatibility layer (atoms, refs/STM, agents, persistent collections,\ncore.async, transducers, protocols, multimethods) as Chez Scheme\nmacros and native libraries. No Gerbil expander, no Gambit\ncompatibility layer, no patched Chez. The standard Chez compiler\nproduces the binaries.\n\n## Why Chez Scheme\n\nJerboa picks Chez Scheme as its host because its concurrency model is\nthe rare combination that real production systems need:\n\n- **Real OS threads, no GIL.** Chez Scheme's threaded build\n (`--threads`) gives you native OS threads with a thread-safe\n generational GC. CPU-bound work scales linearly across cores; you\n do not pay for parallelism with a global interpreter lock.\n- **First-class synchronization primitives.** `make-mutex`,\n `make-condition`, `with-mutex`, `condition-wait`,\n `condition-broadcast`, and atomic CAS on tc-mutex slots are\n exposed in the language. Jerboa's higher-level concurrency\n abstractions (`(std atom)`, `(std stm)`, `(std csp)`,\n `(std net io)` fibers) are built directly on these.\n- **Cheap closures, fast call paths.** Chez compiles to machine code\n through the nanopass framework \u2014 its closure allocation and\n call-through-pointer costs are competitive with what Go achieves\n via its runtime. That gives Jerboa room to express tens of\n thousands of fibers as plain procedures over a small worker pool\n without the cost dominating the workload.\n- **Fixnum-tagged arithmetic and unboxed bytevectors.** Hot paths in\n protocol handling (HTTP/2, WebSocket framing, base64, SHA) stay\n in fixnums and unboxed bytes, so a Scheme implementation of a\n protocol can sit within a small constant factor of a hand-written\n C version.\n- **A stable, fast FFI.** `foreign-procedure` and `foreign-callable`\n let Jerboa drop into a Rust shared library (`libjerboa_native`)\n for everything that genuinely needs sharp edges \u2014 ring for\n crypto, rustls for TLS, regex for ReDoS-immune matching,\n rusqlite/postgres/duckdb for storage. The Scheme side stays\n high-level; the Rust side stays memory-safe.\n- **A self-hosting compiler.** When Jerboa needs a primitive that\n Chez does not ship (e.g. `bytevector-slice`, `bytevector-append`,\n `base64-encode`/`base64-decode`, `sha1-bytevector`,\n `sha256-bytevector`), we add it to our Chez fork in pure Scheme\n with full backwards compatibility. No patched bootstrap, no\n vendored compiler \u2014 just additional primitives in `(chezscheme)`.\n- **Apache 2.0**, no license entanglements.\n\nThe result: a single language where green threads (fibers), OS\nthreads, atomic state, software-transactional memory, and CSP\nchannels all coexist on top of the same scheduler primitives, with\npredictable performance and no runtime to fight.\n\n## Quick Start\n\n```scheme\n(import (jerboa prelude))\n\n(def (main)\n (defstruct point (x y))\n (let ([p (make-point 3 4)])\n (displayln (point-x p)) ;; 3\n (displayln (sort < [5 1 3])) ;; (1 3 5)\n (displayln (string-join [\"a\" \"b\"] \",\")) ;; a,b\n (displayln (json-object->string [1 2 3])))) ;; [1,2,3]\n\n(main)\n```\n\nRun with:\n```bash\nscheme --libdirs lib --script your-file.ss\n```\n\n## Architecture\n\n```\n\u250c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2510\n\u2502 User's Gerbil-like code \u2502\n\u2502 (def (main) (displayln (sort < [3 1 2]))) \u2502\n\u2514\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u252c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2518\n \u2502\n\u250c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u25bc\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2510\n\u2502 Reader: [...] = (...), {...} \u2192 (~ ..) \u2502\n\u2502 :std/sort \u2192 (std sort), keyword:, heredocs \u2502\n\u2502 Optional Clojure mode (#!cloj) \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Core Macros: def, defstruct, match, try \u2502\n\u2502 All expand to standard Chez Scheme \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Runtime: hash tables, method dispatch, \u2502\n\u2502 persistent collections, transients \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Concurrency: fibers, CSP, STM, atoms, \u2502\n\u2502 agents, futures, work-stealing scheduler \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Standard Library: 229 (std *) modules \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Native FFI: libjerboa_native.so (Rust) \u2502\n\u2502 ring \u00b7 flate2 \u00b7 regex \u00b7 sqlite \u00b7 \u2502\n\u2502 postgres \u00b7 rustls \u00b7 landlock \u00b7 ed25519 \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Stock Chez Scheme \u2014 additive primitives, \u2502\n\u2502 no fork, no patches \u2502\n\u2514\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2518\n```\n\n## What's Landed in the Last Month\n\nThe recent push has expanded Jerboa from \"Gerbil syntax on Chez\" into\na full production stack. The additions group into seven themes.\n\n### 1. Fiber-aware concurrency stack\n\nA green-thread system layered on Chez OS threads with epoll-integrated\nI/O. The eight-phase rollout (`docs/green-wins.md`) is now complete.\n\n| Module | Provides |\n|---|---|\n| `(std net io)` | epoll-integrated I/O core for fibers |\n| `(std net fiber-httpd)` | Fiber-native HTTP/1.1 server with URL-param routing |\n| `(std net fiber-ws)` | Fiber-aware WebSocket server, integrates with httpd |\n| `(std workpool)` | Bounded worker pool for blocking syscalls |\n| `(std net dns)` | Fiber-friendly resolver with caching |\n| `(std net filepool)` | File-descriptor pool offloading slow disk I/O |\n| `(std net sendfile)` | Zero-copy `sendfile(2)` paths for static content |\n| `(std net connpool)` | Fiber-aware connection pooling for outbound TCP |\n| `(std net rate)` | Token bucket, sliding/fixed-window limiters |\n| `(std net router)` | HTTP routing with `:param` captures + middleware |\n| `(std semaphore)` / `(std net admission)` | Production hardening: admission control + circuit metrics |\n| `(std fiber)` | Cancellation, fiber-locals, join, link, select, timeouts, groups |\n\nInternally, the scheduler now uses **per-worker work-stealing deques**\ninstead of a shared run-queue, and the completion / wait API was\nre-wired through fibers so that ports and channels block fibers\nwithout parking the OS thread.\n\n### 2. Clojure compatibility layer \u2014 `(std clojure)`\n\nA substantial Clojure-on-Scheme port: sequences, atoms, agents, refs,\nmultimethods, protocols, transducers, persistent collections, lazy\nsequences, core.async, EDN, specter, zippers, and the rest of the\ncommon idiom.\n\n**Persistent collections** (HAMT- and RRB-backed):\n\n| Module | Provides |\n|---|---|\n| `(std pmap)` | Persistent hash-array-mapped trie map + `transient-map` for fast bulk build |\n| `(std pvec)` | Persistent RRB vector |\n| `(std pset)` | Persistent set on top of `pmap` |\n| `(std sorted-set)` | Sorted persistent set |\n| `(std sorted-map)` | Sorted persistent map |\n| `(std pqueue)` | Persistent FIFO queue (SRFI-134-backed) |\n\nAll persistent collections participate in Chez's `equal?` /\n`equal-hash` / `display`, integrate with the `for/collect` / `for/fold`\niterator protocol, and are destructurable via `match`. They use\nnongenerative RTDs so equality survives separate compilation.\n\n**Concurrency primitives** (Clojure-style names, Chez-thread-safe):\n\n| Module | Provides |\n|---|---|\n| `(std atom)` | `atom`, `swap!`, `reset!`, `compare-and-set!`, `add-watch!`, `volatile!` family |\n| `(std agent)` | Async state cells with bounded send queues |\n| `(std stm)` | `ref`, `dosync`, `alter`, `commute`, `ensure` on top of TVars |\n| `(std multi)` | `defmulti` / `defmethod` with `:hierarchy` and `derive!` |\n| `(std protocol)` | Open-world protocols (`defprotocol`, `extend-type`, `extend!`) |\n| `(std meta)` | Metadata wrappers (`with-meta`, `meta`) |\n| `(std component)` | Stuart Sierra-style lifecycle (`start`, `stop`, dependency graph) |\n\n**core.async-style CSP** \u2014 `(std csp)`:\n\n- `(chan n xform)` \u2014 transducer-backed channels\n- Sliding / dropping / blocking buffers\n- `alts!` / `alts!!` non-deterministic select\n- `pipe`, `mult`, `mix` (with `'block` / `'drop` / `'timeout` policies)\n- `pub` / `sub` topic filtering\n- `split` / `chan-classify-by` n-way split\n- `async-reduce`, `onto-chan!`, `onto-chan!!`\n- `put!` / `take!` non-blocking callback variants\n- Timer wheel for scalable timeouts (`JERBOA_CSP_TIMER_WHEEL=1`)\n- `(std csp fiber-chan)` integrates channels with fibers\n\n**Sequence / data manipulation**:\n\n| Module | Provides |\n|---|---|\n| `(std clojure)` | Umbrella with `delay`, `future`, `promise`, polymorphic `deref` |\n| `(std clojure walk)` | `prewalk`, `postwalk`, `keywordize-keys`, etc. |\n| `(std clojure data)` | `diff` |\n| `(std clojure zip)` | Tree zippers |\n| `(std clojure seq)` | Lazy sequences: `range`, `iterate`, `repeat`, `cycle`, `take-while`, `drop-while` |\n| `(std clojure reducers)` | Reducible/transducible adapters |\n| `(std specter)` | Composable path navigation for nested data |\n| `(std zipper)` | Functional tree zippers |\n| `(std text edn)` | EDN reader/writer (#inst, #uuid, tagged literals) |\n| `(std misc nested)` | `get-in`, `assoc-in`, `update-in` |\n| `(std injest)` | Smart thread-last with transducer fusion |\n\nThe `(std clojure)` module also lands `ex-info`, `condp =>`,\n`reduce-kv`, set relational ops (`select`, `project`, `rename`,\n`index`, `join`), and full destructuring.\n\n`(std test check)` is a property-based testing library with\nshrinking, in the style of `test.check`.\n\n### 3. Slang + WebAssembly backend\n\nSlang is a secure language compiler that targets WebAssembly, with\ntwo execution backends.\n\n- Full WASM MVP plus post-MVP features: saturating conversions, bulk\n memory operations, reference types, tables, tail calls, exception\n handling, GC, host imports.\n- `(jerboa wasm format)` \u2014 binary format primitives (LEB128, IEEE 754).\n- `(jerboa wasm codegen)` \u2014 Scheme\u2192WASM compiler for an i32 subset\n (closures, tail calls, exceptions, variadic lambdas).\n- `(jerboa wasm runtime)` \u2014 stack-based interpreter for testing.\n- **wasmi backend** \u2014 Rust embedding with fuel metering and bounded\n memory; security-hardened (bounds checks, exception boundary,\n import validation, module-size limits).\n- **SpiderMonkey backend** via the `mozjs` crate \u2014 production JIT for\n benchmarks where wasmi is the bottleneck.\n- Argon2id key derivation, message HMAC, sandbox limits, taint checks\n baked in.\n- `wasm-sandbox-instantiate-hosted` provides a Scheme FFI binding for\n hosting third-party WASM modules with capability-based imports.\n\n### 4. Native Rust backend \u2014 `libjerboa_native.so`\n\nA unified Rust shared library replaces the previous C-FFI surface\nwith memory-safe implementations behind a small extern-\"C\" facade.\n\n| Module | Crate(s) | Provides |\n|---|---|---|\n| `(std crypto native-rust)` | ring | SHA-1/256/384/512, HMAC, AES-256-GCM, PBKDF2, CSPRNG, ed25519 sign/verify |\n| `(std crypto secure-mem)` | libc (mmap/mlock) | Guard-paged, mlocked memory outside GC |\n| `(std compress native-rust)` | flate2 | `deflate`/`inflate`/`gzip`/`gunzip` with size limits |\n| `(std regex-native)` | regex (NFA) | Compile / match / find / replace \u2014 ReDoS-immune |\n| `(std db sqlite-native)` | rusqlite (bundled) | Open / exec / prepare with parameterized queries |\n| `(std db postgresql-native)` | rust-postgres | Connect / exec / query |\n| `(std db duckdb-native)` | duckdb-rs | Native DuckDB integration |\n| `(std os epoll-native)` | libc | epoll create / ctl / wait |\n| `(std os inotify-native)` | libc | inotify init / add_watch / read_events |\n| `(std os landlock-native)` | libc | Landlock LSM ABI v1\u2013v7 (FS + network confinement) |\n| `(std net tls-rustls)` | rustls | HTTPS / `wss://` with pinned cert verification |\n| `(std net request)` | rustls | HTTPS via the Rust TLS path |\n| `(std pcap)` | rscap | Live packet capture |\n\n`panic.rs` wraps every extern \"C\" entry point in `catch_unwind` so a\nRust panic never crosses the FFI boundary as undefined behavior.\n\n### 5. Cross-platform ports\n\nJerboa now runs on Linux (glibc + musl), FreeBSD, macOS (Intel + Apple\nSilicon), and Android (Termux).\n\n- **FreeBSD**: full Capsicum support in `(std security cage)`,\n `__error` errno binding, correct platform constants for O_* flags,\n `struct stat`, `sockaddr_in`, signals (SIGTSTP/SIGCHLD/SIGCONT and\n six others were hardcoded to Linux values), and integrity check via\n `sysctl` instead of `/proc/curproc/file`.\n- **macOS**: BPF live capture activation via `BIOCSETF` + `BIOCIMMEDIATE`\n (replacing `BIOCSETFNR` which doesn't exist on macOS), portable\n libc/libm names, dylib path fallback, AArch64 seccomp.\n- **Android**: bionic libc errno symbol support in TCP layer.\n\n`(std security cage)` provides pledge/unveil-style process\nconfinement that maps to the strongest mechanism available on each\nplatform: Landlock + seccomp on Linux, Capsicum on FreeBSD, sandbox-exec\non macOS.\n\n### 6. Security hardening\n\n- `(std security)` \u2014 `audit`, `auth`, `cage`, `capability`,\n `flow`, `import-audit`, `io-intercept`, `landlock`,\n `metrics`, `privsep`, `restrict`, `sandbox`, `sanitize`,\n `seatbelt`, `seccomp`, `secret`, `taint`, `capsicum`,\n `capability-typed`, `errors`.\n- mTLS with **pinned cert verifier** (replacing\n `WebPkiClientVerifier`); in-memory cert/key APIs.\n- Argon2id, TOCTOU-safe path handling, message HMAC.\n- Binary-hardening flags wired into the musl static build (PIE,\n RELRO, stack-canaries, NX) \u2014 see `docs/secure-binary.md`.\n- aarch64 seccomp filter.\n\n### 7. Performance work \u2014 phases 4\u201322\n\nA multi-phase optimization push, each with a benchmark gate to detect\nregressions. The scaffolding lives in `(std bench)` and runs in CI.\n\n| Phase | Optimization |\n|---|---|\n| 4 | Memoize regex compilation for literal reuse |\n| 5 | Fuse `for` / `for/collect` / `for/fold` over `in-range` / `in-vector` / `in-string` |\n| 6 | Single-pass keyword-arg extraction in `def` expansion |\n| 7 | Build the prelude aggregator to produce WPO for `std/*` |\n| 8 | Bench-suite harness + regression gate |\n| 12 | Arity-specialized method dispatch in `(~ obj 'name ...)` |\n| 13 | Fuse `in-hash-keys` / `in-hash-values` in `for/collect` |\n| 14 | Fuse runs of `(list 'TAG p ...)` clauses in `match` |\n| 17 | Method dispatch cost vs direct call (baseline) |\n| 18 | Kwarg call overhead (baseline) |\n| 22 | `string-append` adjacent-literal fold (Chez-side) |\n| \u2014 | `defstruct` / `defrecord` / `ok` / `err` seal by default |\n| \u2014 | `str` expand-time constant folding for literal args |\n| \u2014 | Persistent-collection nongenerative UIDs |\n| \u2014 | Iter fusion: `for/or` / `for/and` over known iterator heads |\n| \u2014 | Match2 fast-path `(: Type)` with fused RTD dispatch |\n\n### 8. Reader & build infrastructure\n\n- **Clojure reader compatibility mode** (`#!cloj`) \u2014 switch a file or\n REPL session into Clojure surface syntax (`#\"regex\"`, `#{}` sets,\n `#_form` discard, etc.).\n- **Regex tier 1\u20133** \u2014 raw strings, unified `(re ...)` API across the\n pure-Scheme and Rust backends, `rx` macros, full PEG grammar\n system in `(std peg)`.\n- **Single-file packages** \u2014 `jerboa exec` reads a self-contained\n `.ss` file with header metadata and runs it without project\n scaffolding.\n- **jerbuild** improvements \u2014 per-project feature gating so a\n static-musl build only links the dependencies the project\n actually uses.\n- **Docker base image** for static musl binary builds; CI workflow\n for macOS Rust libraries; jemacs static build TUI deps included.\n- **nREPL** \u2014 `(std nrepl)` is the canonical source; full CIDER /\n Calva middleware plus Jerboa extensions.\n- **AI compatibility aliases** \u2014 `(jerboa prelude)` exports common\n names from Racket / Gambit / Common Lisp that LLMs frequently\n hallucinate (`hash-has-key?` \u2192 `hash-key?`,\n `directory-exists?` \u2192 `file-directory?`, `random-integer` \u2192\n `random`, `eql?` \u2192 `eqv?`, etc.).\n\n### 9. Documentation push\n\n`docs/` is now ~90 files. Highlights:\n\n- `docs/anti-cookbook.md` \u2014 common Scheme/Clojure mistakes and how\n Jerboa makes them explicit.\n- `docs/api-index.md` \u2014 comprehensive API reference (~700KB,\n generated).\n- `docs/clojure-vs-jerboa.md` \u2014 feature scorecard with status\n markers.\n- `docs/clojure-left.md` \u2014 gap analysis driving the parity work.\n- `docs/green-wins.md` \u2014 fiber roadmap (now complete).\n- `docs/jerboa-edge.md` \u2014 edge-computing roadmap.\n- `docs/jerboa-db.md` \u2014 database integration tracking.\n- `docs/native-rust.md` \u2014 Rust backend architecture and migration.\n- `docs/regex-rx-peg.md` \u2014 unified regex/SRE/PEG reference.\n\n## What's Included\n\n### Core Macros (`(jerboa core)`)\n- `def`, `def*` \u2014 functions with optional / multi-arity / rest args\n- `defstruct` \u2014 sealed Chez records with auto-generated accessors\n- `defclass` \u2014 records with single inheritance\n- `defmethod`, `defmulti` \u2014 method dispatch and multimethods\n- `match`, `match2` \u2014 pattern matching (lists, predicates,\n `and`/`or`/`not`, cons, type patterns, persistent-collection\n destructuring, wildcards)\n- `try`/`catch`/`finally`, `errdefer`, `defvariant` (Zig-inspired)\n- `defrule`/`defrules` \u2014 syntax-rules shortcuts\n- `while`/`until`, `for` family\n- `hash-literal`/`let-hash`\n- Threading macros: `chain`, `chain-and`, `->`, `->>`, `as->`,\n `some->`, `cond->`\n\n### Runtime (`(jerboa runtime)`)\n- Full Gerbil hash table API\n- Method dispatch: `~`, `bind-method!`, `call-method`\n- Keywords, ports, displayln, `iota`, `1+`, `1-`\n- `(jerboa pkg)`, `(jerboa lock)` \u2014 semver, dep resolution,\n manifests, lockfile management\n- `(jerboa hot)` \u2014 hot code reload via mtime polling\n- `(jerboa embed)` \u2014 sandboxed evaluation environments\n- `(jerboa cross)` \u2014 cross-compilation config and ABI naming\n\n### Standard Library \u2014 229 modules under `lib/std/`\n\nMajor areas:\n\n- **Concurrency**: `(std atom)`, `(std agent)`, `(std stm)`,\n `(std csp)`, `(std multi)`, `(std protocol)`, `(std meta)`,\n `(std component)`, `(std clojure)`, `(std fiber)`, `(std raft)`,\n `(std actor)`, `(std concur hash)`, `(std concur stm)`,\n `(std concur structured)`.\n- **Networking**: 35+ `(std net *)` modules \u2014 `request`, `httpd`,\n `fiber-httpd`, `fiber-ws`, `websocket`, `http2`, `dns`,\n `sendfile`, `connpool`, `workpool`, `tcp`, `udp`, `tls`,\n `tls-rustls`, `ssh`, `s3`, `smtp`, `socks5-server`, `9p`,\n `grpc`, `json-rpc`, `router`, `rate`, `uri`.\n- **Data**: `(std pmap)`, `(std pvec)`, `(std pset)`,\n `(std sorted-set)`, `(std sorted-map)`, `(std pqueue)`,\n `(std specter)`, `(std zipper)`, `(std injest)`,\n `(std clojure data/walk/zip)`, `(std misc nested)`.\n- **Persistence / DB**: `(std db sqlite/postgresql/duckdb/leveldb)`,\n native-Rust variants, `(std db dbi)`, `(std db query-compile)`,\n `(std db conpool)`.\n- **Text**: `(std text json/edn/csv/xml/yaml/base64/hex/utf8)`,\n `(std regex-native)`, `(std rx)`, `(std peg)`.\n- **OS / runtime**: `(std os env/path/temporaries/signal/fdio)`,\n native epoll/inotify/landlock, `(std os capsicum)`,\n `(std misc process)`, `(std misc thread)`, `(std misc cpu)`.\n- **Crypto**: `(std crypto digest/cipher/hmac/pkey/kdf)`,\n `(std crypto native-rust)` (ring), `(std crypto secure-mem)`.\n- **Production infra**: `(std log)`, `(std metrics)`, `(std span)`,\n `(std health)`, `(std circuit)`, `(std semaphore)`, `(std lint)`,\n `(std test)`, `(std test check)`, `(std bench)`.\n- **Security**: 21 `(std security *)` modules \u2014 pledge/unveil,\n Landlock, Capsicum, seccomp, capability-typed I/O, taint, sandbox.\n\n### FFI (`(jerboa ffi)`)\n- `c-lambda` \u2192 `foreign-procedure` with automatic type translation\n- `define-c-lambda`, `begin-ffi`, `c-declare`\n- Full Gambit-to-Chez type mapping\n- `native-available?` guards for build-time platform feature gating\n\n### Reader (`(jerboa reader)`)\n- `[...]` = `(...)` (same as Gerbil and Chez)\n- `{method obj}` \u2192 `(~ obj 'method)`\n- `keyword:` \u2192 keyword objects\n- `:std/sort` \u2192 `(std sort)` module paths\n- Heredoc strings, datum comments, block comments\n- Optional Clojure surface syntax under `#!cloj`\n\n### Prelude (`(jerboa prelude)`)\nOne import for everything:\n```scheme\n(import (jerboa prelude))\n```\n\n## Examples\n\n### Fiber-based HTTP server\n```scheme\n(import (jerboa prelude)\n (std net fiber-httpd))\n\n(define (handler req)\n (let-values ([(method path) (request-method+path req)])\n (case method\n [(GET) (respond-text 200 \"hello\\n\")]\n [else (respond-text 405 \"method not allowed\\n\")])))\n\n(fiber-httpd-serve port: 8080 handler: handler workers: 4)\n```\n\n### CSP pipeline\n```scheme\n(import (jerboa prelude)\n (std csp) (std csp ops))\n\n(let ([in (chan 100)]\n [out (chan 100 (map (lambda (x) (* x x))))])\n (pipe in out)\n (go (let loop ([i 0])\n (when (< i 1000) (put! in i) (loop (+ i 1)))))\n (let consume ([n 0])\n (when (< n 1000)\n (displayln (take! out)) (consume (+ n 1)))))\n```\n\n### STM (Clojure refs)\n```scheme\n(import (jerboa prelude) (std stm))\n\n(define account-a (ref 100))\n(define account-b (ref 50))\n\n(define (transfer! from to amount)\n (dosync\n (alter from - amount)\n (alter to + amount)))\n\n(transfer! account-a account-b 25)\n```\n\n### Persistent map\n```scheme\n(import (jerboa prelude) (std pmap))\n\n(define m1 (pmap 'a 1 'b 2 'c 3))\n(define m2 (pmap-assoc m1 'd 4))\n(displayln (pmap-ref m2 'b)) ;; 2\n(displayln (pmap-ref m1 'd #f)) ;; #f (m1 unchanged)\n```\n\n## Testing\n\n```bash\nmake test # Core tests (289 tests)\nmake test-features # Phase 2+3 feature tests (637 tests)\nmake test-native # Rust native backend tests\nmake test-wrappers # Legacy chez-* C library wrappers (27 tests)\nmake test-clojure # Clojure compatibility layer tests\nmake test-fiber # Fiber + CSP + STM tests\nmake test-wasm # Slang/WASM backend tests\nmake test-all # Everything (1500+ tests)\n```\n\nProperty-based testing is available via `(std test check)`:\n\n```scheme\n(import (std test) (std test check))\n\n(check 'sort-is-idempotent\n (lambda (xs) (equal? (sort < xs) (sort < (sort < xs))))\n (gen-list (gen-integer)))\n```\n\n## Requirements\n\n- [Chez Scheme](https://cisco.github.io/ChezScheme/) 10.x (stock,\n unmodified \u2014 though we maintain an additive fork at\n [github.com/ober/ChezScheme](https://github.com/ober/ChezScheme)\n with a handful of pure-Scheme primitives that the standard\n library uses). Both work.\n- Optional: [Rust toolchain](https://rustup.rs/) for building\n `libjerboa_native.so` (crypto, compression, regex, databases,\n TLS, OS integration, ed25519).\n- Optional (legacy): [chez-*](https://github.com/ober) libraries for\n the older C-FFI shims (still functional, being superseded by the\n Rust backend).\n\n### Supported platforms\n\n| OS | Architecture | Notes |\n|---|---|---|\n| Linux | x86_64, aarch64 | glibc + musl static both supported |\n| FreeBSD | x86_64 | Capsicum enabled by default |\n| macOS | x86_64, aarch64 | Apple Silicon native; sandbox-exec for `(std security cage)` |\n| Android | aarch64 | Termux; bionic libc compat |\n\n## Project Structure\n\n```\nlib/\n jerboa/ # Reader, core macros, runtime, FFI, prelude\n # + pkg, lock, hot, embed, cross, wasm, build\n std/ # 229 modules \u2014 see \"Standard Library\" above\njerboa-native-rs/ # Unified Rust shared library\n src/\n lib.rs # module declarations, init\n crypto.rs # ring digests, hmac, aead, csprng, ed25519\n compress.rs # flate2: deflate, inflate, gzip\n regex_native.rs # regex crate\n sqlite.rs # rusqlite\n postgres_native.rs # rust-postgres\n duckdb.rs # duckdb-rs\n epoll.rs / inotify_native.rs / landlock.rs\n secure_mem.rs # mlock + guard pages + explicit_bzero\n tls_rustls.rs # rustls-based TLS\n panic.rs # catch_unwind wrapper for FFI\nslang/ # Slang language compiler\n src/ # IR, lowering, codegen\n wasm/ # WASM backend (wasmi + SpiderMonkey)\ndocs/ # ~90 files \u2014 green-wins, clojure-vs-jerboa, native-rust, \u2026\ntests/ # Test suite (1500+ tests)\nbenchmarks/ # Bench harness with regression gate\nsupport/ # Static-build artifacts, Docker base image\n```\n\n## What Gerbil Code Works\n\nMost user-level Gerbil code works unchanged:\n\n```scheme\n(import :std/sugar :std/sort :std/format)\n\n(def (run-command cmd env)\n (try\n (let* ([tokens (tokenize cmd)]\n [expanded (expand-aliases tokens env)])\n (match expanded\n ([prog . args] (exec-pipeline prog args env))\n (else (displayln \"empty command\"))))\n (catch (e) (displayln \"error: \" (error-message e)))))\n```\n\n## What Won't Work\n\n1. **Gerbil expander API** (`:gerbil/expander`) \u2014 not applicable\n2. **Gambit `##` primitives** \u2014 provided case-by-case\n3. **`(export #t)`** \u2014 re-export-everything needs explicit exports\n4. **Gerbil-specific `syntax-case` binding semantics** \u2014 uses Chez R6RS\n5. **Gambit thread API** is wrapped (`(std misc thread)`); some\n Gambit-specific primitives (e.g. `thread-yield!` quirks) are not\n 1:1 \u2014 see `docs/concurrency-extended.md`.\n\n## License\n\nApache 2.0\n"} {"text": "<!-- FILE: JERBOA-LANG.md -->\n# The Jerboa Programming Language\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own\nlanguage \u2014 with features that differ from and exceed Gerbil. All user-facing code is\nwritten in `.ss` files. The `.sls` files are implementation internals.\n\n## Quick Start\n\n```scheme\n;; hello.ss\n(import (jerboa prelude))\n\n(def (main)\n (def name \"world\")\n (displayln (str \"Hello, \" name \"!\")))\n\n(main)\n```\n\nRun with:\n```\nscheme --libdirs lib --script hello.ss\n```\n\nOne import gives you the entire language:\n```scheme\n(import (jerboa prelude))\n```\n\n---\n\n## Table of Contents\n\n1. [File Structure](#file-structure)\n2. [Reader Syntax](#reader-syntax)\n3. [Definitions](#definitions)\n4. [Data Structures](#data-structures)\n5. [Pattern Matching](#pattern-matching)\n6. [Control Flow](#control-flow)\n7. [Error Handling](#error-handling)\n8. [Result Types](#result-types)\n9. [Iterators](#iterators)\n10. [Threading Macros](#threading-macros)\n11. [Ergonomic Typing](#ergonomic-typing)\n12. [Hash Tables](#hash-tables)\n13. [Functions & Combinators](#functions--combinators)\n14. [Standard Library](#standard-library)\n15. [FFI](#ffi)\n16. [Differences from Gerbil](#differences-from-gerbil)\n17. [Differences from Chez Scheme](#differences-from-chez-scheme)\n\n---\n\n## File Structure\n\nA Jerboa `.ss` file has this shape:\n\n```scheme\n(import (jerboa prelude))\n;; Optional extra imports for modules not in the prelude:\n;; (import (std net request))\n;; (import (std db sqlite))\n\n;; Definitions\n(def (my-function x y)\n (+ x y))\n\n;; Top-level code\n(displayln (my-function 1 2))\n```\n\nKey points:\n- **No `(library ...)` wrapper** \u2014 that's for `.sls` internals only\n- **`(import (jerboa prelude))`** gives you everything: core macros, runtime,\n result types, datetime, iterators, CSV, pretty-printer, JSON, paths, strings,\n lists, alists, hash tables, functional combinators, ergo typing, FFI, and more\n- For specialized modules not in the prelude, add extra imports\n\n---\n\n## Reader Syntax\n\nJerboa extends the Chez Scheme reader with Gerbil-inspired syntax.\n\n### Square Brackets \u2014 Plain Parentheses\n\nSquare brackets are interchangeable with parentheses, exactly like Gerbil and\nstock Chez Scheme. Use them freely in bindings, match clauses, cond, etc.:\n\n```scheme\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([i (in-range 5)]) (* i i))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### Curly Braces \u2192 Method Dispatch\n\n```scheme\n{draw canvas} ;; \u2192 (~ canvas 'draw)\n{move sprite 10 20} ;; \u2192 (~ sprite 'move 10 20)\n{name person} ;; \u2192 (~ person 'name)\n```\n\n### Keywords (trailing colon)\n\n```scheme\nname: ;; \u2192 keyword object #:name\ncolor: ;; \u2192 keyword object #:color\n(keyword? name:) ;; \u2192 #t\n```\n\n### Module Paths (Gerbil-style)\n\n```scheme\n:std/sort ;; \u2192 (std sort)\n:std/text/json ;; \u2192 (std text json)\n:std/misc/string ;; \u2192 (std misc string)\n```\n\nBoth forms work in `import`:\n```scheme\n(import :std/net/request) ;; Gerbil style\n(import (std net request)) ;; R6RS style \u2014 both are equivalent\n```\n\n### Heredoc Strings\n\n```scheme\n#<<END\nThis is a multi-line\nstring literal.\nEND\n```\n\n### Standard Scheme Syntax\n\nAll standard Chez Scheme reader features work:\n- `'expr` \u2014 quote\n- `` `expr `` \u2014 quasiquote, with `,expr` unquote and `,@expr` splicing\n- `#(1 2 3)` \u2014 vector\n- `#u8(1 2 3)` \u2014 bytevector\n- `#\\space`, `#\\newline`, `#\\x41` \u2014 characters\n- `#xFF`, `#b1010`, `#o77` \u2014 number radix prefixes\n- `#;expr` \u2014 datum comment (skip next form)\n- `#| ... |#` \u2014 block comment (nestable)\n- `#&value` \u2014 box\n- `#!void`, `#!eof` \u2014 void and eof literals\n\n---\n\n## Definitions\n\n### `def` \u2014 Define Variables and Functions\n\n```scheme\n;; Simple binding\n(def x 42)\n(def name \"Alice\")\n\n;; Function\n(def (add a b)\n (+ a b))\n\n;; Optional parameters (default values)\n(def (greet name (greeting \"hello\"))\n (str greeting \", \" name \"!\"))\n\n(greet \"Bob\") ;; \u2192 \"hello, Bob!\"\n(greet \"Bob\" \"howdy\") ;; \u2192 \"howdy, Bob!\"\n\n;; Rest arguments\n(def (first-and-rest first . rest)\n (list first rest))\n\n;; Type-checked parameters (via ergo)\n(def (add (x : number?) (y : number?)) : number?\n (+ x y))\n```\n\n### `def*` \u2014 Multiple Arities\n\n```scheme\n(def* greet\n ((name) (greet name \"hello\"))\n ((name greeting) (str greeting \", \" name \"!\")))\n```\n\n### `defrule` / `defrules` \u2014 Define Macros\n\n```scheme\n;; Single-pattern macro\n(defrule (swap! a b)\n (let ((tmp a)) (set! a b) (set! b tmp)))\n\n;; Multi-pattern macro\n(defrules my-or ()\n ((_ a) a)\n ((_ a b ...) (let ((t a)) (if t t (my-or b ...)))))\n```\n\n---\n\n## Data Structures\n\n### `defstruct` \u2014 Record Types\n\n```scheme\n(defstruct point (x y))\n\n;; Generated:\n;; make-point \u2014 constructor\n;; point? \u2014 predicate\n;; point-x \u2014 accessor\n;; point-y \u2014 accessor\n;; point-x-set! \u2014 mutator\n;; point-y-set! \u2014 mutator\n;; point::t \u2014 record type descriptor\n\n(def p (make-point 3 4))\n(point-x p) ;; \u2192 3\n(point-y-set! p 10)\n(point-y p) ;; \u2192 10\n```\n\n### Inheritance\n\n```scheme\n(defstruct shape (color))\n(defstruct (circle shape) (radius))\n\n(def c (make-circle \"red\" 5))\n(shape-color c) ;; \u2192 \"red\" (inherited field)\n(circle-radius c) ;; \u2192 5\n(shape? c) ;; \u2192 #t\n(circle? c) ;; \u2192 #t\n```\n\nOnly **single inheritance** is supported.\n\n### `defclass` \u2014 Alias for `defstruct`\n\n```scheme\n(defclass point (x y)) ;; same as defstruct\n(defclass (circle shape) (r)) ;; same as defstruct with parent\n```\n\n### `defrecord` \u2014 Struct with Pretty Printing\n\n```scheme\n(defrecord person (name age))\n\n;; Same as defstruct plus:\n;; person->alist \u2014 convert to association list\n;; Custom printer: #<person name=\"Alice\" age=30>\n```\n\n### `defmethod` \u2014 Method Dispatch\n\n```scheme\n(defstruct circle (radius))\n(defstruct rect (width height))\n\n(defmethod (area (self circle))\n (* 3.14159 (expt (circle-radius self) 2)))\n\n(defmethod (area (self rect))\n (* (rect-width self) (rect-height self)))\n\n;; Call with ~ or {} syntax\n(def c (make-circle 5))\n(~ c 'area) ;; \u2192 78.53975\n{area c} ;; \u2192 78.53975 (same thing)\n\n;; Methods with extra args\n(defmethod (move (self point) dx dy)\n (make-point (+ (point-x self) dx)\n (+ (point-y self) dy)))\n\n{move p 10 20} ;; \u2192 new point shifted by (10, 20)\n```\n\nMethod dispatch walks the inheritance chain \u2014 a method defined on `shape`\nworks on `circle` too.\n\n### `define-enum` \u2014 Enumeration Types\n\n```scheme\n(define-enum color (red green blue))\n\n;; Generated:\n;; color-red \u2192 0\n;; color-green \u2192 1\n;; color-blue \u2192 2\n;; color? \u2014 predicate (checks 0..2)\n;; color->name \u2014 number to string\n;; name->color \u2014 string to number\n```\n\n---\n\n## Pattern Matching\n\n### `match`\n\n```scheme\n(match value\n ;; Literal patterns\n (0 \"zero\")\n (#t \"true\")\n (\"hello\" \"greeting\")\n\n ;; Variable binding\n (x (str \"got: \" x)))\n\n;; List destructuring\n(match (list 1 2 3)\n ((list a b c) (+ a b c))) ;; \u2192 6\n\n;; Nested patterns\n(match '(1 (2 3))\n ((list a (list b c)) (+ a b c))) ;; \u2192 6\n\n;; Cons patterns\n(match '(1 2 3)\n ((cons head tail) head)) ;; \u2192 1\n\n;; Predicate patterns\n(match 42\n ((? string?) \"a string\")\n ((? number?) \"a number\")) ;; \u2192 \"a number\"\n\n;; Guards\n(match x\n (n (where (> n 0)) \"positive\")\n (n (where (< n 0)) \"negative\")\n (_ \"zero\"))\n\n;; Logical combinators\n(match x\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\" \"true\") #t)\n ((not #f) \"truthy\"))\n\n;; Wildcard\n(match x\n (_ \"anything\"))\n\n;; View patterns \u2014 apply function, match result\n(match \"123\"\n ((=> string->number n) (+ n 1))) ;; \u2192 124\n\n;; Struct patterns (requires define-match-type registration)\n(define-match-type point point? point-x point-y)\n(match (make-point 3 4)\n ((point x y) (+ x y))) ;; \u2192 7\n```\n\n### `match/strict` \u2014 Exhaustiveness-Checked Matching\n\n```scheme\n(define-sealed-hierarchy shape\n (circle circle? circle-radius)\n (rect rect? rect-width rect-height))\n\n(match/strict shape my-shape\n ((circle r) (* 3.14 r r))\n ((rect w h) (* w h)))\n;; Warns at runtime if a variant is missing\n```\n\n### `define-active-pattern` \u2014 Custom Extractors\n\n```scheme\n(define-active-pattern (even? n)\n (and (number? n) (zero? (mod n 2)) n))\n\n(match 42\n ((even? n) (str n \" is even\")))\n```\n\n---\n\n## Control Flow\n\n### Conditionals\n\n```scheme\n;; Standard\n(if test then else)\n(cond (test1 expr1) (test2 expr2) (else default))\n(when test body ...)\n(unless test body ...)\n\n;; Anaphoric \u2014 binds result to `it`\n(awhen (find-user name)\n (send-email it))\n\n(aif (lookup key)\n (use it)\n (handle-missing))\n\n;; Conditional binding\n(when-let (x (get-thing))\n (process x))\n\n(if-let (user (find-user id))\n (greet user)\n (show-login))\n```\n\n### Loops\n\n```scheme\n;; Counted loop\n(dotimes (i 10)\n (displayln i)) ;; prints 0..9\n\n;; While/until\n(while (< x 10)\n (set! x (+ x 1)))\n\n(until (> x 10)\n (set! x (+ x 1)))\n\n;; Iterators (see Iterators section)\n(for ((x (in-range 10)))\n (displayln x))\n```\n\n### `assert!`\n\n```scheme\n(assert! (> x 0)) ;; raises error if false\n(assert! (> x 0) \"x must be positive\") ;; with message\n```\n\n---\n\n## Error Handling\n\n### `try` / `catch` / `finally`\n\n```scheme\n;; Basic try/catch\n(try\n (risky-operation)\n (catch (e)\n (displayln \"Error: \" (error-message e))))\n\n;; With predicate\n(try\n (/ 1 0)\n (catch (error? e)\n (displayln \"caught: \" e)))\n\n;; With finally (always runs)\n(try\n (def port (open-input-file \"data.txt\"))\n (process port)\n (catch (e)\n (displayln \"failed\"))\n (finally\n (close-input-port port)))\n```\n\n### Resource Management\n\n```scheme\n;; Guaranteed cleanup\n(unwind-protect\n (do-work)\n (cleanup))\n\n;; Resource lifecycle\n(with-resource (port (open-input-file \"f.txt\") close-input-port)\n (read-all-as-string port))\n\n;; Mutex\n(with-lock my-mutex\n (modify-shared-state))\n```\n\n---\n\n## Result Types\n\nRust-inspired `Result<T,E>` for composable error handling without exceptions.\n\n### Constructors & Predicates\n\n```scheme\n(ok 42) ;; success value\n(err \"not found\") ;; error value\n\n(ok? (ok 42)) ;; \u2192 #t\n(err? (err \"x\")) ;; \u2192 #t\n(result? (ok 1)) ;; \u2192 #t\n```\n\n### Extracting Values\n\n```scheme\n(unwrap (ok 42)) ;; \u2192 42\n(unwrap (err \"x\")) ;; raises error!\n\n(unwrap-or (err \"x\") 0) ;; \u2192 0 (safe default)\n(unwrap-or-else (err \"x\")\n (lambda () (compute-default))) ;; \u2192 lazy default\n\n(unwrap-err (err \"bad\")) ;; \u2192 \"bad\"\n```\n\n### Transforming Results\n\n```scheme\n;; Map over ok values\n(map-ok (lambda (x) (* x 2)) (ok 5)) ;; \u2192 (ok 10)\n(map-ok (lambda (x) (* x 2)) (err \"x\")) ;; \u2192 (err \"x\")\n\n;; Map over error values\n(map-err string-upcase (err \"bad\")) ;; \u2192 (err \"BAD\")\n\n;; Monadic bind (chain operations)\n(and-then (ok 5) (lambda (x)\n (if (> x 0) (ok (* x 2)) (err \"negative\"))))\n;; \u2192 (ok 10)\n\n;; Error recovery\n(or-else (err \"bad\") (lambda (e) (ok 0))) ;; \u2192 (ok 0)\n```\n\n### Exception \u2194 Result Conversion\n\n```scheme\n;; Wrap exceptions as err\n(try-result (/ 1 0)) ;; \u2192 (err <condition>)\n(try-result* (/ 1 0)) ;; \u2192 (err \"...message string...\")\n(try-result (+ 1 2)) ;; \u2192 (ok 3)\n```\n\n### Collection Operations\n\n```scheme\n;; All-or-nothing\n(sequence-results (list (ok 1) (ok 2) (ok 3)))\n;; \u2192 (ok (1 2 3))\n\n(sequence-results (list (ok 1) (err \"x\") (ok 3)))\n;; \u2192 (err \"x\")\n\n;; Partition successes and failures\n(results-partition (list (ok 1) (err \"a\") (ok 2)))\n;; \u2192 ((1 2) . (\"a\"))\n\n;; Filter\n(filter-ok (list (ok 1) (err \"a\") (ok 2))) ;; \u2192 (1 2)\n(filter-err (list (ok 1) (err \"a\") (ok 2))) ;; \u2192 (\"a\")\n```\n\n### Result-Aware Threading\n\n```scheme\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30)\n(->? (err \"x\") (+ 5) (* 2)) ;; \u2192 (err \"x\") \u2014 short circuits\n(->>? (ok 10) (- 3)) ;; \u2192 (ok -7) \u2014 thread last\n```\n\n---\n\n## Iterators\n\n### `for` \u2014 Side Effects\n\n```scheme\n(for ((x (in-range 5)))\n (displayln x))\n;; prints 0 1 2 3 4\n\n;; Multiple iterators (zipped, stops at shortest)\n(for ((name (in-list '(\"Alice\" \"Bob\")))\n (age (in-list '(30 25))))\n (displayln name \": \" age))\n```\n\n### `for/collect` \u2014 Build a List\n\n```scheme\n(for/collect ((x (in-range 5)))\n (* x x))\n;; \u2192 (0 1 4 9 16)\n```\n\n### `for/fold` \u2014 Accumulate\n\n```scheme\n(for/fold ((sum 0)) ((x (in-range 10)))\n (+ sum x))\n;; \u2192 45\n```\n\n### `for/or` \u2014 First Truthy\n\n```scheme\n(for/or ((x (in-list '(1 -2 3 -4))))\n (and (negative? x) x))\n;; \u2192 -2\n```\n\n### `for/and` \u2014 All Truthy\n\n```scheme\n(for/and ((x (in-list '(2 4 6))))\n (even? x))\n;; \u2192 #t\n```\n\n### Iterator Constructors\n\n| Constructor | Description | Example |\n|-------------|-------------|---------|\n| `(in-list lst)` | Iterate over list | `(in-list '(a b c))` |\n| `(in-vector vec)` | Iterate over vector | `(in-vector #(1 2 3))` |\n| `(in-string str)` | Iterate over chars | `(in-string \"abc\")` |\n| `(in-range end)` | 0 to end-1 | `(in-range 5)` \u2192 0..4 |\n| `(in-range start end)` | start to end-1 | `(in-range 2 5)` \u2192 2..4 |\n| `(in-range start end step)` | with step | `(in-range 0 10 2)` \u2192 0,2,4,6,8 |\n| `(in-hash-keys ht)` | Hash table keys | |\n| `(in-hash-values ht)` | Hash table values | |\n| `(in-hash-pairs ht)` | Key-value pairs | `(key . val)` |\n| `(in-naturals)` | 0, 1, 2, ... | Bounded to 100k |\n| `(in-naturals start)` | start, start+1, ... | |\n| `(in-indexed lst)` | `(idx . elem)` pairs | |\n| `(in-port [port [reader]])` | Read datums | |\n| `(in-lines [port])` | Read lines | |\n| `(in-chars [port])` | Read characters | |\n| `(in-bytes [port])` | Read bytes | |\n| `(in-producer thunk [sentinel])` | Call thunk until done | |\n\n---\n\n## Threading Macros\n\n### `->` Thread First\n\nInsert value as **first** argument at each step:\n\n```scheme\n(-> 10\n (+ 5) ;; (+ 10 5) \u2192 15\n (* 2)) ;; (* 15 2) \u2192 30\n```\n\n### `->>` Thread Last\n\nInsert value as **last** argument:\n\n```scheme\n(->> '(1 2 3 4 5)\n (filter even?) ;; (filter even? '(...)) \u2192 (2 4)\n (map (cut * <> 10)) ;; (map ... '(2 4)) \u2192 (20 40)\n (apply +)) ;; \u2192 60\n```\n\n### `as->` Thread with Explicit Name\n\n```scheme\n(as-> 1 x\n (+ x 10) ;; \u2192 11\n (* x 2) ;; \u2192 22\n (- 100 x)) ;; \u2192 78\n```\n\n### `some->` / `some->>` Short-Circuit on `#f`\n\n```scheme\n(some-> user\n (get-address) ;; returns #f if no address\n (get-city)) ;; skipped if previous was #f\n;; \u2192 city or #f\n```\n\n### `cond->` / `cond->>` Conditional Steps\n\n```scheme\n(cond-> base-query\n include-deleted? (add-filter \"deleted = true\")\n limit (add-limit limit))\n```\n\n---\n\n## Ergonomic Typing\n\n### `:` Type Cast\n\n```scheme\n(: value predicate?) ;; checked cast \u2014 raises if wrong type\n(: x number?) ;; asserts x is a number\n```\n\n### `using` \u2014 Typed Bindings with Dot Access\n\n```scheme\n(defstruct point (x y))\n\n(using (p (make-point 3 4) : point?)\n (+ p.x p.y)) ;; p.x \u2192 (point-x p)\n;; \u2192 7\n\n;; Multiple bindings\n(using ((p (make-point 1 2) : point?)\n (c (make-circle 5) : circle?))\n (displayln p.x c.radius))\n\n;; `as` skips the type check (trust mode)\n(using (p some-expr as point?)\n p.x)\n```\n\n### Contract Predicates\n\n```scheme\n;; Predicate factory \u2014 returns a predicate\n((list-of? number?) '(1 2 3)) ;; \u2192 #t\n((list-of? string?) '(1 2 3)) ;; \u2192 #f\n\n;; Maybe \u2014 accepts #f or matching value\n((maybe string?) \"hello\") ;; \u2192 #t\n((maybe string?) #f) ;; \u2192 #t\n((maybe string?) 42) ;; \u2192 #f\n```\n\n---\n\n## Hash Tables\n\n### Construction\n\n```scheme\n;; Empty\n(def ht (make-hash-table))\n\n;; From pairs (literal macro)\n(def ht (hash-literal (\"name\" \"Alice\") (\"age\" 30)))\n\n;; From list of pairs\n(def ht (list->hash-table '((\"a\" . 1) (\"b\" . 2))))\n\n;; From property list\n(def ht (plist->hash-table '(\"name\" \"Alice\" \"age\" 30)))\n```\n\n### Access\n\n```scheme\n(hash-ref ht \"name\") ;; \u2192 \"Alice\" (error if missing)\n(hash-ref ht \"missing\" \"default\") ;; \u2192 \"default\"\n(hash-get ht \"name\") ;; \u2192 \"Alice\" or #f\n(hash-key? ht \"name\") ;; \u2192 #t\n```\n\n### Mutation\n\n```scheme\n(hash-put! ht \"email\" \"alice@example.com\")\n(hash-update! ht \"age\" add1)\n(hash-remove! ht \"email\")\n(hash-merge! target source) ;; merge source into target\n```\n\n### Iteration\n\n```scheme\n(hash-for-each (lambda (k v) (displayln k \": \" v)) ht)\n(hash-map (lambda (k v) (cons k (add1 v))) ht)\n(hash-fold (lambda (k v acc) (+ acc v)) 0 ht)\n\n;; With iterators\n(for ((k (in-hash-keys ht)))\n (displayln k))\n(for (((k . v) (in-hash-pairs ht)))\n (displayln k \" \u2192 \" v))\n```\n\n### Conversion\n\n```scheme\n(hash->list ht) ;; \u2192 ((key . val) ...)\n(hash->plist ht) ;; \u2192 (key val key val ...)\n(hash-keys ht) ;; \u2192 (key ...)\n(hash-values ht) ;; \u2192 (val ...)\n(hash-length ht) ;; \u2192 count\n(hash-copy ht) ;; \u2192 shallow copy\n```\n\n### Destructuring\n\n```scheme\n(let-hash ht (name age)\n (displayln name \" is \" age))\n```\n\n---\n\n## Functions & Combinators\n\n### Partial Application\n\n```scheme\n;; cut / cute (SRFI-26) \u2014 <> marks slots\n((cut + 1 <>) 5) ;; \u2192 6\n((cut map <> '(1 2 3)) add1) ;; \u2192 (2 3 4)\n((cut string-append <> \"!\" <>) \"hi\" \"?\") ;; \u2192 \"hi!?\"\n\n;; partial (Clojure-style)\n((partial + 10) 5) ;; \u2192 15\n```\n\n### Composition\n\n```scheme\n((compose add1 add1) 5) ;; \u2192 7\n((comp add1 (* 2)) 5) ;; same (alias)\n((complement even?) 3) ;; \u2192 #t\n((negate even?) 3) ;; \u2192 #t\n((constantly 42) 'anything) ;; \u2192 42\n(identity 42) ;; \u2192 42\n((flip cons) '(2 3) 1) ;; \u2192 (1 2 3)\n```\n\n### Higher-Order Utilities\n\n```scheme\n((conjoin positive? even?) 4) ;; \u2192 #t (both true)\n((disjoin zero? negative?) -1) ;; \u2192 #t (either true)\n((every-pred number? positive?) 5) ;; \u2192 #t\n((some-fn string? number?) \"hi\") ;; \u2192 #t\n\n((curry + 1) 2) ;; \u2192 3\n((juxt min max) 3 1 4 1 5) ;; \u2192 (1 5)\n((fnil + 0 0) #f 5) ;; \u2192 5 (replaces #f with 0)\n\n(def slow-fib (memo-proc fib)) ;; memoize a procedure\n```\n\n---\n\n## Standard Library\n\nEverything below is available from `(import (jerboa prelude))`.\n\n### Strings \u2014 `(std misc string)`\n\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\")\n(string-join '(\"a\" \"b\" \"c\") \",\") ;; \u2192 \"a,b,c\"\n(string-trim \" hello \") ;; \u2192 \"hello\"\n(string-prefix? \"hel\" \"hello\") ;; \u2192 #t\n(string-suffix? \"llo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index)\n(string-index \"hello\" #\\l) ;; \u2192 2\n(string-empty? \"\") ;; \u2192 #t\n(string-match? \"^[0-9]+$\" \"123\") ;; \u2192 #t\n(string-find \"[0-9]+\" \"abc123\") ;; \u2192 \"123\"\n(string-find-all \"[0-9]+\" \"a1b2\");; \u2192 (\"1\" \"2\")\n(str \"age: \" 25 \"!\") ;; \u2192 \"age: 25!\" (auto-coerce)\n```\n\n### Lists \u2014 `(std misc list)`\n\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3 3)) ;; \u2192 (1 2 3)\n(take '(1 2 3 4 5) 3) ;; \u2192 (1 2 3)\n(drop '(1 2 3 4 5) 3) ;; \u2192 (4 5)\n(take-last '(1 2 3 4) 2) ;; \u2192 (3 4)\n(drop-last '(1 2 3 4) 2) ;; \u2192 (1 2)\n(every number? '(1 2 3)) ;; \u2192 #t\n(any negative? '(1 -2 3)) ;; \u2192 #t\n(filter-map (lambda (x) (and (> x 0) (* x 2))) '(-1 2 -3 4))\n;; \u2192 (4 8)\n(group-by even? '(1 2 3 4 5))\n;; \u2192 ((#t 2 4) (#f 1 3 5))\n(zip '(1 2 3) '(a b c)) ;; \u2192 ((1 a) (2 b) (3 c))\n(frequencies '(a b a c b a)) ;; \u2192 ((a . 3) (b . 2) (c . 1))\n(partition even? '(1 2 3 4 5)) ;; \u2192 ((2 4) (1 3 5))\n(interleave '(1 2 3) '(a b c)) ;; \u2192 (1 a 2 b 3 c)\n(interpose \", \" '(\"a\" \"b\" \"c\")) ;; \u2192 (\"a\" \", \" \"b\" \", \" \"c\")\n(mapcat (lambda (x) (list x x)) '(1 2 3)) ;; \u2192 (1 1 2 2 3 3)\n(distinct '(1 2 1 3 2)) ;; \u2192 (1 2 3)\n(keep (lambda (x) (and (> x 0) x)) '(-1 2 -3 4)) ;; \u2192 (2 4)\n(split-at '(1 2 3 4 5) 3) ;; \u2192 ((1 2 3) (4 5))\n(reductions + 0 '(1 2 3)) ;; \u2192 (0 1 3 6)\n(append-map (lambda (x) (list x x)) '(1 2)) ;; \u2192 (1 1 2 2)\n(snoc '(1 2) 3) ;; \u2192 (1 2 3)\n```\n\n### Association Lists \u2014 `(std misc alist)`\n\n```scheme\n;; Construction\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n\n;; Access (q=eq?, v=eqv?, default=equal?)\n(aget '((name . \"Alice\")) 'name) ;; \u2192 \"Alice\"\n(agetq '((x . 1)) 'x) ;; \u2192 1\n\n;; Mutation\n(aset! '((x . 1)) 'x 2) ;; \u2192 ((x . 2))\n\n;; Property lists\n(pgetq '(x 1 y 2) 'y) ;; \u2192 2\n```\n\n### Sorting \u2014 `(std sort)`\n\n```scheme\n(sort '(3 1 2) <) ;; \u2192 (1 2 3)\n(sort! vec <) ;; in-place on vectors\n(stable-sort lst string<?) ;; preserves order of equal elements\n```\n\n### Formatting \u2014 `(std format)`\n\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"count: ~a\\n\" 42) ;; print to stdout\n(eprintf \"error: ~a\\n\" msg) ;; print to stderr\n```\n\n### JSON \u2014 `(std text json)`\n\n```scheme\n(def data (string->json-object \"{\\\"name\\\":\\\"Alice\\\",\\\"age\\\":30}\"))\n(hash-ref data \"name\") ;; \u2192 \"Alice\"\n\n(json-object->string (hash-literal (\"x\" 1) (\"y\" 2)))\n;; \u2192 \"{\\\"x\\\":1,\\\"y\\\":2}\"\n\n;; Port-based\n(read-json port)\n(write-json obj port)\n```\n\n### Paths \u2014 `(std os path)`\n\n```scheme\n(path-join \"/home\" \"user\" \"file.txt\") ;; \u2192 \"/home/user/file.txt\"\n(path-directory \"/home/user/f.txt\") ;; \u2192 \"/home/user\"\n(path-extension \"/home/user/f.txt\") ;; \u2192 \"txt\"\n(path-strip-extension \"file.txt\") ;; \u2192 \"file\"\n(path-absolute? \"/home\") ;; \u2192 #t\n(path-expand \"~/file\") ;; \u2192 \"/home/user/file\"\n```\n\n### File I/O \u2014 `(std misc ports)`\n\n```scheme\n(read-file-string \"data.txt\") ;; \u2192 entire file as string\n(read-file-lines \"data.txt\") ;; \u2192 list of lines\n(write-file-string \"out.txt\" \"hello\") ;; write string to file\n(read-all-as-string port) ;; read port to string\n```\n\n### CSV \u2014 `(std csv)`\n\n```scheme\n(csv->alists \"name,age\\nAlice,30\\nBob,25\")\n;; \u2192 (((name . \"Alice\") (age . \"30\"))\n;; ((name . \"Bob\") (age . \"25\")))\n\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" '((\"a\" \"b\") (\"1\" \"2\")))\n(rows->csv-string '((\"x\" \"y\") (\"1\" \"2\")))\n```\n\n### DateTime \u2014 `(std datetime)`\n\n```scheme\n(def now (datetime-now))\n(datetime-year now) ;; \u2192 2026\n(datetime->iso8601 now) ;; \u2192 \"2026-03-27T22:13:43Z\"\n\n;; Construction\n(make-datetime 2026 3 27 12 0 0)\n(make-date 2026 3 27)\n(make-time 12 30 0)\n\n;; Parsing\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(parse-date \"2026-03-27\")\n\n;; Arithmetic\n(datetime-add now (make-duration 3600 0)) ;; +1 hour\n(datetime-diff dt1 dt2) ;; \u2192 duration\n\n;; Comparison\n(datetime<? dt1 dt2)\n(datetime-min dt1 dt2)\n(datetime-clamp dt lower upper)\n\n;; Calendar\n(day-of-week (make-date 2026 3 27)) ;; \u2192 5 (Friday)\n(leap-year? 2024) ;; \u2192 #t\n(days-in-month 2026 2) ;; \u2192 28\n```\n\n### Pretty Printing \u2014 `(std debug pp)`\n\n```scheme\n(pp '(a b (c d (e f)))) ;; pretty-print to stdout\n(pp-to-string expr) ;; \u2192 formatted string\n(ppd expr) ;; deep pretty-print (shows internals)\n```\n\n### Error Constructors \u2014 `(std error)`\n\n```scheme\n(Error \"something went wrong\" irritant1 irritant2)\n(ContractViolation \"expected positive\" value)\n```\n\n---\n\n## FFI\n\n### Quick FFI\n\n```scheme\n(import (jerboa prelude))\n\n(c-declare \"#include <math.h>\")\n(def c-sqrt (c-lambda (double) double \"sqrt\"))\n(c-sqrt 2.0) ;; \u2192 1.4142135623730951\n```\n\n### `begin-ffi` Block\n\n```scheme\n(begin-ffi (my-getpid)\n (c-declare \"#include <unistd.h>\")\n (define my-getpid (c-lambda () int \"getpid\")))\n```\n\n### Direct Chez FFI\n\nFor more control, use Chez's native FFI directly:\n\n```scheme\n(import (chezscheme))\n(load-shared-object \"libm.so.6\")\n(def c-sin (foreign-procedure \"sin\" (double) double))\n```\n\n---\n\n## Additional Modules\n\nThese are **not** in the prelude \u2014 import them separately:\n\n```scheme\n;; Networking\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n\n;; Database\n(import (std db sqlite)) ;; SQLite bindings\n\n;; Concurrency\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std concur)) ;; Concurrency primitives\n\n;; Crypto\n(import (std crypto digest)) ;; SHA, MD5, etc.\n(import (std crypto cipher)) ;; AES, etc.\n\n;; Security\n(import (std security sandbox)) ;; Sandboxing\n(import (std security taint)) ;; Taint tracking\n\n;; Text processing\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std text regex)) ;; Regular expressions\n\n;; OS\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std os temp)) ;; Temp files\n```\n\n---\n\n## Differences from Gerbil\n\n| Feature | Gerbil | Jerboa |\n|---------|--------|--------|\n| Backend | Gambit | Chez Scheme |\n| Multiple inheritance | Yes | No (single only) |\n| `[...]` | Various uses | Always `(list ...)` |\n| `{...}` | Method call | Method call (same) |\n| `keyword:` | Keywords | Keywords (same) |\n| Module system | Gerbil modules | R6RS libraries (`.sls`) |\n| Compilation | `gxc` | Load from source / `compile-whole-program` |\n| `export` | `(export ...)` | Part of `(library ...)` form |\n| `##` primitives | Yes (Gambit) | No (use `(chezscheme)` imports) |\n| Iterators | `for/collect` etc. | Same syntax |\n| Result types | Not built-in | Built-in `ok`/`err` |\n| DateTime | Not built-in | Built-in `datetime` |\n| Ergo typing | Not built-in | Built-in `using`, `:` |\n| Threading macros | `->`, `->>` | Same + `->?`, `->>?` (result-aware) |\n\n---\n\n## Differences from Chez Scheme\n\n| Feature | Chez Scheme | Jerboa |\n|---------|-------------|--------|\n| File format | `.sls` with `(library ...)` | `.ss` with `(import ...)` |\n| `define` | `define` | `def` (preferred) |\n| Records | `define-record-type` | `defstruct` / `defclass` |\n| Hash tables | `(make-hashtable ...)` | `(make-hash-table)` with richer API |\n| Pattern matching | None built-in | `match` with guards, views, struct patterns |\n| Error handling | `guard` | `try`/`catch`/`finally` |\n| Macros | `define-syntax` | `defrule`/`defrules` (simpler), or `define-syntax` |\n| Strings | Basic | `string-split`, `string-join`, `str`, regex |\n| Lists | Basic | `take`, `drop`, `flatten`, `group-by`, `zip`, 50+ more |\n| Iteration | `do`, named `let` | `for`/`for/collect`/`for/fold` |\n| Method dispatch | None | `defmethod` + `~` / `{...}` |\n| FFI | `foreign-procedure` | `c-lambda` (simpler) + `foreign-procedure` |\n| JSON | None | Built-in `read-json`/`write-json` |\n| Paths | None | Built-in path operations |\n| CSV | None | Built-in CSV parsing |\n| Result type | None | Built-in `ok`/`err` monad |\n| DateTime | None | Built-in datetime library |\n\n---\n\n## The Jerboa Philosophy\n\n1. **One import to start**: `(import (jerboa prelude))` gives you a complete language\n2. **`.ss` files are the language**: You never need to write `.sls` files\n3. **Gerbil-familiar, Chez-powered**: Syntax is Gerbil-like, performance is Chez\n4. **Batteries included**: JSON, CSV, datetime, result types, iterators \u2014 all in the prelude\n5. **Functional first**: Threading macros, combinators, result monads \u2014 but mutation when needed\n6. **No boilerplate**: `def` over `define`, `defstruct` over `define-record-type`, `match` over nested `cond`\n"} {"text": "<!-- FILE: implement-me.md -->\n# Jerboa Runtime: Features to Implement\n\n## GC Finalizer Safety Net for Unclosed Resources\n\n**ID:** jerboa-finalizer-safety-net \n**Impact:** high \n**Votes:** 1\n\n### What\n\nRegister Chez guardians on resource-acquiring functions (`sqlite-open`, `tcp-connect`, `open-input-file`, etc.). When a resource is garbage collected without being explicitly closed, log a warning that includes the allocation site. This catches resource leaks that `with-resource` would have prevented, without crashing.\n\n### Why\n\nClaude-generated code frequently forgets `with-resource` and uses bare `(let ([db (sqlite-open ...)]) ...)`. The connection leaks silently and is only discovered in production under load. With a finalizer safety net, a warning appears in the log during testing so the leak is caught early.\n\n### Example\n\n```\nWARNING: sqlite handle #7 GC'd without close \u2014 allocated at handler.ss:42\n```\n\nDeveloper then wraps the `sqlite-open` in `with-resource`. Bug fixed before production.\n\n### How to Implement\n\nIn the relevant resource-opening functions (e.g. `sqlite-open` in `lib/std/db/sqlite.sls`, `tcp-connect` in `lib/std/net/tcp.sls`), register a Chez guardian after the resource is created:\n\n```scheme\n;; After creating the resource handle:\n(let ([guardian (make-guardian)])\n (guardian handle)\n (spawn\n (lambda ()\n (let loop ()\n (let ([collected (guardian)])\n (when collected\n (unless (resource-closed? collected)\n (log-warning\n (str \"WARNING: \" (resource-type-name collected)\n \" handle GC'd without close\"\n (if (resource-alloc-site collected)\n (str \" \u2014 allocated at \" (resource-alloc-site collected))\n \"\"))))\n (loop)))))))\n```\n\nKey details:\n- Use `make-guardian` (Chez SRFI-115 guardian API)\n- The guardian thread should be a daemon thread (low priority, doesn't prevent exit)\n- Capture the allocation site via `(call-with-current-continuation ...)` or a `(fluid-let ([*alloc-site* (current-source-location)]) ...)` wrapper at the call site\n- The warning should go to `current-error-port`, not `current-output-port`\n- This is opt-in per module \u2014 add to: `(std db sqlite)`, `(std net tcp)`, `(std net request)`, `(std os file)` at minimum\n\n### Affected Modules\n\n- `lib/std/db/sqlite.sls` \u2014 `sqlite-open`\n- `lib/std/net/tcp.sls` \u2014 `tcp-connect`, `tcp-listen`\n- `lib/std/net/request.sls` \u2014 any connection-holding handle\n- `lib/std/os/file.sls` \u2014 file handles opened without `with-resource`\n\n### Notes\n\n- The warning must NOT prevent GC or cause a crash \u2014 it is purely informational\n- In production, this can be silenced via `(set-resource-leak-warning! #f)`\n- This is a runtime change to the standard library, not an MCP tool\n"} -{"text": "<!-- FILE: AGENTS.md -->\n## The Jerboa Language \u2014 Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** \u2014 those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms \u2014 that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] \u2192 plain parentheses \u2014 same as Gerbil and Chez Scheme\n{method obj args} \u2192 (~ obj 'method args) \u2014 method dispatch\nname: \u2192 keyword #:name\n:std/sort \u2192 (std sort) \u2014 Gerbil-style module path\n#<<END ... END \u2192 heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` \u2192 `hash-key?` (Racket)\n- `hash-table-set!` \u2192 `hash-put!` (Racket)\n- `directory-exists?` \u2192 `file-directory?` (Gambit)\n- `eql?` \u2192 `eqv?` (Common Lisp)\n- `random-integer` \u2192 `random` (Gambit)\n- `read-line` \u2192 `get-line` wrapper (Gambit) \u2014 works with or without port arg\n- `force-output` \u2192 `flush-output-port` wrapper (Gambit) \u2014 works with or without port arg\n- `string-map` \u2192 char-level map (Racket/R7RS) \u2014 `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` \u2014 use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` \u2014 use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` \u2014 use `(defstruct name (fields ...))`\n- `raise` with a string \u2014 use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` \u2014 Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data \u2014 wrong in Jerboa)\n- `time->seconds` \u2014 use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` \u2014 Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` \u2014 no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args \u2014 Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` \u2014 Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` \u2014 Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` \u2014 Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` \u2014 Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` \u2014 Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` \u2014 Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` \u2014 Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` \u2014 R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` \u2014 Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` \u2014 Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` \u2014 NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` \u2014 NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` \u2014 takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` \u2014 takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` \u2014 Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; \u2192 make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; \u2192 color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; \u2192 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; \u2192 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions \u2192 (err condition)\n(try-result* expr) ;; exceptions \u2192 (err \"message string\")\n(sequence-results list-of-results) ;; \u2192 (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; \u2192 (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; \u2192 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access \u2192 (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory \u2192 #t\n((maybe string?) #f) ;; accepts #f or string \u2192 #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; \u2192 val or #f\n(hash-key? ht \"key\") ;; \u2192 #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; \u2192 \"a,b\"\n(string-trim \" hi \") ;; \u2192 \"hi\"\n(string-prefix? \"he\" \"hello\") ;; \u2192 #t\n(string-suffix? \"lo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index, not boolean!)\n(string-empty? \"\") ;; \u2192 #t\n(str \"age: \" 42 \"!\") ;; \u2192 \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3)) ;; \u2192 (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; \u2192 (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; \u2192 hash table\n(json-object->string ht) ;; \u2192 JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; \u2192 (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; \u2192 \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; \u2192 \"/a/b\"\n(path-extension \"file.txt\") ;; \u2192 \"txt\"\n(path-absolute? \"/home\") ;; \u2192 #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; \u2192 entire file\n(read-file-lines \"f.txt\") ;; \u2192 list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available \u2014 the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` \u2014 **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` \u2014 **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` \u2014 Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools \u2014 MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess \u2014 always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** \u2014 BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** \u2014 confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** \u2014 combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** \u2014 for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` \u2014 cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` \u2014 never guess function names |\n| Check function arity/args | `jerboa_function_signature` \u2014 prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` \u2014 one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` \u2014 use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` \u2014 maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` \u2014 source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` \u2014 prefer over bash `make` |\n| Run tests | `jerboa_run_tests` \u2014 prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` \u2014 common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` \u2014 fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` \u2014 use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` \u2014 balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` \u2014 type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` \u2014 see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error\u2192fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche \u2014 every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text": "<!-- FILE: AGENTS.md -->\n## The Jerboa Language \u2014 Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** \u2014 those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms \u2014 that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] \u2192 plain parentheses \u2014 same as Gerbil and Chez Scheme\n{method obj args} \u2192 (~ obj 'method args) \u2014 method dispatch\nname: \u2192 keyword #:name\n:std/sort \u2192 (std sort) \u2014 Gerbil-style module path\n#<<END ... END \u2192 heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` \u2192 `hash-key?` (Racket)\n- `hash-table-set!` \u2192 `hash-put!` (Racket)\n- `directory-exists?` \u2192 `file-directory?` (Gambit)\n- `eql?` \u2192 `eqv?` (Common Lisp)\n- `random-integer` \u2192 `random` (Gambit)\n- `read-line` \u2192 `get-line` wrapper (Gambit) \u2014 works with or without port arg\n- `force-output` \u2192 `flush-output-port` wrapper (Gambit) \u2014 works with or without port arg\n- `string-map` \u2192 char-level map (Racket/R7RS) \u2014 `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` \u2014 use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` \u2014 use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` \u2014 use `(defstruct name (fields ...))`\n- `raise` with a string \u2014 use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` \u2014 Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data \u2014 wrong in Jerboa)\n- `time->seconds` \u2014 use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` \u2014 Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` \u2014 no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args \u2014 Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` \u2014 Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` \u2014 Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` \u2014 Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` \u2014 Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` \u2014 Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` \u2014 Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` \u2014 Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` \u2014 R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` \u2014 Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` \u2014 Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` \u2014 NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` \u2014 NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` \u2014 takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` \u2014 takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` \u2014 Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; \u2192 make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; \u2192 color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; \u2192 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; \u2192 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions \u2192 (err condition)\n(try-result* expr) ;; exceptions \u2192 (err \"message string\")\n(sequence-results list-of-results) ;; \u2192 (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; \u2192 (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; \u2192 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access \u2192 (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory \u2192 #t\n((maybe string?) #f) ;; accepts #f or string \u2192 #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; \u2192 val or #f\n(hash-key? ht \"key\") ;; \u2192 #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; \u2192 \"a,b\"\n(string-trim \" hi \") ;; \u2192 \"hi\"\n(string-prefix? \"he\" \"hello\") ;; \u2192 #t\n(string-suffix? \"lo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index, not boolean!)\n(string-empty? \"\") ;; \u2192 #t\n(str \"age: \" 42 \"!\") ;; \u2192 \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3)) ;; \u2192 (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; \u2192 (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; \u2192 hash table\n(json-object->string ht) ;; \u2192 JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; \u2192 (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; \u2192 \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; \u2192 \"/a/b\"\n(path-extension \"file.txt\") ;; \u2192 \"txt\"\n(path-absolute? \"/home\") ;; \u2192 #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; \u2192 entire file\n(read-file-lines \"f.txt\") ;; \u2192 list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available \u2014 the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` \u2014 **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` \u2014 Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools \u2014 MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess \u2014 always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** \u2014 BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** \u2014 confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** \u2014 combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** \u2014 for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` \u2014 cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` \u2014 never guess function names |\n| Check function arity/args | `jerboa_function_signature` \u2014 prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` \u2014 one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` \u2014 use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` \u2014 maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` \u2014 source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` \u2014 prefer over bash `make` |\n| Run tests | `jerboa_run_tests` \u2014 prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` \u2014 common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` \u2014 fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` \u2014 use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` \u2014 balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` \u2014 type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` \u2014 see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error\u2192fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche \u2014 every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text": "<!-- FILE: libraries.md -->\n# Jerboa Library Gap Analysis\n\nGerbil has ~438 `:std/*` modules. Jerboa currently implements 51. This document tracks coverage and what's needed to close the gap.\n\n## Current Coverage (51 modules)\n\n| Category | Jerboa | Gerbil | Coverage |\n|----------|--------|--------|----------|\n| Core (sort, format, error, sugar, pregexp, logger, test) | 7 | ~15 | 47% |\n| text/* (json, csv, hex, base64, utf8, xml, yaml) | 7 | ~15 | 47% |\n| misc/* (string, list, alist, ports, channel, thread, process, queue, bytes, uuid, repr, completion) | 12 | ~38 | 32% |\n| os/* (path, env, signal, temporaries, fdio, epoll, inotify) | 7 | ~16 | 44% |\n| crypto/* (digest, cipher, hmac, pkey, kdf, etc) | 6 | ~9 | 67% |\n| net/* (request, httpd, ssl) | 3 | ~40+ | 8% |\n| db/* (leveldb, sqlite, postgresql) | 3 | ~4 | 75% |\n| cli/* (getopt) | 1 | ~4 | 25% |\n| srfi/* (13, 19) | 2 | ~60+ | 3% |\n| compress/* (zlib) | 1 | 0 | N/A |\n| pcre2 | 1 | 0 | N/A |\n\n## External chez-* Libraries\n\n### Already Integrated\n\n| Library | Wraps | Jerboa Modules |\n|---------|-------|---------------|\n| [chez-ssl](https://github.com/ober/chez-ssl) | OpenSSL TLS/TCP | `(std net ssl)` |\n| [chez-https](https://github.com/ober/chez-https) | HTTP client+server | `(std net request)`, `(std net httpd)` |\n| [chez-zlib](https://github.com/ober/chez-zlib) | zlib compression | `(std compress zlib)` |\n| [chez-pcre2](https://github.com/ober/chez-pcre2) | PCRE2 regex | `(std pcre2)` |\n| [chez-leveldb](https://github.com/ober/chez-leveldb) | LevelDB | `(std db leveldb)` |\n\n### Completed (New)\n\n| Library | Wraps | Jerboa Modules | Status |\n|---------|-------|---------------|--------|\n| [chez-epoll](https://github.com/ober/chez-epoll) | Linux epoll | `(std os epoll)` | Done |\n| [chez-inotify](https://github.com/ober/chez-inotify) | Linux inotify | `(std os inotify)` | Done |\n| [chez-crypto](https://github.com/ober/chez-crypto) | OpenSSL EVP | `(std crypto cipher)`, `(std crypto hmac)`, `(std crypto pkey)`, `(std crypto kdf)`, `(std crypto etc)` | Done |\n| [chez-sqlite](https://github.com/ober/chez-sqlite) | SQLite3 | `(std db sqlite)` | Done |\n| [chez-postgresql](https://github.com/ober/chez-postgresql) | libpq | `(std db postgresql)` | Done |\n\n### Replaced (No Longer Needed)\n\n| Library | Replaced By | Notes |\n|---------|------------|-------|\n| [chez-yaml](https://github.com/ober/chez-yaml) | Pure Scheme `(std text yaml)` | Roundtrip support: preserves comments, key ordering, scalar styles. No C dependency. 58 tests. |\n\n## Pure Scheme Modules (No External Deps)\n\n### High Priority \u2014 Commonly Used\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std iter)` | Iteration protocol | TODO |\n| `(std interface)` | Interface/protocol system | TODO |\n| `(std generic)` | Generic functions (CLOS-lite) | TODO |\n| `(std event)` | Event/sync system | TODO |\n| `(std coroutine)` | Coroutines via continuations | TODO |\n| `(std lazy)` | Lazy evaluation (delay/force) | TODO |\n| `(std values)` | Multiple-values utilities | TODO |\n| `(std ref)` | Generic ref/set! | TODO |\n| `(std contract)` | Design-by-contract | TODO |\n| `(std amb)` | Nondeterminism | TODO |\n| `(std net uri)` | URI parsing/encoding | TODO |\n| `(std net address)` | Network address parsing | TODO |\n| `(std net json-rpc)` | JSON-RPC protocol | TODO |\n| `(std parser)` | Parser combinators | TODO |\n| `(std protobuf)` | Protocol Buffers | TODO |\n\n### misc/* \u2014 Data Structures & Utilities\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std misc hash)` | Extended hash utilities | TODO |\n| `(std misc func)` | Function combinators | TODO |\n| `(std misc number)` | Number utilities | TODO |\n| `(std misc decimal)` | Decimal arithmetic | TODO |\n| `(std misc deque)` | Double-ended queue | TODO |\n| `(std misc pqueue)` | Priority queue | TODO |\n| `(std misc rbtree)` | Red-black tree | TODO |\n| `(std misc lru)` | LRU cache | TODO |\n| `(std misc dag)` | DAG operations | TODO |\n| `(std misc shuffle)` | Random shuffle | TODO |\n| `(std misc vector)` | Vector utilities | TODO |\n| `(std misc symbol)` | Symbol utilities | TODO |\n| `(std misc plist)` | Property lists | TODO |\n| `(std misc text)` | Text utilities | TODO |\n| `(std misc walist)` | Weak-alist | TODO |\n| `(std misc list-builder)` | List builder pattern | TODO |\n| `(std misc timeout)` | Timeout utilities | TODO |\n| `(std misc barrier)` | Thread barrier | TODO |\n| `(std misc rwlock)` | Read-write lock | TODO |\n| `(std misc concurrent-plan)` | Concurrent DAG executor | TODO |\n| `(std misc atom)` | Atomic reference | TODO |\n| `(std misc sync)` | Synchronization primitives | TODO |\n| `(std misc wg)` | WaitGroup | TODO |\n| `(std misc evector)` | Extensible vector | TODO |\n| `(std misc shared)` | Shared structure detection | TODO |\n| `(std misc path)` | Path utilities (beyond os/path) | TODO |\n| `(std misc prime)` | Prime numbers | TODO |\n| `(std misc template)` | String templates | TODO |\n\n### text/* \u2014 Text Processing\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std text base58)` | Base58 encode/decode | TODO |\n| `(std text utf16)` | UTF-16 utilities | TODO |\n| `(std text utf32)` | UTF-32 utilities | TODO |\n| `(std text char-set)` | Character sets (SRFI-14) | TODO |\n| `(std text zlib)` | zlib in text format | Covered by `(std compress zlib)` |\n\n### os/* \u2014 Operating System\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std os hostname)` | Get hostname | TODO |\n| `(std os pid)` | Process ID utilities | TODO |\n| `(std os pipe)` | Pipe creation | TODO |\n| `(std os flock)` | File locking | TODO |\n| `(std os fcntl)` | fcntl operations | TODO |\n| `(std os error)` | OS error codes | TODO |\n| `(std os fd)` | File descriptor utilities | TODO |\n| `(std os socket)` | Raw socket operations | TODO |\n| `(std os epoll)` | Linux epoll | Done |\n| `(std os inotify)` | Linux inotify | Done |\n| `(std os kqueue)` | BSD kqueue | N/A (Linux only) |\n| `(std os signalfd)` | Linux signalfd | TODO |\n\n### cli/* \u2014 Command Line\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std cli multicall)` | Busybox-style multicall | TODO |\n| `(std cli shell)` | Shell completion generation | TODO |\n| `(std cli print-exit)` | Print-and-exit patterns | TODO |\n\n### net/* \u2014 Networking (beyond HTTP)\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std net websocket)` | WebSocket client/server | TODO |\n| `(std net smtp)` | SMTP email sending | TODO |\n| `(std net socks)` | SOCKS proxy | TODO |\n| `(std net s3)` | AWS S3 client | TODO |\n| `(std net repl)` | Network REPL | TODO |\n| `(std net bio)` | Buffered network I/O | TODO |\n| `(std net socket)` | Socket abstraction | TODO |\n\n### markup/* \u2014 HTML/XML/TAL\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std markup html)` | HTML generation | TODO |\n| `(std markup xml)` | XML processing | Partially covered by `(std text xml)` |\n| `(std markup sxml)` | SXML processing | TODO |\n| `(std markup tal)` | TAL templates | TODO |\n\n### Other\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std mime types)` | MIME type database | TODO |\n| `(std io)` | Buffered I/O framework | TODO |\n| `(std debug DBG)` | Debug printing | TODO |\n| `(std debug heap)` | Heap analysis | TODO |\n| `(std debug threads)` | Thread debugging | TODO |\n| `(std web fastcgi)` | FastCGI protocol | TODO |\n| `(std web rack)` | Rack-style web framework | TODO |\n\n### srfi/* \u2014 Scheme Requests for Implementation\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std srfi 1)` | List library | TODO |\n| `(std srfi 8)` | receive (multiple values) | TODO |\n| `(std srfi 9)` | Records | TODO |\n| `(std srfi 14)` | Character sets | TODO |\n| `(std srfi 41)` | Streams (lazy lists) | TODO |\n| `(std srfi 42)` | Eager comprehensions | TODO |\n| `(std srfi 43)` | Vector library | TODO |\n| `(std srfi 78)` | Lightweight testing | TODO |\n| `(std srfi 95)` | Sorting and merging | TODO |\n| `(std srfi 101)` | Purely functional random-access pairs | TODO |\n| `(std srfi 113)` | Sets and bags | TODO |\n| `(std srfi 115)` | Regexp | TODO |\n| `(std srfi 116)` | Immutable pairs | TODO |\n| `(std srfi 117)` | Queues based on lists | TODO |\n| `(std srfi 121)` | Generators | TODO |\n| `(std srfi 124)` | Ephemerons | TODO |\n| `(std srfi 125)` | Hash tables | TODO |\n| `(std srfi 127)` | Lazy sequences | TODO |\n| `(std srfi 128)` | Comparators | TODO |\n| `(std srfi 130)` | Cursor-based string library | TODO |\n| `(std srfi 132)` | Sort libraries | TODO |\n| `(std srfi 133)` | Vector library (R7RS-compatible) | TODO |\n| `(std srfi 134)` | Immutable deques | TODO |\n| `(std srfi 135)` | Immutable texts | TODO |\n| `(std srfi 141)` | Integer division | TODO |\n| `(std srfi 143)` | Fixnums | TODO |\n| `(std srfi 144)` | Flonums | TODO |\n| `(std srfi 145)` | Assumptions | TODO |\n| `(std srfi 146)` | Mappings | TODO |\n| `(std srfi 151)` | Bitwise operations | TODO |\n| `(std srfi 158)` | Generators and accumulators | TODO |\n| `(std srfi 159)` | Combinator formatting | TODO |\n| `(std srfi 160)` | Homogeneous numeric vector | TODO |\n| `(std srfi 212)` | Aliases | TODO |\n\n## Actor System\n\nThe Gerbil actor system (v13 + v18, ~30+ modules) is deeply tied to the Gerbil runtime and would require significant design work to port. This is out of scope for initial coverage.\n\n## I/O System\n\nGerbil's `:std/io` subsystem (~30+ modules) provides a layered buffered I/O framework. Chez Scheme's built-in port system covers most use cases, but a compatibility layer could be built for code that depends on bio/strio APIs.\n"} {"text": "<!-- FILE: CLAUDE.md -->\n## Pre-commit Requirements\n\n**ALWAYS** run a clean build **before** committing any code to this repository. Pick the right target for the *current* platform:\n\n- **Linux**: run `make docker-build` \u2014 the Docker image must build cleanly against the full musl-static release pipeline.\n- **macOS / FreeBSD / other**: run `make binary` \u2014 the native local build must succeed. Do **not** run `make docker-build` here; Docker on non-Linux hosts is slow and not the canonical pipeline for those platforms.\n\nDo not commit if the build fails.\n\n## Act First, Read Less\n\nWhen making changes, read only what you need to make the edit, then make it.\nDo not read more than 3 files before acting. Do not re-read files you already\nread. Do not verify things you already know. If you have enough context to make\na change, make it. The user will interrupt you if you are wrong.\n\n"} {"text": "<!-- FILE: secure.md -->\n# Jerboa Secure Binary Strategy\n\n## The Problem\n\nJerboa compiles to Chez Scheme native code. A static musl binary (e.g., jerboa-secmon at 11MB) embeds:\n\n| Component | Size | ROP Gadgets |\n|-----------|------|-------------|\n| petite.boot | ~1.9MB | None (`.rodata` data) |\n| scheme.boot | ~1.0MB | None (data) |\n| app.boot | ~2.6MB | None (data) |\n| libkernel (Chez runtime) | ~1.0MB | **Thousands** \u2014 GC, compiler, thread scheduler, I/O |\n| musl libc | ~200KB | Some |\n| Rust native lib | ~500KB | Minimal (memory-safe code) |\n| ffi-shim + program | ~25KB | Minimal |\n\nThe Chez runtime (`libkernel`) is the primary source of ROP gadgets. At ~1MB of native code, it contains thousands of potentially usable gadget sequences. It is heavily interconnected (GC references compiler, compiler references I/O, I/O references threading) so `--gc-sections` removes very little.\n\nBoot files are pure data \u2014 zero gadget contribution. The Rust native library contributes minimal gadgets due to memory safety.\n\n---\n\n## Path 1: Harden the Chez Binary\n\n**Effort**: Days. **Impact**: Highest bang for buck.\n\nThis doesn't shrink the binary but makes gadgets effectively unusable through hardware and OS enforcement.\n\n### Intel CET (Control-flow Enforcement Technology)\n\nRequires CPU support (`ibt` and `user_shstk` in `/proc/cpuinfo`). Available on Intel 12th gen+ and AMD Zen 4+.\n\n#### Shadow Stack (SHSTK) \u2014 Priority: Very High\n\nHardware maintains a second copy of return addresses on a separate, protected shadow stack. On every `ret`, the CPU cross-checks the return address against the shadow copy. If they differ (because an attacker overwrote the real stack), the CPU faults with `#CP`.\n\nThis **directly defeats classical ROP**, which fundamentally relies on corrupted return addresses.\n\n**Chez compatibility**: Likely works without modification. Chez uses standard `call`/`ret` calling conventions. The JIT-generated code uses normal x86_64 function prologues/epilogues. Shadow stack enforcement should be transparent.\n\n**To enable**: Rebuild Chez with `-fcf-protection=return` (SHSTK only) or `-fcf-protection=full` (SHSTK + IBT). The binary must also be linked with CET-aware linker flags.\n\n#### Indirect Branch Tracking (IBT) \u2014 Priority: Medium\n\nEvery indirect jump/call target must begin with an `ENDBR64` instruction. If control flow arrives at a non-`ENDBR64` instruction via indirect branch, the CPU faults.\n\n**Chez compatibility**: Problematic. Chez's code generator emits native x86_64 code at runtime (during `compile-program` and boot file loading). This JIT-generated code does **not** have `ENDBR64` instructions at function entries. IBT will fault on calls into Chez-compiled code.\n\n**Fix**: Patch Chez's code generator (`compile.ss` and `gc.c`) to emit `ENDBR64` (4 bytes: `f3 0f 1e fa`) at every compiled function entry point. This is a targeted change \u2014 feasible but requires understanding Chez internals.\n\n**Alternative**: Enable SHSTK-only mode via `prctl(PR_SET_SHADOW_STACK, ...)` without IBT. Gets return-address protection without the indirect-branch requirement.\n\n### Standard Hardening CFLAGS\n\nRebuild Chez and all C code with:\n\n```\n-fstack-protector-strong # Stack canaries on functions with arrays/address-taken vars\n-fstack-clash-protection # Probe large stack allocations (prevent guard-page bypass)\n-fcf-protection=full # CET: shadow stack + indirect branch tracking\n-D_FORTIFY_SOURCE=2 # Compile-time and runtime buffer overflow checks\n-Wl,-z,relro,-z,now # Full RELRO (read-only GOT/PLT after startup)\n-pie # Position-independent executable (for ASLR)\n```\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** \u2014 all of the above are now applied by\ndefault. The `build-musl-binary` and `musl-link-command` functions automatically add these\nflags. Pass `no-harden: #t` to disable for debugging. CET flags (`-fcf-protection=full`)\nare only added on x86_64 Linux machine types.\n\n**Status: DONE in `jerboa-native-rs/.cargo/config.toml`** \u2014 Rust builds now pass\n`-Wl,-z,relro,-z,now` for all targets and `-fcf-protection=full` for x86_64 Linux.\n\n**NOT YET DONE \u2014 downstream projects**: jerboa-secmon and jerboa-dns have their own\nbuild scripts (`build-secmon-musl.ss`, `build-secmon-musl.sh`, `Dockerfile`) that hardcode\n`musl-gcc -c -O2` and `musl-gcc -static` directly instead of using `(jerboa build musl)`.\nThese need the same flags added manually, or better, ported to use the shared build module.\n\n**NOT YET DONE \u2014 Chez Scheme itself (libkernel.a)**: This is the biggest gap. The\nDockerfile builds Chez with `./configure --threads --disable-x11 --static CC=musl-gcc`\nand no `CFLAGS` override. The resulting `libkernel.a` \u2014 the ~1MB primary source of ROP\ngadgets \u2014 has **zero hardening**: no stack canaries, no CET, no FORTIFY_SOURCE. Fix by\npassing hardening flags when building Chez:\n\n```bash\n./configure --threads --disable-x11 --static \\\n CC=musl-gcc \\\n CFLAGS=\"-O2 -fstack-protector-strong -fstack-clash-protection -D_FORTIFY_SOURCE=2 -fPIE -fcf-protection=full\"\n```\n\nThis is the single highest-impact change remaining \u2014 it hardens the code that contributes\nthe most ROP gadgets.\n\n### Static PIE\n\nSwitch musl build from `-static` to **`-static-pie`**. This enables full ASLR for the entire binary \u2014 the base address, stack, heap, and mmap regions are all randomized on each execution.\n\nStatic linking actually slightly increases the gadget set (musl code is embedded rather than at a separate randomized address), but static PIE with ASLR makes all gadget addresses unpredictable. An attacker needs an information leak before they can chain gadgets.\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** \u2014 `musl-link-command` now uses\n`-static-pie` by default instead of `-static`.\n\n### Namespace Isolation\n\nAdd Linux namespace isolation to the security cage module (`lib/std/security/cage.sls`). After initialization, call:\n\n```c\nunshare(CLONE_NEWPID | CLONE_NEWNS | CLONE_NEWNET)\n```\n\nThis creates:\n- **PID namespace**: Process can't see or signal other processes\n- **Mount namespace**: Process sees only an allow-listed filesystem\n- **Network namespace**: Process has only its own network stack (or a specific pre-bound socket)\n\nCombined with existing seccomp + Landlock/Capsicum, this creates micro-VM-like isolation without VM overhead.\n\n**Requirement**: `CAP_SYS_ADMIN` or unprivileged user namespaces enabled (`sysctl kernel.unprivileged_userns_clone=1`).\n\n### Hardening Summary\n\n| Technique | Works with Chez JIT? | Effort | ROP Impact |\n|-----------|---------------------|--------|------------|\n| **SHSTK (shadow stack)** | Likely yes | Low (rebuild Chez) | **Directly defeats ROP** |\n| **IBT (indirect branch)** | No (needs Chez patch) | High | Constrains gadgets to function entries |\n| Stack canaries | C code only, not JIT | Low (add CFLAG) | Detects stack buffer overflows |\n| Static PIE + ASLR | Yes | Low (change linker flag) | Gadget addresses unpredictable |\n| `-fstack-clash-protection` | Yes | Trivial | Prevents guard-page bypass |\n| seccomp post-init | Yes | **Already done** | Blocks ptrace, process_vm_readv |\n| Landlock/Capsicum post-init | Yes | **Already done** | Blocks filesystem escape |\n| Anti-debug | Yes | **Already done** | Blocks dynamic analysis |\n| Integrity verification | Yes | **Already done** | Detects binary modification |\n| Namespace isolation | Yes | Medium | PID/mount/network containment |\n\n### FreeBSD Portability (Path 1)\n\n**Intel CET is not available on any released FreeBSD.** Kernel SHSTK plumbing exists in\n15-CURRENT only (Konstantin Belousov's work). IBT enforcement has not been implemented.\nUserland CET support (rtld awareness, base compiled with `-fcf-protection`) is incomplete\neven in -CURRENT. This means the highest-value ROP mitigation \u2014 hardware shadow stacks \u2014\nis Linux-only for the foreseeable future.\n\n**What FreeBSD 14.x provides today:**\n\n| Feature | FreeBSD Status | vs Linux |\n|---------|---------------|----------|\n| ASLR + PIE | On by default since 13.0 | **Lower entropy**: ~14 bits (stack) vs Linux ~22 bits |\n| Stack canaries (`-strong`) | Since 12.0 | Comparable |\n| `_FORTIFY_SOURCE=2` | Since 14.0 | Linux distros had this since ~2006 |\n| Full RELRO + BIND_NOW | Since 12.0 | Comparable |\n| Stack clash protection | Since ~13.x (clang) | Comparable |\n| Capsicum capability mode | Mature, since 9.0 | No Linux equivalent (seccomp is different) |\n| ARM PAC | Since 13.0 (arm64) | Comparable (Linux 5.0+) |\n| ARM BTI | Since 14.0 (arm64) | Comparable (Linux 5.10+) |\n| W^X opt-in (PROTMAX) | Since 14.0 via `procctl` | Linux has `prctl(SET_MDWE)` since 6.3 |\n| SafeStack | Available (clang), not default | Same on Linux |\n\n**The Capsicum vs seccomp gap for ROP containment:**\n\nCapsicum and seccomp solve different problems. Capsicum restricts *which resources* a process\ncan access (file descriptors, paths). seccomp restricts *which syscalls* a process can make.\n\nFor ROP mitigation specifically, seccomp has a critical advantage: it can **block\n`mprotect(PROT_EXEC)`** after initialization, preventing a ROP chain from making attacker-\ncontrolled data executable (the typical second stage after gaining control flow). Capsicum\ncannot do this \u2014 it does not filter memory operations.\n\nFreeBSD's `procctl(PROC_PROTMAX_CTL)` partially addresses this gap: when enabled, the\nmaximum protection on a mapping is set at `mmap` time and cannot be escalated via `mprotect`.\nHowever, this breaks Chez's JIT pattern (`mmap(RW)` then `mprotect(RX)`) unless all JIT\ncompilation completes before PROTMAX is enabled. A post-init PROTMAX call \u2014 after boot files\nare loaded and all code is compiled \u2014 could work but requires careful sequencing.\n\n**FreeBSD-specific hardening not available on Linux:**\n\n- **Capsicum**: Process-level capability confinement with per-fd rights limiting. More\n principled than seccomp for resource access control. Already integrated into Jerboa's\n cage module.\n- **HardenedBSD**: A FreeBSD fork with PaX-like features (strict W^X via NOEXEC, SEGVGUARD\n for brute-force ASLR defeat prevention, mandatory SafeStack). Tracks FreeBSD 14/15\n branches. Worth considering as a deployment target for maximum hardening.\n\n**Practical implication**: On FreeBSD, the lack of CET makes **Path 2 (WASM sandbox) more\nimportant** than on Linux. Without hardware return-address protection, software isolation of\nsecurity-critical parsers becomes the primary ROP defense rather than a defense-in-depth layer.\n\n**ARM64 FreeBSD** (e.g., AWS Graviton) is a notable bright spot: PAC (since 13.0) provides\nhardware return-address signing, and BTI (since 14.0) provides landing-pad enforcement. These\nare the ARM equivalents of CET SHSTK and IBT respectively, and they are available on released\nFreeBSD. For maximum hardware security on FreeBSD, target arm64.\n\n---\n\n## Path 2: WASM Sandbox for Parsers\n\n**Effort**: Weeks. **Impact**: Strongest isolation for the most-attacked code.\n\n### Why WASM Eliminates ROP\n\nWebAssembly is **structurally immune** to classical ROP:\n\n- **Separate code and data spaces**: Linear memory (where attacker-controlled input lives) cannot address the code section. You cannot scan executable pages for gadget sequences because they are in a completely separate address space managed by the runtime.\n- **No raw jumps**: All control flow uses `block`/`loop`/`if`/`br`/`br_table`. There is no `ret` instruction that pops an address off the stack.\n- **Opaque execution stack**: The WASM call stack is managed by the runtime, invisible to guest code. Buffer overflows in linear memory cannot overwrite return addresses because return addresses don't exist in linear memory.\n- **Typed indirect calls**: `call_indirect` validates function type signatures at runtime. You cannot redirect an indirect call to an arbitrary function.\n\nEven with arbitrary write within WASM linear memory, an attacker cannot hijack control flow. The attack surface shifts entirely to bugs in the WASM runtime itself.\n\n### Architecture: Split Design\n\n```\nJerboa binary\n\u251c\u2500\u2500 Chez runtime (orchestration, policy, configuration DSL)\n\u251c\u2500\u2500 Rust native lib (crypto via ring, TLS via rustls)\n\u2514\u2500\u2500 wasmi WASM interpreter (security-critical parsers)\n \u251c\u2500\u2500 dns_parser.wasm (DNS packet parsing)\n \u251c\u2500\u2500 http_parser.wasm (HTTP request parsing)\n \u2514\u2500\u2500 proto_fsm.wasm (protocol state machines)\n```\n\nSecurity-critical parsing code is written in Rust, compiled to `.wasm`, and executed inside an interpreter-mode WASM runtime embedded in the Jerboa binary. The Chez/Jerboa layer handles orchestration, policy evaluation, and configuration.\n\n### WASM Runtime Options\n\n| Runtime | Binary overhead | Mode | Gadgets in runtime | Best for |\n|---------|----------------|------|-------------------|----------|\n| **wasm3** | ~100KB static | Interpreter | Near-zero (tiny loop) | Maximum minimality |\n| **WAMR** | ~50-85KB | Interpreter | Near-zero | Embedded/IoT |\n| **wasmi** | ~2-3MB as Rust lib | Interpreter | Near-zero | Pure Rust, integrates with jerboa-native-rs |\n| **Wasmtime** | ~15-20MB | JIT (Cranelift) | Some (JIT code) | Full WASI, best tooling |\n\n**Key insight**: Interpreter-mode runtimes generate **zero native code at runtime**. The entire attack surface is the statically-compiled interpreter loop. A wasm3 interpreter is ~3,000 lines of C. Compare that to the millions of gadget-contributing instructions in Chez's runtime.\n\n### Integration with jerboa-native-rs\n\nAdd wasmi as a dependency in `jerboa-native-rs/Cargo.toml`. Expose FFI functions:\n\n```rust\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_load(module_bytes: *const u8, len: usize) -> i32;\n\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_call(\n func_name: *const u8, name_len: usize,\n input: *const u8, input_len: usize,\n output: *mut u8, output_len: usize,\n actual_len: *mut usize\n) -> i32;\n```\n\nScheme code calls through `foreign-procedure`:\n\n```scheme\n(define wasm-call\n (foreign-procedure \"jerboa_wasm_call\" (string int u8* int u8* int void*) int))\n```\n\n### Performance\n\nInterpreter-mode WASM is 10-100x slower than native. For a DNS server, the bottleneck is network I/O, not parsing compute. A DNS response parser running in wasm3 at 1/50th native speed still finishes in microseconds \u2014 acceptable for security-critical paths.\n\n### Existing WASM Infrastructure\n\nJerboa already has embryonic WASM support in `lib/jerboa/wasm/`:\n- `codegen.sls` \u2014 Compile restricted Scheme subset to WASM binary (i32-only, no closures)\n- `runtime.sls` \u2014 Stack-based WASM interpreter for testing\n- `format.sls` \u2014 LEB128 encoding, section parsing, binary format primitives\n\nThis is currently educational/testing-grade but the format layer is real and could serve as a foundation.\n\n---\n\n## Path 3: Minimal Interpreter Binary\n\n**Effort**: Months. **Impact**: Smallest possible footprint (~500KB).\n\nFor tools where binary size and gadget count are the absolute priority, replace the Chez runtime entirely with a minimal Scheme interpreter.\n\n### s7 Scheme\n\n- Single C file, ~35,000 lines. Compiles to **~400KB**.\n- Interpreter-only: no JIT means no W+X pages, no dynamically generated gadgets.\n- Full access to C hardening flags: `-fcf-protection=full`, `-fstack-protector-strong`, etc.\n- R7RS-ish with extensions. Not Chez-compatible.\n- ~50-100x slower than Chez for compute-heavy code. Acceptable for I/O-bound servers.\n\n### Architecture\n\n```\nStatic binary (~500KB-1MB)\n\u251c\u2500\u2500 s7 Scheme interpreter (400KB, fully hardened C)\n\u251c\u2500\u2500 Rust native lib (crypto, TLS, WASM runtime)\n\u2514\u2500\u2500 Application logic in s7 Scheme\n```\n\n### Tradeoff\n\nThis means **leaving Jerboa** for those specific tools. You'd be writing a different program in a different Scheme dialect. The Jerboa prelude, reader syntax, defstruct/defclass/defmethod, capability system, effects, contracts \u2014 none of it carries over.\n\nThis path only makes sense if you're willing to write the security tools as standalone projects that don't depend on Jerboa's ecosystem. Jerboa could still be used for development, prototyping, and testing, with the production binary being a separate s7-based build.\n\n---\n\n## Approaches NOT Worth Pursuing\n\n### Scheme-to-Rust Transpilation\n\nFundamental type system mismatch makes automated translation impossible:\n- **Continuations**: Chez's `call/cc` captures the native stack. Rust has no equivalent.\n- **Garbage collection**: Scheme values are GC-managed. Rust uses ownership. No mechanical translation exists.\n- **Dynamic typing**: Every Scheme value is a tagged pointer. Translating to Rust means `enum Value { Int(i64), String(Rc<String>), ... }` everywhere, losing Rust's type safety benefits.\n\nNo tool exists for this. Building one would take years. The few academic efforts (Ribbit Scheme) produce minimal subsets lacking Jerboa's features.\n\n### Alternative Scheme Compilers (Chicken, Gambit)\n\nChicken compiles Scheme to C via Cheney-on-the-MTA. A minimal program produces a ~400KB binary. Gambit is similar but larger (~1-2MB). Both give full access to C hardening flags.\n\n**What you lose**: Chez's native-code performance (3-10x slower), the entire Jerboa prelude, all MCP tooling, reader syntax extensions, defstruct/defclass/defmethod, the capability system, taint tracking, effects, contracts.\n\nNot worth it unless starting from scratch.\n\n### Full LTO Across Chez + Rust\n\nNot technically feasible. Chez's `libkernel.a` is pre-built; LTO would require recompiling Chez with `-flto`. Even then, cross-language LTO (C + Rust) is not supported by current toolchains for this combination.\n\n---\n\n## Recommended Architecture\n\n### Target: Self-Sandboxing Static PIE Binary\n\nThe architecture adapts to platform capabilities. WASM-sandboxed parsing is the\nuniversal constant; OS-level confinement and hardware enforcement vary.\n\n```\n+--------------------------------------------------+\n| Static PIE ELF (~8MB) |\n| Full ASLR + platform-specific HW enforcement |\n| |\n| +-----------+ +-----------+ +---------------+ |\n| | Chez | | Rust | | wasmi WASM | |\n| | Runtime | | Native | | Interpreter | |\n| | | | (ring, | | (DNS parser | |\n| | | | rustls) | | in sandboxed | |\n| | | | | | WASM module) | |\n| +-----------+ +-----------+ +---------------+ |\n| |\n| Jerboa orchestration layer: |\n| - Capability-gated network I/O |\n| - Policy evaluation (who queries what) |\n| - Audit logging (hash-chain) |\n| - Configuration via Jerboa DSL |\n| |\n| Post-init self-sandbox (platform-dependent): |\n| +---------------------+------------------------+ |\n| | Linux | FreeBSD | |\n| +---------------------+------------------------+ |\n| | CET/SHSTK (hw ROP) | ARM PAC+BTI (arm64) | |\n| | seccomp (syscall | Capsicum (resource | |\n| | filter, block | confinement, block | |\n| | mprotect(EXEC)) | path-based access) | |\n| | Landlock (fs paths) | PROTMAX (post-init, | |\n| | Namespaces (PID, | block mprotect | |\n| | mount, network) | escalation) | |\n| | Anti-debug (ptrace) | Anti-debug (ptrace) | |\n| | Integrity check | Integrity check | |\n| +---------------------+------------------------+ |\n+--------------------------------------------------+\n```\n\n### Defense Layers by Platform\n\n**Linux (x86_64 with CET)** \u2014 Six independent layers:\n\n1. **ASLR** (~22 bits entropy) \u2014 Information leak to discover gadget addresses\n2. **CET/SHSTK** \u2014 Hardware bypass to use corrupted return addresses\n3. **WASM sandbox** \u2014 Runtime bug to escape parser isolation\n4. **seccomp** \u2014 Kernel exploit to make blocked syscalls (including `mprotect(EXEC)`)\n5. **Namespaces** \u2014 Kernel exploit to escape PID/mount/network isolation\n6. **Landlock** \u2014 Kernel exploit to access blocked filesystem paths\n\n**FreeBSD (x86_64)** \u2014 Five layers, no hardware ROP protection:\n\n1. **ASLR** (~14 bits entropy) \u2014 Information leak (lower bar than Linux)\n2. **WASM sandbox** \u2014 Runtime bug to escape parser isolation (**primary ROP defense**)\n3. **Capsicum** \u2014 Kernel exploit to escape capability mode\n4. **PROTMAX** \u2014 Kernel exploit or pre-PROTMAX timing to escalate memory protections\n5. **Anti-debug + integrity** \u2014 Bypass tracing detection and hash verification\n\n**FreeBSD (arm64)** \u2014 Six layers, with hardware enforcement:\n\n1. **ASLR** \u2014 Information leak to discover gadget addresses\n2. **ARM PAC** \u2014 Hardware bypass to forge signed return addresses\n3. **ARM BTI** \u2014 Hardware bypass to jump to non-BTI-landing-pad instructions\n4. **WASM sandbox** \u2014 Runtime bug to escape parser isolation\n5. **Capsicum** \u2014 Kernel exploit to escape capability mode\n6. **PROTMAX** \u2014 Kernel exploit to escalate memory protections\n\n**Key insight**: On FreeBSD x86_64, the WASM sandbox is not defense-in-depth \u2014 it is the\n**primary** control-flow integrity mechanism. This elevates Path 2 from \"nice to have\" to\n\"essential\" on that platform. On FreeBSD arm64, PAC+BTI restore hardware-level protection,\nmaking it the strongest FreeBSD deployment target.\n\n### Platform Feature Matrix\n\n| Defense | Linux x86_64 | FreeBSD x86_64 | FreeBSD arm64 |\n|---------|-------------|----------------|---------------|\n| ASLR | High entropy | Low entropy | Low entropy |\n| HW return-addr protection | CET/SHSTK | **None** | ARM PAC |\n| HW indirect-branch protection | CET/IBT (needs Chez patch) | **None** | ARM BTI |\n| Syscall filtering | seccomp-bpf | **None** (Capsicum is resource-based) | **None** |\n| Block mprotect(EXEC) | seccomp | PROTMAX (post-init only) | PROTMAX (post-init only) |\n| Resource confinement | Landlock | Capsicum | Capsicum |\n| Process isolation | Namespaces | **None** (jails require root) | **None** |\n| WASM parser sandbox | Yes | Yes | Yes |\n| Anti-debug | ptrace self-trace | ptrace self-trace | ptrace self-trace |\n| Compiler hardening (CFLAGS) | Full | Full | Full |\n\n### Implementation Priority\n\nPriority is adjusted for cross-platform impact. Items that benefit both Linux and FreeBSD\nare ranked higher than Linux-only features.\n\n| Phase | Work | Effort | Linux | FreeBSD | Notes |\n|-------|------|--------|-------|---------|-------|\n| **1a** | Embed wasmi in jerboa-native-rs | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform, highest priority |\n| **1b** | Write DNS parser in Rust \u2192 WASM | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform |\n| **1c** | Switch musl build to static PIE | Hours | Full ASLR | Full ASLR | Cross-platform |\n| **1d** | Rebuild Chez with hardening CFLAGS | Days | All flags | All except CET | Cross-platform (flag subset varies) |\n| **2a** | Enable CET/SHSTK in Chez build | Days | **Defeats ROP** | N/A | Linux-only, highest HW impact |\n| **2b** | Add namespace isolation to cage | Days | Micro-VM containment | N/A | Linux-only |\n| **2c** | Enable PROTMAX post-init on FreeBSD | Days | N/A | Block mprotect escalation | FreeBSD-only, requires post-JIT sequencing |\n| **2d** | ARM PAC+BTI build target | Days | N/A | HW ROP defense (arm64) | FreeBSD arm64 only |\n| **3a** | Patch Chez codegen for ENDBR64 | Weeks | Full CET (IBT+SHSTK) | N/A | Linux-only, enables IBT |\n| **3b** | Encrypted boot files | Weeks | Resist static analysis | Resist static analysis | Cross-platform |\n| **3c** | Firecracker deployment wrapper | Weeks | VM-level isolation | N/A (bhyve possible) | Linux-primary |\n| **3d** | HardenedBSD deployment target | Days | N/A | Strict W^X, SEGVGUARD | FreeBSD fork, maximum hardening |\n"} --- a/cpt_corpus_v3.jsonl +++ b/cpt_corpus_v3.jsonl @@ -6,7 +6,7 @@ {"text": "<!-- FILE: README.md -->\n# Jerboa\n\nA Gerbil-syntax, Clojure-compatible Scheme dialect for production\nconcurrent systems, running on stock [Chez Scheme](https://cisco.github.io/ChezScheme/).\n\nJerboa implements Gerbil's user-facing language (`def`, `defstruct`,\n`match`, hash tables, `:std/*` libraries) **and** a substantial Clojure\ncompatibility layer (atoms, refs/STM, agents, persistent collections,\ncore.async, transducers, protocols, multimethods) as Chez Scheme\nmacros and native libraries. No Gerbil expander, no Gambit\ncompatibility layer, no patched Chez. The standard Chez compiler\nproduces the binaries.\n\n## Why Chez Scheme\n\nJerboa picks Chez Scheme as its host because its concurrency model is\nthe rare combination that real production systems need:\n\n- **Real OS threads, no GIL.** Chez Scheme's threaded build\n (`--threads`) gives you native OS threads with a thread-safe\n generational GC. CPU-bound work scales linearly across cores; you\n do not pay for parallelism with a global interpreter lock.\n- **First-class synchronization primitives.** `make-mutex`,\n `make-condition`, `with-mutex`, `condition-wait`,\n `condition-broadcast`, and atomic CAS on tc-mutex slots are\n exposed in the language. Jerboa's higher-level concurrency\n abstractions (`(std atom)`, `(std stm)`, `(std csp)`,\n `(std net io)` fibers) are built directly on these.\n- **Cheap closures, fast call paths.** Chez compiles to machine code\n through the nanopass framework \u2014 its closure allocation and\n call-through-pointer costs are competitive with what Go achieves\n via its runtime. That gives Jerboa room to express tens of\n thousands of fibers as plain procedures over a small worker pool\n without the cost dominating the workload.\n- **Fixnum-tagged arithmetic and unboxed bytevectors.** Hot paths in\n protocol handling (HTTP/2, WebSocket framing, base64, SHA) stay\n in fixnums and unboxed bytes, so a Scheme implementation of a\n protocol can sit within a small constant factor of a hand-written\n C version.\n- **A stable, fast FFI.** `foreign-procedure` and `foreign-callable`\n let Jerboa drop into a Rust shared library (`libjerboa_native`)\n for everything that genuinely needs sharp edges \u2014 ring for\n crypto, rustls for TLS, regex for ReDoS-immune matching,\n rusqlite/postgres/duckdb for storage. The Scheme side stays\n high-level; the Rust side stays memory-safe.\n- **A self-hosting compiler.** When Jerboa needs a primitive that\n Chez does not ship (e.g. `bytevector-slice`, `bytevector-append`,\n `base64-encode`/`base64-decode`, `sha1-bytevector`,\n `sha256-bytevector`), we add it to our Chez fork in pure Scheme\n with full backwards compatibility. No patched bootstrap, no\n vendored compiler \u2014 just additional primitives in `(chezscheme)`.\n- **Apache 2.0**, no license entanglements.\n\nThe result: a single language where green threads (fibers), OS\nthreads, atomic state, software-transactional memory, and CSP\nchannels all coexist on top of the same scheduler primitives, with\npredictable performance and no runtime to fight.\n\n## Quick Start\n\n```scheme\n(import (jerboa prelude))\n\n(def (main)\n (defstruct point (x y))\n (let ([p (make-point 3 4)])\n (displayln (point-x p)) ;; 3\n (displayln (sort < [5 1 3])) ;; (1 3 5)\n (displayln (string-join [\"a\" \"b\"] \",\")) ;; a,b\n (displayln (json-object->string [1 2 3])))) ;; [1,2,3]\n\n(main)\n```\n\nRun with:\n```bash\nscheme --libdirs lib --script your-file.ss\n```\n\n## Architecture\n\n```\n\u250c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2510\n\u2502 User's Gerbil-like code \u2502\n\u2502 (def (main) (displayln (sort < [3 1 2]))) \u2502\n\u2514\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u252c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2518\n \u2502\n\u250c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u25bc\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2510\n\u2502 Reader: [...] = (...), {...} \u2192 (~ ..) \u2502\n\u2502 :std/sort \u2192 (std sort), keyword:, heredocs \u2502\n\u2502 Optional Clojure mode (#!cloj) \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Core Macros: def, defstruct, match, try \u2502\n\u2502 All expand to standard Chez Scheme \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Runtime: hash tables, method dispatch, \u2502\n\u2502 persistent collections, transients \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Concurrency: fibers, CSP, STM, atoms, \u2502\n\u2502 agents, futures, work-stealing scheduler \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Standard Library: 229 (std *) modules \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Native FFI: libjerboa_native.so (Rust) \u2502\n\u2502 ring \u00b7 flate2 \u00b7 regex \u00b7 sqlite \u00b7 \u2502\n\u2502 postgres \u00b7 rustls \u00b7 landlock \u00b7 ed25519 \u2502\n\u251c\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2524\n\u2502 Stock Chez Scheme \u2014 additive primitives, \u2502\n\u2502 no fork, no patches \u2502\n\u2514\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2500\u2518\n```\n\n## What's Landed in the Last Month\n\nThe recent push has expanded Jerboa from \"Gerbil syntax on Chez\" into\na full production stack. The additions group into seven themes.\n\n### 1. Fiber-aware concurrency stack\n\nA green-thread system layered on Chez OS threads with epoll-integrated\nI/O. The eight-phase rollout (`docs/green-wins.md`) is now complete.\n\n| Module | Provides |\n|---|---|\n| `(std net io)` | epoll-integrated I/O core for fibers |\n| `(std net fiber-httpd)` | Fiber-native HTTP/1.1 server with URL-param routing |\n| `(std net fiber-ws)` | Fiber-aware WebSocket server, integrates with httpd |\n| `(std workpool)` | Bounded worker pool for blocking syscalls |\n| `(std net dns)` | Fiber-friendly resolver with caching |\n| `(std net filepool)` | File-descriptor pool offloading slow disk I/O |\n| `(std net sendfile)` | Zero-copy `sendfile(2)` paths for static content |\n| `(std net connpool)` | Fiber-aware connection pooling for outbound TCP |\n| `(std net rate)` | Token bucket, sliding/fixed-window limiters |\n| `(std net router)` | HTTP routing with `:param` captures + middleware |\n| `(std semaphore)` / `(std net admission)` | Production hardening: admission control + circuit metrics |\n| `(std fiber)` | Cancellation, fiber-locals, join, link, select, timeouts, groups |\n\nInternally, the scheduler now uses **per-worker work-stealing deques**\ninstead of a shared run-queue, and the completion / wait API was\nre-wired through fibers so that ports and channels block fibers\nwithout parking the OS thread.\n\n### 2. Clojure compatibility layer \u2014 `(std clojure)`\n\nA substantial Clojure-on-Scheme port: sequences, atoms, agents, refs,\nmultimethods, protocols, transducers, persistent collections, lazy\nsequences, core.async, EDN, specter, zippers, and the rest of the\ncommon idiom.\n\n**Persistent collections** (HAMT- and RRB-backed):\n\n| Module | Provides |\n|---|---|\n| `(std pmap)` | Persistent hash-array-mapped trie map + `transient-map` for fast bulk build |\n| `(std pvec)` | Persistent RRB vector |\n| `(std pset)` | Persistent set on top of `pmap` |\n| `(std sorted-set)` | Sorted persistent set |\n| `(std sorted-map)` | Sorted persistent map |\n| `(std pqueue)` | Persistent FIFO queue (SRFI-134-backed) |\n\nAll persistent collections participate in Chez's `equal?` /\n`equal-hash` / `display`, integrate with the `for/collect` / `for/fold`\niterator protocol, and are destructurable via `match`. They use\nnongenerative RTDs so equality survives separate compilation.\n\n**Concurrency primitives** (Clojure-style names, Chez-thread-safe):\n\n| Module | Provides |\n|---|---|\n| `(std atom)` | `atom`, `swap!`, `reset!`, `compare-and-set!`, `add-watch!`, `volatile!` family |\n| `(std agent)` | Async state cells with bounded send queues |\n| `(std stm)` | `ref`, `dosync`, `alter`, `commute`, `ensure` on top of TVars |\n| `(std multi)` | `defmulti` / `defmethod` with `:hierarchy` and `derive!` |\n| `(std protocol)` | Open-world protocols (`defprotocol`, `extend-type`, `extend!`) |\n| `(std meta)` | Metadata wrappers (`with-meta`, `meta`) |\n| `(std component)` | Stuart Sierra-style lifecycle (`start`, `stop`, dependency graph) |\n\n**core.async-style CSP** \u2014 `(std csp)`:\n\n- `(chan n xform)` \u2014 transducer-backed channels\n- Sliding / dropping / blocking buffers\n- `alts!` / `alts!!` non-deterministic select\n- `pipe`, `mult`, `mix` (with `'block` / `'drop` / `'timeout` policies)\n- `pub` / `sub` topic filtering\n- `split` / `chan-classify-by` n-way split\n- `async-reduce`, `onto-chan!`, `onto-chan!!`\n- `put!` / `take!` non-blocking callback variants\n- Timer wheel for scalable timeouts (`JERBOA_CSP_TIMER_WHEEL=1`)\n- `(std csp fiber-chan)` integrates channels with fibers\n\n**Sequence / data manipulation**:\n\n| Module | Provides |\n|---|---|\n| `(std clojure)` | Umbrella with `delay`, `future`, `promise`, polymorphic `deref` |\n| `(std clojure walk)` | `prewalk`, `postwalk`, `keywordize-keys`, etc. |\n| `(std clojure data)` | `diff` |\n| `(std clojure zip)` | Tree zippers |\n| `(std clojure seq)` | Lazy sequences: `range`, `iterate`, `repeat`, `cycle`, `take-while`, `drop-while` |\n| `(std clojure reducers)` | Reducible/transducible adapters |\n| `(std specter)` | Composable path navigation for nested data |\n| `(std zipper)` | Functional tree zippers |\n| `(std text edn)` | EDN reader/writer (#inst, #uuid, tagged literals) |\n| `(std misc nested)` | `get-in`, `assoc-in`, `update-in` |\n| `(std injest)` | Smart thread-last with transducer fusion |\n\nThe `(std clojure)` module also lands `ex-info`, `condp =>`,\n`reduce-kv`, set relational ops (`select`, `project`, `rename`,\n`index`, `join`), and full destructuring.\n\n`(std test check)` is a property-based testing library with\nshrinking, in the style of `test.check`.\n\n### 3. Slang + WebAssembly backend\n\nSlang is a secure language compiler that targets WebAssembly, with\ntwo execution backends.\n\n- Full WASM MVP plus post-MVP features: saturating conversions, bulk\n memory operations, reference types, tables, tail calls, exception\n handling, GC, host imports.\n- `(jerboa wasm format)` \u2014 binary format primitives (LEB128, IEEE 754).\n- `(jerboa wasm codegen)` \u2014 Scheme\u2192WASM compiler for an i32 subset\n (closures, tail calls, exceptions, variadic lambdas).\n- `(jerboa wasm runtime)` \u2014 stack-based interpreter for testing.\n- **wasmi backend** \u2014 Rust embedding with fuel metering and bounded\n memory; security-hardened (bounds checks, exception boundary,\n import validation, module-size limits).\n- **SpiderMonkey backend** via the `mozjs` crate \u2014 production JIT for\n benchmarks where wasmi is the bottleneck.\n- Argon2id key derivation, message HMAC, sandbox limits, taint checks\n baked in.\n- `wasm-sandbox-instantiate-hosted` provides a Scheme FFI binding for\n hosting third-party WASM modules with capability-based imports.\n\n### 4. Native Rust backend \u2014 `libjerboa_native.so`\n\nA unified Rust shared library replaces the previous C-FFI surface\nwith memory-safe implementations behind a small extern-\"C\" facade.\n\n| Module | Crate(s) | Provides |\n|---|---|---|\n| `(std crypto native-rust)` | ring | SHA-1/256/384/512, HMAC, AES-256-GCM, PBKDF2, CSPRNG, ed25519 sign/verify |\n| `(std crypto secure-mem)` | libc (mmap/mlock) | Guard-paged, mlocked memory outside GC |\n| `(std compress native-rust)` | flate2 | `deflate`/`inflate`/`gzip`/`gunzip` with size limits |\n| `(std regex-native)` | regex (NFA) | Compile / match / find / replace \u2014 ReDoS-immune |\n| `(std db sqlite-native)` | rusqlite (bundled) | Open / exec / prepare with parameterized queries |\n| `(std db postgresql-native)` | rust-postgres | Connect / exec / query |\n| `(std db duckdb-native)` | duckdb-rs | Native DuckDB integration |\n| `(std os epoll-native)` | libc | epoll create / ctl / wait |\n| `(std os inotify-native)` | libc | inotify init / add_watch / read_events |\n| `(std os landlock-native)` | libc | Landlock LSM ABI v1\u2013v7 (FS + network confinement) |\n| `(std net tls-rustls)` | rustls | HTTPS / `wss://` with pinned cert verification |\n| `(std net request)` | rustls | HTTPS via the Rust TLS path |\n| `(std pcap)` | rscap | Live packet capture |\n\n`panic.rs` wraps every extern \"C\" entry point in `catch_unwind` so a\nRust panic never crosses the FFI boundary as undefined behavior.\n\n### 5. Cross-platform ports\n\nJerboa now runs on Linux (glibc + musl), FreeBSD, macOS (Intel + Apple\nSilicon), and Android (Termux).\n\n- **FreeBSD**: full Capsicum support in `(std security cage)`,\n `__error` errno binding, correct platform constants for O_* flags,\n `struct stat`, `sockaddr_in`, signals (SIGTSTP/SIGCHLD/SIGCONT and\n six others were hardcoded to Linux values), and integrity check via\n `sysctl` instead of `/proc/curproc/file`.\n- **macOS**: BPF live capture activation via `BIOCSETF` + `BIOCIMMEDIATE`\n (replacing `BIOCSETFNR` which doesn't exist on macOS), portable\n libc/libm names, dylib path fallback, AArch64 seccomp.\n- **Android**: bionic libc errno symbol support in TCP layer.\n\n`(std security cage)` provides pledge/unveil-style process\nconfinement that maps to the strongest mechanism available on each\nplatform: Landlock + seccomp on Linux, Capsicum on FreeBSD, sandbox-exec\non macOS.\n\n### 6. Security hardening\n\n- `(std security)` \u2014 `audit`, `auth`, `cage`, `capability`,\n `flow`, `import-audit`, `io-intercept`, `landlock`,\n `metrics`, `privsep`, `restrict`, `sandbox`, `sanitize`,\n `seatbelt`, `seccomp`, `secret`, `taint`, `capsicum`,\n `capability-typed`, `errors`.\n- mTLS with **pinned cert verifier** (replacing\n `WebPkiClientVerifier`); in-memory cert/key APIs.\n- Argon2id, TOCTOU-safe path handling, message HMAC.\n- Binary-hardening flags wired into the musl static build (PIE,\n RELRO, stack-canaries, NX) \u2014 see `docs/secure-binary.md`.\n- aarch64 seccomp filter.\n\n### 7. Performance work \u2014 phases 4\u201322\n\nA multi-phase optimization push, each with a benchmark gate to detect\nregressions. The scaffolding lives in `(std bench)` and runs in CI.\n\n| Phase | Optimization |\n|---|---|\n| 4 | Memoize regex compilation for literal reuse |\n| 5 | Fuse `for` / `for/collect` / `for/fold` over `in-range` / `in-vector` / `in-string` |\n| 6 | Single-pass keyword-arg extraction in `def` expansion |\n| 7 | Build the prelude aggregator to produce WPO for `std/*` |\n| 8 | Bench-suite harness + regression gate |\n| 12 | Arity-specialized method dispatch in `(~ obj 'name ...)` |\n| 13 | Fuse `in-hash-keys` / `in-hash-values` in `for/collect` |\n| 14 | Fuse runs of `(list 'TAG p ...)` clauses in `match` |\n| 17 | Method dispatch cost vs direct call (baseline) |\n| 18 | Kwarg call overhead (baseline) |\n| 22 | `string-append` adjacent-literal fold (Chez-side) |\n| \u2014 | `defstruct` / `defrecord` / `ok` / `err` seal by default |\n| \u2014 | `str` expand-time constant folding for literal args |\n| \u2014 | Persistent-collection nongenerative UIDs |\n| \u2014 | Iter fusion: `for/or` / `for/and` over known iterator heads |\n| \u2014 | Match2 fast-path `(: Type)` with fused RTD dispatch |\n\n### 8. Reader & build infrastructure\n\n- **Clojure reader compatibility mode** (`#!cloj`) \u2014 switch a file or\n REPL session into Clojure surface syntax (`#\"regex\"`, `#{}` sets,\n `#_form` discard, etc.).\n- **Regex tier 1\u20133** \u2014 raw strings, unified `(re ...)` API across the\n pure-Scheme and Rust backends, `rx` macros, full PEG grammar\n system in `(std peg)`.\n- **Single-file packages** \u2014 `jerboa exec` reads a self-contained\n `.ss` file with header metadata and runs it without project\n scaffolding.\n- **jerbuild** improvements \u2014 per-project feature gating so a\n static-musl build only links the dependencies the project\n actually uses.\n- **Docker base image** for static musl binary builds; CI workflow\n for macOS Rust libraries; jemacs static build TUI deps included.\n- **nREPL** \u2014 `(std nrepl)` is the canonical source; full CIDER /\n Calva middleware plus Jerboa extensions.\n- **AI compatibility aliases** \u2014 `(jerboa prelude)` exports common\n names from Racket / Gambit / Common Lisp that LLMs frequently\n hallucinate (`hash-has-key?` \u2192 `hash-key?`,\n `directory-exists?` \u2192 `file-directory?`, `random-integer` \u2192\n `random`, `eql?` \u2192 `eqv?`, etc.).\n\n### 9. Documentation push\n\n`docs/` is now ~90 files. Highlights:\n\n- `docs/anti-cookbook.md` \u2014 common Scheme/Clojure mistakes and how\n Jerboa makes them explicit.\n- `docs/api-index.md` \u2014 comprehensive API reference (~700KB,\n generated).\n- `docs/clojure-vs-jerboa.md` \u2014 feature scorecard with status\n markers.\n- `docs/clojure-left.md` \u2014 gap analysis driving the parity work.\n- `docs/green-wins.md` \u2014 fiber roadmap (now complete).\n- `docs/jerboa-edge.md` \u2014 edge-computing roadmap.\n- `docs/jerboa-db.md` \u2014 database integration tracking.\n- `docs/native-rust.md` \u2014 Rust backend architecture and migration.\n- `docs/regex-rx-peg.md` \u2014 unified regex/SRE/PEG reference.\n\n## What's Included\n\n### Core Macros (`(jerboa core)`)\n- `def`, `def*` \u2014 functions with optional / multi-arity / rest args\n- `defstruct` \u2014 sealed Chez records with auto-generated accessors\n- `defclass` \u2014 records with single inheritance\n- `defmethod`, `defmulti` \u2014 method dispatch and multimethods\n- `match`, `match2` \u2014 pattern matching (lists, predicates,\n `and`/`or`/`not`, cons, type patterns, persistent-collection\n destructuring, wildcards)\n- `try`/`catch`/`finally`, `errdefer`, `defvariant` (Zig-inspired)\n- `defrule`/`defrules` \u2014 syntax-rules shortcuts\n- `while`/`until`, `for` family\n- `hash-literal`/`let-hash`\n- Threading macros: `chain`, `chain-and`, `->`, `->>`, `as->`,\n `some->`, `cond->`\n\n### Runtime (`(jerboa runtime)`)\n- Full Gerbil hash table API\n- Method dispatch: `~`, `bind-method!`, `call-method`\n- Keywords, ports, displayln, `iota`, `1+`, `1-`\n- `(jerboa pkg)`, `(jerboa lock)` \u2014 semver, dep resolution,\n manifests, lockfile management\n- `(jerboa hot)` \u2014 hot code reload via mtime polling\n- `(jerboa embed)` \u2014 sandboxed evaluation environments\n- `(jerboa cross)` \u2014 cross-compilation config and ABI naming\n\n### Standard Library \u2014 229 modules under `lib/std/`\n\nMajor areas:\n\n- **Concurrency**: `(std atom)`, `(std agent)`, `(std stm)`,\n `(std csp)`, `(std multi)`, `(std protocol)`, `(std meta)`,\n `(std component)`, `(std clojure)`, `(std fiber)`, `(std raft)`,\n `(std actor)`, `(std concur hash)`, `(std concur stm)`,\n `(std concur structured)`.\n- **Networking**: 35+ `(std net *)` modules \u2014 `request`, `httpd`,\n `fiber-httpd`, `fiber-ws`, `websocket`, `http2`, `dns`,\n `sendfile`, `connpool`, `workpool`, `tcp`, `udp`, `tls`,\n `tls-rustls`, `ssh`, `s3`, `smtp`, `socks5-server`, `9p`,\n `grpc`, `json-rpc`, `router`, `rate`, `uri`.\n- **Data**: `(std pmap)`, `(std pvec)`, `(std pset)`,\n `(std sorted-set)`, `(std sorted-map)`, `(std pqueue)`,\n `(std specter)`, `(std zipper)`, `(std injest)`,\n `(std clojure data/walk/zip)`, `(std misc nested)`.\n- **Persistence / DB**: `(std db sqlite/postgresql/duckdb/leveldb)`,\n native-Rust variants, `(std db dbi)`, `(std db query-compile)`,\n `(std db conpool)`.\n- **Text**: `(std text json/edn/csv/xml/yaml/base64/hex/utf8)`,\n `(std regex-native)`, `(std rx)`, `(std peg)`.\n- **OS / runtime**: `(std os env/path/temporaries/signal/fdio)`,\n native epoll/inotify/landlock, `(std os capsicum)`,\n `(std misc process)`, `(std misc thread)`, `(std misc cpu)`.\n- **Crypto**: `(std crypto digest/cipher/hmac/pkey/kdf)`,\n `(std crypto native-rust)` (ring), `(std crypto secure-mem)`.\n- **Production infra**: `(std log)`, `(std metrics)`, `(std span)`,\n `(std health)`, `(std circuit)`, `(std semaphore)`, `(std lint)`,\n `(std test)`, `(std test check)`, `(std bench)`.\n- **Security**: 21 `(std security *)` modules \u2014 pledge/unveil,\n Landlock, Capsicum, seccomp, capability-typed I/O, taint, sandbox.\n\n### FFI (`(jerboa ffi)`)\n- `c-lambda` \u2192 `foreign-procedure` with automatic type translation\n- `define-c-lambda`, `begin-ffi`, `c-declare`\n- Full Gambit-to-Chez type mapping\n- `native-available?` guards for build-time platform feature gating\n\n### Reader (`(jerboa reader)`)\n- `[...]` = `(...)` (same as Gerbil and Chez)\n- `{method obj}` \u2192 `(~ obj 'method)`\n- `keyword:` \u2192 keyword objects\n- `:std/sort` \u2192 `(std sort)` module paths\n- Heredoc strings, datum comments, block comments\n- Optional Clojure surface syntax under `#!cloj`\n\n### Prelude (`(jerboa prelude)`)\nOne import for everything:\n```scheme\n(import (jerboa prelude))\n```\n\n## Examples\n\n### Fiber-based HTTP server\n```scheme\n(import (jerboa prelude)\n (std net fiber-httpd))\n\n(define (handler req)\n (let-values ([(method path) (request-method+path req)])\n (case method\n [(GET) (respond-text 200 \"hello\\n\")]\n [else (respond-text 405 \"method not allowed\\n\")])))\n\n(fiber-httpd-serve port: 8080 handler: handler workers: 4)\n```\n\n### CSP pipeline\n```scheme\n(import (jerboa prelude)\n (std csp) (std csp ops))\n\n(let ([in (chan 100)]\n [out (chan 100 (map (lambda (x) (* x x))))])\n (pipe in out)\n (go (let loop ([i 0])\n (when (< i 1000) (put! in i) (loop (+ i 1)))))\n (let consume ([n 0])\n (when (< n 1000)\n (displayln (take! out)) (consume (+ n 1)))))\n```\n\n### STM (Clojure refs)\n```scheme\n(import (jerboa prelude) (std stm))\n\n(define account-a (ref 100))\n(define account-b (ref 50))\n\n(define (transfer! from to amount)\n (dosync\n (alter from - amount)\n (alter to + amount)))\n\n(transfer! account-a account-b 25)\n```\n\n### Persistent map\n```scheme\n(import (jerboa prelude) (std pmap))\n\n(define m1 (pmap 'a 1 'b 2 'c 3))\n(define m2 (pmap-assoc m1 'd 4))\n(displayln (pmap-ref m2 'b)) ;; 2\n(displayln (pmap-ref m1 'd #f)) ;; #f (m1 unchanged)\n```\n\n## Testing\n\n```bash\nmake test # Core tests (289 tests)\nmake test-features # Phase 2+3 feature tests (637 tests)\nmake test-native # Rust native backend tests\nmake test-wrappers # Legacy chez-* C library wrappers (27 tests)\nmake test-clojure # Clojure compatibility layer tests\nmake test-fiber # Fiber + CSP + STM tests\nmake test-wasm # Slang/WASM backend tests\nmake test-all # Everything (1500+ tests)\n```\n\nProperty-based testing is available via `(std test check)`:\n\n```scheme\n(import (std test) (std test check))\n\n(check 'sort-is-idempotent\n (lambda (xs) (equal? (sort < xs) (sort < (sort < xs))))\n (gen-list (gen-integer)))\n```\n\n## Requirements\n\n- [Chez Scheme](https://cisco.github.io/ChezScheme/) 10.x (stock,\n unmodified \u2014 though we maintain an additive fork at\n [github.com/ober/ChezScheme](https://github.com/ober/ChezScheme)\n with a handful of pure-Scheme primitives that the standard\n library uses). Both work.\n- Optional: [Rust toolchain](https://rustup.rs/) for building\n `libjerboa_native.so` (crypto, compression, regex, databases,\n TLS, OS integration, ed25519).\n- Optional (legacy): [chez-*](https://github.com/ober) libraries for\n the older C-FFI shims (still functional, being superseded by the\n Rust backend).\n\n### Supported platforms\n\n| OS | Architecture | Notes |\n|---|---|---|\n| Linux | x86_64, aarch64 | glibc + musl static both supported |\n| FreeBSD | x86_64 | Capsicum enabled by default |\n| macOS | x86_64, aarch64 | Apple Silicon native; sandbox-exec for `(std security cage)` |\n| Android | aarch64 | Termux; bionic libc compat |\n\n## Project Structure\n\n```\nlib/\n jerboa/ # Reader, core macros, runtime, FFI, prelude\n # + pkg, lock, hot, embed, cross, wasm, build\n std/ # 229 modules \u2014 see \"Standard Library\" above\njerboa-native-rs/ # Unified Rust shared library\n src/\n lib.rs # module declarations, init\n crypto.rs # ring digests, hmac, aead, csprng, ed25519\n compress.rs # flate2: deflate, inflate, gzip\n regex_native.rs # regex crate\n sqlite.rs # rusqlite\n postgres_native.rs # rust-postgres\n duckdb.rs # duckdb-rs\n epoll.rs / inotify_native.rs / landlock.rs\n secure_mem.rs # mlock + guard pages + explicit_bzero\n tls_rustls.rs # rustls-based TLS\n panic.rs # catch_unwind wrapper for FFI\nslang/ # Slang language compiler\n src/ # IR, lowering, codegen\n wasm/ # WASM backend (wasmi + SpiderMonkey)\ndocs/ # ~90 files \u2014 green-wins, clojure-vs-jerboa, native-rust, \u2026\ntests/ # Test suite (1500+ tests)\nbenchmarks/ # Bench harness with regression gate\nsupport/ # Static-build artifacts, Docker base image\n```\n\n## What Gerbil Code Works\n\nMost user-level Gerbil code works unchanged:\n\n```scheme\n(import :std/sugar :std/sort :std/format)\n\n(def (run-command cmd env)\n (try\n (let* ([tokens (tokenize cmd)]\n [expanded (expand-aliases tokens env)])\n (match expanded\n ([prog . args] (exec-pipeline prog args env))\n (else (displayln \"empty command\"))))\n (catch (e) (displayln \"error: \" (error-message e)))))\n```\n\n## What Won't Work\n\n1. **Gerbil expander API** (`:gerbil/expander`) \u2014 not applicable\n2. **Gambit `##` primitives** \u2014 provided case-by-case\n3. **`(export #t)`** \u2014 re-export-everything needs explicit exports\n4. **Gerbil-specific `syntax-case` binding semantics** \u2014 uses Chez R6RS\n5. **Gambit thread API** is wrapped (`(std misc thread)`); some\n Gambit-specific primitives (e.g. `thread-yield!` quirks) are not\n 1:1 \u2014 see `docs/concurrency-extended.md`.\n\n## License\n\nApache 2.0\n"} {"text": "<!-- FILE: JERBOA-LANG.md -->\n# The Jerboa Programming Language\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own\nlanguage \u2014 with features that differ from and exceed Gerbil. All user-facing code is\nwritten in `.ss` files. The `.sls` files are implementation internals.\n\n## Quick Start\n\n```scheme\n;; hello.ss\n(import (jerboa prelude))\n\n(def (main)\n (def name \"world\")\n (displayln (str \"Hello, \" name \"!\")))\n\n(main)\n```\n\nRun with:\n```\nscheme --libdirs lib --script hello.ss\n```\n\nOne import gives you the entire language:\n```scheme\n(import (jerboa prelude))\n```\n\n---\n\n## Table of Contents\n\n1. [File Structure](#file-structure)\n2. [Reader Syntax](#reader-syntax)\n3. [Definitions](#definitions)\n4. [Data Structures](#data-structures)\n5. [Pattern Matching](#pattern-matching)\n6. [Control Flow](#control-flow)\n7. [Error Handling](#error-handling)\n8. [Result Types](#result-types)\n9. [Iterators](#iterators)\n10. [Threading Macros](#threading-macros)\n11. [Ergonomic Typing](#ergonomic-typing)\n12. [Hash Tables](#hash-tables)\n13. [Functions & Combinators](#functions--combinators)\n14. [Standard Library](#standard-library)\n15. [FFI](#ffi)\n16. [Differences from Gerbil](#differences-from-gerbil)\n17. [Differences from Chez Scheme](#differences-from-chez-scheme)\n\n---\n\n## File Structure\n\nA Jerboa `.ss` file has this shape:\n\n```scheme\n(import (jerboa prelude))\n;; Optional extra imports for modules not in the prelude:\n;; (import (std net request))\n;; (import (std db sqlite))\n\n;; Definitions\n(def (my-function x y)\n (+ x y))\n\n;; Top-level code\n(displayln (my-function 1 2))\n```\n\nKey points:\n- **No `(library ...)` wrapper** \u2014 that's for `.sls` internals only\n- **`(import (jerboa prelude))`** gives you everything: core macros, runtime,\n result types, datetime, iterators, CSV, pretty-printer, JSON, paths, strings,\n lists, alists, hash tables, functional combinators, ergo typing, FFI, and more\n- For specialized modules not in the prelude, add extra imports\n\n---\n\n## Reader Syntax\n\nJerboa extends the Chez Scheme reader with Gerbil-inspired syntax.\n\n### Square Brackets \u2014 Plain Parentheses\n\nSquare brackets are interchangeable with parentheses, exactly like Gerbil and\nstock Chez Scheme. Use them freely in bindings, match clauses, cond, etc.:\n\n```scheme\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([i (in-range 5)]) (* i i))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### Curly Braces \u2192 Method Dispatch\n\n```scheme\n{draw canvas} ;; \u2192 (~ canvas 'draw)\n{move sprite 10 20} ;; \u2192 (~ sprite 'move 10 20)\n{name person} ;; \u2192 (~ person 'name)\n```\n\n### Keywords (trailing colon)\n\n```scheme\nname: ;; \u2192 keyword object #:name\ncolor: ;; \u2192 keyword object #:color\n(keyword? name:) ;; \u2192 #t\n```\n\n### Module Paths (Gerbil-style)\n\n```scheme\n:std/sort ;; \u2192 (std sort)\n:std/text/json ;; \u2192 (std text json)\n:std/misc/string ;; \u2192 (std misc string)\n```\n\nBoth forms work in `import`:\n```scheme\n(import :std/net/request) ;; Gerbil style\n(import (std net request)) ;; R6RS style \u2014 both are equivalent\n```\n\n### Heredoc Strings\n\n```scheme\n#<<END\nThis is a multi-line\nstring literal.\nEND\n```\n\n### Standard Scheme Syntax\n\nAll standard Chez Scheme reader features work:\n- `'expr` \u2014 quote\n- `` `expr `` \u2014 quasiquote, with `,expr` unquote and `,@expr` splicing\n- `#(1 2 3)` \u2014 vector\n- `#u8(1 2 3)` \u2014 bytevector\n- `#\\space`, `#\\newline`, `#\\x41` \u2014 characters\n- `#xFF`, `#b1010`, `#o77` \u2014 number radix prefixes\n- `#;expr` \u2014 datum comment (skip next form)\n- `#| ... |#` \u2014 block comment (nestable)\n- `#&value` \u2014 box\n- `#!void`, `#!eof` \u2014 void and eof literals\n\n---\n\n## Definitions\n\n### `def` \u2014 Define Variables and Functions\n\n```scheme\n;; Simple binding\n(def x 42)\n(def name \"Alice\")\n\n;; Function\n(def (add a b)\n (+ a b))\n\n;; Optional parameters (default values)\n(def (greet name (greeting \"hello\"))\n (str greeting \", \" name \"!\"))\n\n(greet \"Bob\") ;; \u2192 \"hello, Bob!\"\n(greet \"Bob\" \"howdy\") ;; \u2192 \"howdy, Bob!\"\n\n;; Rest arguments\n(def (first-and-rest first . rest)\n (list first rest))\n\n;; Type-checked parameters (via ergo)\n(def (add (x : number?) (y : number?)) : number?\n (+ x y))\n```\n\n### `def*` \u2014 Multiple Arities\n\n```scheme\n(def* greet\n ((name) (greet name \"hello\"))\n ((name greeting) (str greeting \", \" name \"!\")))\n```\n\n### `defrule` / `defrules` \u2014 Define Macros\n\n```scheme\n;; Single-pattern macro\n(defrule (swap! a b)\n (let ((tmp a)) (set! a b) (set! b tmp)))\n\n;; Multi-pattern macro\n(defrules my-or ()\n ((_ a) a)\n ((_ a b ...) (let ((t a)) (if t t (my-or b ...)))))\n```\n\n---\n\n## Data Structures\n\n### `defstruct` \u2014 Record Types\n\n```scheme\n(defstruct point (x y))\n\n;; Generated:\n;; make-point \u2014 constructor\n;; point? \u2014 predicate\n;; point-x \u2014 accessor\n;; point-y \u2014 accessor\n;; point-x-set! \u2014 mutator\n;; point-y-set! \u2014 mutator\n;; point::t \u2014 record type descriptor\n\n(def p (make-point 3 4))\n(point-x p) ;; \u2192 3\n(point-y-set! p 10)\n(point-y p) ;; \u2192 10\n```\n\n### Inheritance\n\n```scheme\n(defstruct shape (color))\n(defstruct (circle shape) (radius))\n\n(def c (make-circle \"red\" 5))\n(shape-color c) ;; \u2192 \"red\" (inherited field)\n(circle-radius c) ;; \u2192 5\n(shape? c) ;; \u2192 #t\n(circle? c) ;; \u2192 #t\n```\n\nOnly **single inheritance** is supported.\n\n### `defclass` \u2014 Alias for `defstruct`\n\n```scheme\n(defclass point (x y)) ;; same as defstruct\n(defclass (circle shape) (r)) ;; same as defstruct with parent\n```\n\n### `defrecord` \u2014 Struct with Pretty Printing\n\n```scheme\n(defrecord person (name age))\n\n;; Same as defstruct plus:\n;; person->alist \u2014 convert to association list\n;; Custom printer: #<person name=\"Alice\" age=30>\n```\n\n### `defmethod` \u2014 Method Dispatch\n\n```scheme\n(defstruct circle (radius))\n(defstruct rect (width height))\n\n(defmethod (area (self circle))\n (* 3.14159 (expt (circle-radius self) 2)))\n\n(defmethod (area (self rect))\n (* (rect-width self) (rect-height self)))\n\n;; Call with ~ or {} syntax\n(def c (make-circle 5))\n(~ c 'area) ;; \u2192 78.53975\n{area c} ;; \u2192 78.53975 (same thing)\n\n;; Methods with extra args\n(defmethod (move (self point) dx dy)\n (make-point (+ (point-x self) dx)\n (+ (point-y self) dy)))\n\n{move p 10 20} ;; \u2192 new point shifted by (10, 20)\n```\n\nMethod dispatch walks the inheritance chain \u2014 a method defined on `shape`\nworks on `circle` too.\n\n### `define-enum` \u2014 Enumeration Types\n\n```scheme\n(define-enum color (red green blue))\n\n;; Generated:\n;; color-red \u2192 0\n;; color-green \u2192 1\n;; color-blue \u2192 2\n;; color? \u2014 predicate (checks 0..2)\n;; color->name \u2014 number to string\n;; name->color \u2014 string to number\n```\n\n---\n\n## Pattern Matching\n\n### `match`\n\n```scheme\n(match value\n ;; Literal patterns\n (0 \"zero\")\n (#t \"true\")\n (\"hello\" \"greeting\")\n\n ;; Variable binding\n (x (str \"got: \" x)))\n\n;; List destructuring\n(match (list 1 2 3)\n ((list a b c) (+ a b c))) ;; \u2192 6\n\n;; Nested patterns\n(match '(1 (2 3))\n ((list a (list b c)) (+ a b c))) ;; \u2192 6\n\n;; Cons patterns\n(match '(1 2 3)\n ((cons head tail) head)) ;; \u2192 1\n\n;; Predicate patterns\n(match 42\n ((? string?) \"a string\")\n ((? number?) \"a number\")) ;; \u2192 \"a number\"\n\n;; Guards\n(match x\n (n (where (> n 0)) \"positive\")\n (n (where (< n 0)) \"negative\")\n (_ \"zero\"))\n\n;; Logical combinators\n(match x\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\" \"true\") #t)\n ((not #f) \"truthy\"))\n\n;; Wildcard\n(match x\n (_ \"anything\"))\n\n;; View patterns \u2014 apply function, match result\n(match \"123\"\n ((=> string->number n) (+ n 1))) ;; \u2192 124\n\n;; Struct patterns (requires define-match-type registration)\n(define-match-type point point? point-x point-y)\n(match (make-point 3 4)\n ((point x y) (+ x y))) ;; \u2192 7\n```\n\n### `match/strict` \u2014 Exhaustiveness-Checked Matching\n\n```scheme\n(define-sealed-hierarchy shape\n (circle circle? circle-radius)\n (rect rect? rect-width rect-height))\n\n(match/strict shape my-shape\n ((circle r) (* 3.14 r r))\n ((rect w h) (* w h)))\n;; Warns at runtime if a variant is missing\n```\n\n### `define-active-pattern` \u2014 Custom Extractors\n\n```scheme\n(define-active-pattern (even? n)\n (and (number? n) (zero? (mod n 2)) n))\n\n(match 42\n ((even? n) (str n \" is even\")))\n```\n\n---\n\n## Control Flow\n\n### Conditionals\n\n```scheme\n;; Standard\n(if test then else)\n(cond (test1 expr1) (test2 expr2) (else default))\n(when test body ...)\n(unless test body ...)\n\n;; Anaphoric \u2014 binds result to `it`\n(awhen (find-user name)\n (send-email it))\n\n(aif (lookup key)\n (use it)\n (handle-missing))\n\n;; Conditional binding\n(when-let (x (get-thing))\n (process x))\n\n(if-let (user (find-user id))\n (greet user)\n (show-login))\n```\n\n### Loops\n\n```scheme\n;; Counted loop\n(dotimes (i 10)\n (displayln i)) ;; prints 0..9\n\n;; While/until\n(while (< x 10)\n (set! x (+ x 1)))\n\n(until (> x 10)\n (set! x (+ x 1)))\n\n;; Iterators (see Iterators section)\n(for ((x (in-range 10)))\n (displayln x))\n```\n\n### `assert!`\n\n```scheme\n(assert! (> x 0)) ;; raises error if false\n(assert! (> x 0) \"x must be positive\") ;; with message\n```\n\n---\n\n## Error Handling\n\n### `try` / `catch` / `finally`\n\n```scheme\n;; Basic try/catch\n(try\n (risky-operation)\n (catch (e)\n (displayln \"Error: \" (error-message e))))\n\n;; With predicate\n(try\n (/ 1 0)\n (catch (error? e)\n (displayln \"caught: \" e)))\n\n;; With finally (always runs)\n(try\n (def port (open-input-file \"data.txt\"))\n (process port)\n (catch (e)\n (displayln \"failed\"))\n (finally\n (close-input-port port)))\n```\n\n### Resource Management\n\n```scheme\n;; Guaranteed cleanup\n(unwind-protect\n (do-work)\n (cleanup))\n\n;; Resource lifecycle\n(with-resource (port (open-input-file \"f.txt\") close-input-port)\n (read-all-as-string port))\n\n;; Mutex\n(with-lock my-mutex\n (modify-shared-state))\n```\n\n---\n\n## Result Types\n\nRust-inspired `Result<T,E>` for composable error handling without exceptions.\n\n### Constructors & Predicates\n\n```scheme\n(ok 42) ;; success value\n(err \"not found\") ;; error value\n\n(ok? (ok 42)) ;; \u2192 #t\n(err? (err \"x\")) ;; \u2192 #t\n(result? (ok 1)) ;; \u2192 #t\n```\n\n### Extracting Values\n\n```scheme\n(unwrap (ok 42)) ;; \u2192 42\n(unwrap (err \"x\")) ;; raises error!\n\n(unwrap-or (err \"x\") 0) ;; \u2192 0 (safe default)\n(unwrap-or-else (err \"x\")\n (lambda () (compute-default))) ;; \u2192 lazy default\n\n(unwrap-err (err \"bad\")) ;; \u2192 \"bad\"\n```\n\n### Transforming Results\n\n```scheme\n;; Map over ok values\n(map-ok (lambda (x) (* x 2)) (ok 5)) ;; \u2192 (ok 10)\n(map-ok (lambda (x) (* x 2)) (err \"x\")) ;; \u2192 (err \"x\")\n\n;; Map over error values\n(map-err string-upcase (err \"bad\")) ;; \u2192 (err \"BAD\")\n\n;; Monadic bind (chain operations)\n(and-then (ok 5) (lambda (x)\n (if (> x 0) (ok (* x 2)) (err \"negative\"))))\n;; \u2192 (ok 10)\n\n;; Error recovery\n(or-else (err \"bad\") (lambda (e) (ok 0))) ;; \u2192 (ok 0)\n```\n\n### Exception \u2194 Result Conversion\n\n```scheme\n;; Wrap exceptions as err\n(try-result (/ 1 0)) ;; \u2192 (err <condition>)\n(try-result* (/ 1 0)) ;; \u2192 (err \"...message string...\")\n(try-result (+ 1 2)) ;; \u2192 (ok 3)\n```\n\n### Collection Operations\n\n```scheme\n;; All-or-nothing\n(sequence-results (list (ok 1) (ok 2) (ok 3)))\n;; \u2192 (ok (1 2 3))\n\n(sequence-results (list (ok 1) (err \"x\") (ok 3)))\n;; \u2192 (err \"x\")\n\n;; Partition successes and failures\n(results-partition (list (ok 1) (err \"a\") (ok 2)))\n;; \u2192 ((1 2) . (\"a\"))\n\n;; Filter\n(filter-ok (list (ok 1) (err \"a\") (ok 2))) ;; \u2192 (1 2)\n(filter-err (list (ok 1) (err \"a\") (ok 2))) ;; \u2192 (\"a\")\n```\n\n### Result-Aware Threading\n\n```scheme\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30)\n(->? (err \"x\") (+ 5) (* 2)) ;; \u2192 (err \"x\") \u2014 short circuits\n(->>? (ok 10) (- 3)) ;; \u2192 (ok -7) \u2014 thread last\n```\n\n---\n\n## Iterators\n\n### `for` \u2014 Side Effects\n\n```scheme\n(for ((x (in-range 5)))\n (displayln x))\n;; prints 0 1 2 3 4\n\n;; Multiple iterators (zipped, stops at shortest)\n(for ((name (in-list '(\"Alice\" \"Bob\")))\n (age (in-list '(30 25))))\n (displayln name \": \" age))\n```\n\n### `for/collect` \u2014 Build a List\n\n```scheme\n(for/collect ((x (in-range 5)))\n (* x x))\n;; \u2192 (0 1 4 9 16)\n```\n\n### `for/fold` \u2014 Accumulate\n\n```scheme\n(for/fold ((sum 0)) ((x (in-range 10)))\n (+ sum x))\n;; \u2192 45\n```\n\n### `for/or` \u2014 First Truthy\n\n```scheme\n(for/or ((x (in-list '(1 -2 3 -4))))\n (and (negative? x) x))\n;; \u2192 -2\n```\n\n### `for/and` \u2014 All Truthy\n\n```scheme\n(for/and ((x (in-list '(2 4 6))))\n (even? x))\n;; \u2192 #t\n```\n\n### Iterator Constructors\n\n| Constructor | Description | Example |\n|-------------|-------------|---------|\n| `(in-list lst)` | Iterate over list | `(in-list '(a b c))` |\n| `(in-vector vec)` | Iterate over vector | `(in-vector #(1 2 3))` |\n| `(in-string str)` | Iterate over chars | `(in-string \"abc\")` |\n| `(in-range end)` | 0 to end-1 | `(in-range 5)` \u2192 0..4 |\n| `(in-range start end)` | start to end-1 | `(in-range 2 5)` \u2192 2..4 |\n| `(in-range start end step)` | with step | `(in-range 0 10 2)` \u2192 0,2,4,6,8 |\n| `(in-hash-keys ht)` | Hash table keys | |\n| `(in-hash-values ht)` | Hash table values | |\n| `(in-hash-pairs ht)` | Key-value pairs | `(key . val)` |\n| `(in-naturals)` | 0, 1, 2, ... | Bounded to 100k |\n| `(in-naturals start)` | start, start+1, ... | |\n| `(in-indexed lst)` | `(idx . elem)` pairs | |\n| `(in-port [port [reader]])` | Read datums | |\n| `(in-lines [port])` | Read lines | |\n| `(in-chars [port])` | Read characters | |\n| `(in-bytes [port])` | Read bytes | |\n| `(in-producer thunk [sentinel])` | Call thunk until done | |\n\n---\n\n## Threading Macros\n\n### `->` Thread First\n\nInsert value as **first** argument at each step:\n\n```scheme\n(-> 10\n (+ 5) ;; (+ 10 5) \u2192 15\n (* 2)) ;; (* 15 2) \u2192 30\n```\n\n### `->>` Thread Last\n\nInsert value as **last** argument:\n\n```scheme\n(->> '(1 2 3 4 5)\n (filter even?) ;; (filter even? '(...)) \u2192 (2 4)\n (map (cut * <> 10)) ;; (map ... '(2 4)) \u2192 (20 40)\n (apply +)) ;; \u2192 60\n```\n\n### `as->` Thread with Explicit Name\n\n```scheme\n(as-> 1 x\n (+ x 10) ;; \u2192 11\n (* x 2) ;; \u2192 22\n (- 100 x)) ;; \u2192 78\n```\n\n### `some->` / `some->>` Short-Circuit on `#f`\n\n```scheme\n(some-> user\n (get-address) ;; returns #f if no address\n (get-city)) ;; skipped if previous was #f\n;; \u2192 city or #f\n```\n\n### `cond->` / `cond->>` Conditional Steps\n\n```scheme\n(cond-> base-query\n include-deleted? (add-filter \"deleted = true\")\n limit (add-limit limit))\n```\n\n---\n\n## Ergonomic Typing\n\n### `:` Type Cast\n\n```scheme\n(: value predicate?) ;; checked cast \u2014 raises if wrong type\n(: x number?) ;; asserts x is a number\n```\n\n### `using` \u2014 Typed Bindings with Dot Access\n\n```scheme\n(defstruct point (x y))\n\n(using (p (make-point 3 4) : point?)\n (+ p.x p.y)) ;; p.x \u2192 (point-x p)\n;; \u2192 7\n\n;; Multiple bindings\n(using ((p (make-point 1 2) : point?)\n (c (make-circle 5) : circle?))\n (displayln p.x c.radius))\n\n;; `as` skips the type check (trust mode)\n(using (p some-expr as point?)\n p.x)\n```\n\n### Contract Predicates\n\n```scheme\n;; Predicate factory \u2014 returns a predicate\n((list-of? number?) '(1 2 3)) ;; \u2192 #t\n((list-of? string?) '(1 2 3)) ;; \u2192 #f\n\n;; Maybe \u2014 accepts #f or matching value\n((maybe string?) \"hello\") ;; \u2192 #t\n((maybe string?) #f) ;; \u2192 #t\n((maybe string?) 42) ;; \u2192 #f\n```\n\n---\n\n## Hash Tables\n\n### Construction\n\n```scheme\n;; Empty\n(def ht (make-hash-table))\n\n;; From pairs (literal macro)\n(def ht (hash-literal (\"name\" \"Alice\") (\"age\" 30)))\n\n;; From list of pairs\n(def ht (list->hash-table '((\"a\" . 1) (\"b\" . 2))))\n\n;; From property list\n(def ht (plist->hash-table '(\"name\" \"Alice\" \"age\" 30)))\n```\n\n### Access\n\n```scheme\n(hash-ref ht \"name\") ;; \u2192 \"Alice\" (error if missing)\n(hash-ref ht \"missing\" \"default\") ;; \u2192 \"default\"\n(hash-get ht \"name\") ;; \u2192 \"Alice\" or #f\n(hash-key? ht \"name\") ;; \u2192 #t\n```\n\n### Mutation\n\n```scheme\n(hash-put! ht \"email\" \"alice@example.com\")\n(hash-update! ht \"age\" add1)\n(hash-remove! ht \"email\")\n(hash-merge! target source) ;; merge source into target\n```\n\n### Iteration\n\n```scheme\n(hash-for-each (lambda (k v) (displayln k \": \" v)) ht)\n(hash-map (lambda (k v) (cons k (add1 v))) ht)\n(hash-fold (lambda (k v acc) (+ acc v)) 0 ht)\n\n;; With iterators\n(for ((k (in-hash-keys ht)))\n (displayln k))\n(for (((k . v) (in-hash-pairs ht)))\n (displayln k \" \u2192 \" v))\n```\n\n### Conversion\n\n```scheme\n(hash->list ht) ;; \u2192 ((key . val) ...)\n(hash->plist ht) ;; \u2192 (key val key val ...)\n(hash-keys ht) ;; \u2192 (key ...)\n(hash-values ht) ;; \u2192 (val ...)\n(hash-length ht) ;; \u2192 count\n(hash-copy ht) ;; \u2192 shallow copy\n```\n\n### Destructuring\n\n```scheme\n(let-hash ht (name age)\n (displayln name \" is \" age))\n```\n\n---\n\n## Functions & Combinators\n\n### Partial Application\n\n```scheme\n;; cut / cute (SRFI-26) \u2014 <> marks slots\n((cut + 1 <>) 5) ;; \u2192 6\n((cut map <> '(1 2 3)) add1) ;; \u2192 (2 3 4)\n((cut string-append <> \"!\" <>) \"hi\" \"?\") ;; \u2192 \"hi!?\"\n\n;; partial (Clojure-style)\n((partial + 10) 5) ;; \u2192 15\n```\n\n### Composition\n\n```scheme\n((compose add1 add1) 5) ;; \u2192 7\n((comp add1 (* 2)) 5) ;; same (alias)\n((complement even?) 3) ;; \u2192 #t\n((negate even?) 3) ;; \u2192 #t\n((constantly 42) 'anything) ;; \u2192 42\n(identity 42) ;; \u2192 42\n((flip cons) '(2 3) 1) ;; \u2192 (1 2 3)\n```\n\n### Higher-Order Utilities\n\n```scheme\n((conjoin positive? even?) 4) ;; \u2192 #t (both true)\n((disjoin zero? negative?) -1) ;; \u2192 #t (either true)\n((every-pred number? positive?) 5) ;; \u2192 #t\n((some-fn string? number?) \"hi\") ;; \u2192 #t\n\n((curry + 1) 2) ;; \u2192 3\n((juxt min max) 3 1 4 1 5) ;; \u2192 (1 5)\n((fnil + 0 0) #f 5) ;; \u2192 5 (replaces #f with 0)\n\n(def slow-fib (memo-proc fib)) ;; memoize a procedure\n```\n\n---\n\n## Standard Library\n\nEverything below is available from `(import (jerboa prelude))`.\n\n### Strings \u2014 `(std misc string)`\n\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\")\n(string-join '(\"a\" \"b\" \"c\") \",\") ;; \u2192 \"a,b,c\"\n(string-trim \" hello \") ;; \u2192 \"hello\"\n(string-prefix? \"hel\" \"hello\") ;; \u2192 #t\n(string-suffix? \"llo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index)\n(string-index \"hello\" #\\l) ;; \u2192 2\n(string-empty? \"\") ;; \u2192 #t\n(string-match? \"^[0-9]+$\" \"123\") ;; \u2192 #t\n(string-find \"[0-9]+\" \"abc123\") ;; \u2192 \"123\"\n(string-find-all \"[0-9]+\" \"a1b2\");; \u2192 (\"1\" \"2\")\n(str \"age: \" 25 \"!\") ;; \u2192 \"age: 25!\" (auto-coerce)\n```\n\n### Lists \u2014 `(std misc list)`\n\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3 3)) ;; \u2192 (1 2 3)\n(take '(1 2 3 4 5) 3) ;; \u2192 (1 2 3)\n(drop '(1 2 3 4 5) 3) ;; \u2192 (4 5)\n(take-last '(1 2 3 4) 2) ;; \u2192 (3 4)\n(drop-last '(1 2 3 4) 2) ;; \u2192 (1 2)\n(every number? '(1 2 3)) ;; \u2192 #t\n(any negative? '(1 -2 3)) ;; \u2192 #t\n(filter-map (lambda (x) (and (> x 0) (* x 2))) '(-1 2 -3 4))\n;; \u2192 (4 8)\n(group-by even? '(1 2 3 4 5))\n;; \u2192 ((#t 2 4) (#f 1 3 5))\n(zip '(1 2 3) '(a b c)) ;; \u2192 ((1 a) (2 b) (3 c))\n(frequencies '(a b a c b a)) ;; \u2192 ((a . 3) (b . 2) (c . 1))\n(partition even? '(1 2 3 4 5)) ;; \u2192 ((2 4) (1 3 5))\n(interleave '(1 2 3) '(a b c)) ;; \u2192 (1 a 2 b 3 c)\n(interpose \", \" '(\"a\" \"b\" \"c\")) ;; \u2192 (\"a\" \", \" \"b\" \", \" \"c\")\n(mapcat (lambda (x) (list x x)) '(1 2 3)) ;; \u2192 (1 1 2 2 3 3)\n(distinct '(1 2 1 3 2)) ;; \u2192 (1 2 3)\n(keep (lambda (x) (and (> x 0) x)) '(-1 2 -3 4)) ;; \u2192 (2 4)\n(split-at '(1 2 3 4 5) 3) ;; \u2192 ((1 2 3) (4 5))\n(reductions + 0 '(1 2 3)) ;; \u2192 (0 1 3 6)\n(append-map (lambda (x) (list x x)) '(1 2)) ;; \u2192 (1 1 2 2)\n(snoc '(1 2) 3) ;; \u2192 (1 2 3)\n```\n\n### Association Lists \u2014 `(std misc alist)`\n\n```scheme\n;; Construction\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n\n;; Access (q=eq?, v=eqv?, default=equal?)\n(aget '((name . \"Alice\")) 'name) ;; \u2192 \"Alice\"\n(agetq '((x . 1)) 'x) ;; \u2192 1\n\n;; Mutation\n(aset! '((x . 1)) 'x 2) ;; \u2192 ((x . 2))\n\n;; Property lists\n(pgetq '(x 1 y 2) 'y) ;; \u2192 2\n```\n\n### Sorting \u2014 `(std sort)`\n\n```scheme\n(sort '(3 1 2) <) ;; \u2192 (1 2 3)\n(sort! vec <) ;; in-place on vectors\n(stable-sort lst string<?) ;; preserves order of equal elements\n```\n\n### Formatting \u2014 `(std format)`\n\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"count: ~a\\n\" 42) ;; print to stdout\n(eprintf \"error: ~a\\n\" msg) ;; print to stderr\n```\n\n### JSON \u2014 `(std text json)`\n\n```scheme\n(def data (string->json-object \"{\\\"name\\\":\\\"Alice\\\",\\\"age\\\":30}\"))\n(hash-ref data \"name\") ;; \u2192 \"Alice\"\n\n(json-object->string (hash-literal (\"x\" 1) (\"y\" 2)))\n;; \u2192 \"{\\\"x\\\":1,\\\"y\\\":2}\"\n\n;; Port-based\n(read-json port)\n(write-json obj port)\n```\n\n### Paths \u2014 `(std os path)`\n\n```scheme\n(path-join \"/home\" \"user\" \"file.txt\") ;; \u2192 \"/home/user/file.txt\"\n(path-directory \"/home/user/f.txt\") ;; \u2192 \"/home/user\"\n(path-extension \"/home/user/f.txt\") ;; \u2192 \"txt\"\n(path-strip-extension \"file.txt\") ;; \u2192 \"file\"\n(path-absolute? \"/home\") ;; \u2192 #t\n(path-expand \"~/file\") ;; \u2192 \"/home/user/file\"\n```\n\n### File I/O \u2014 `(std misc ports)`\n\n```scheme\n(read-file-string \"data.txt\") ;; \u2192 entire file as string\n(read-file-lines \"data.txt\") ;; \u2192 list of lines\n(write-file-string \"out.txt\" \"hello\") ;; write string to file\n(read-all-as-string port) ;; read port to string\n```\n\n### CSV \u2014 `(std csv)`\n\n```scheme\n(csv->alists \"name,age\\nAlice,30\\nBob,25\")\n;; \u2192 (((name . \"Alice\") (age . \"30\"))\n;; ((name . \"Bob\") (age . \"25\")))\n\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" '((\"a\" \"b\") (\"1\" \"2\")))\n(rows->csv-string '((\"x\" \"y\") (\"1\" \"2\")))\n```\n\n### DateTime \u2014 `(std datetime)`\n\n```scheme\n(def now (datetime-now))\n(datetime-year now) ;; \u2192 2026\n(datetime->iso8601 now) ;; \u2192 \"2026-03-27T22:13:43Z\"\n\n;; Construction\n(make-datetime 2026 3 27 12 0 0)\n(make-date 2026 3 27)\n(make-time 12 30 0)\n\n;; Parsing\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(parse-date \"2026-03-27\")\n\n;; Arithmetic\n(datetime-add now (make-duration 3600 0)) ;; +1 hour\n(datetime-diff dt1 dt2) ;; \u2192 duration\n\n;; Comparison\n(datetime<? dt1 dt2)\n(datetime-min dt1 dt2)\n(datetime-clamp dt lower upper)\n\n;; Calendar\n(day-of-week (make-date 2026 3 27)) ;; \u2192 5 (Friday)\n(leap-year? 2024) ;; \u2192 #t\n(days-in-month 2026 2) ;; \u2192 28\n```\n\n### Pretty Printing \u2014 `(std debug pp)`\n\n```scheme\n(pp '(a b (c d (e f)))) ;; pretty-print to stdout\n(pp-to-string expr) ;; \u2192 formatted string\n(ppd expr) ;; deep pretty-print (shows internals)\n```\n\n### Error Constructors \u2014 `(std error)`\n\n```scheme\n(Error \"something went wrong\" irritant1 irritant2)\n(ContractViolation \"expected positive\" value)\n```\n\n---\n\n## FFI\n\n### Quick FFI\n\n```scheme\n(import (jerboa prelude))\n\n(c-declare \"#include <math.h>\")\n(def c-sqrt (c-lambda (double) double \"sqrt\"))\n(c-sqrt 2.0) ;; \u2192 1.4142135623730951\n```\n\n### `begin-ffi` Block\n\n```scheme\n(begin-ffi (my-getpid)\n (c-declare \"#include <unistd.h>\")\n (define my-getpid (c-lambda () int \"getpid\")))\n```\n\n### Direct Chez FFI\n\nFor more control, use Chez's native FFI directly:\n\n```scheme\n(import (chezscheme))\n(load-shared-object \"libm.so.6\")\n(def c-sin (foreign-procedure \"sin\" (double) double))\n```\n\n---\n\n## Additional Modules\n\nThese are **not** in the prelude \u2014 import them separately:\n\n```scheme\n;; Networking\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n\n;; Database\n(import (std db sqlite)) ;; SQLite bindings\n\n;; Concurrency\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std concur)) ;; Concurrency primitives\n\n;; Crypto\n(import (std crypto digest)) ;; SHA, MD5, etc.\n(import (std crypto cipher)) ;; AES, etc.\n\n;; Security\n(import (std security sandbox)) ;; Sandboxing\n(import (std security taint)) ;; Taint tracking\n\n;; Text processing\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std text regex)) ;; Regular expressions\n\n;; OS\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std os temp)) ;; Temp files\n```\n\n---\n\n## Differences from Gerbil\n\n| Feature | Gerbil | Jerboa |\n|---------|--------|--------|\n| Backend | Gambit | Chez Scheme |\n| Multiple inheritance | Yes | No (single only) |\n| `[...]` | Various uses | Always `(list ...)` |\n| `{...}` | Method call | Method call (same) |\n| `keyword:` | Keywords | Keywords (same) |\n| Module system | Gerbil modules | R6RS libraries (`.sls`) |\n| Compilation | `gxc` | Load from source / `compile-whole-program` |\n| `export` | `(export ...)` | Part of `(library ...)` form |\n| `##` primitives | Yes (Gambit) | No (use `(chezscheme)` imports) |\n| Iterators | `for/collect` etc. | Same syntax |\n| Result types | Not built-in | Built-in `ok`/`err` |\n| DateTime | Not built-in | Built-in `datetime` |\n| Ergo typing | Not built-in | Built-in `using`, `:` |\n| Threading macros | `->`, `->>` | Same + `->?`, `->>?` (result-aware) |\n\n---\n\n## Differences from Chez Scheme\n\n| Feature | Chez Scheme | Jerboa |\n|---------|-------------|--------|\n| File format | `.sls` with `(library ...)` | `.ss` with `(import ...)` |\n| `define` | `define` | `def` (preferred) |\n| Records | `define-record-type` | `defstruct` / `defclass` |\n| Hash tables | `(make-hashtable ...)` | `(make-hash-table)` with richer API |\n| Pattern matching | None built-in | `match` with guards, views, struct patterns |\n| Error handling | `guard` | `try`/`catch`/`finally` |\n| Macros | `define-syntax` | `defrule`/`defrules` (simpler), or `define-syntax` |\n| Strings | Basic | `string-split`, `string-join`, `str`, regex |\n| Lists | Basic | `take`, `drop`, `flatten`, `group-by`, `zip`, 50+ more |\n| Iteration | `do`, named `let` | `for`/`for/collect`/`for/fold` |\n| Method dispatch | None | `defmethod` + `~` / `{...}` |\n| FFI | `foreign-procedure` | `c-lambda` (simpler) + `foreign-procedure` |\n| JSON | None | Built-in `read-json`/`write-json` |\n| Paths | None | Built-in path operations |\n| CSV | None | Built-in CSV parsing |\n| Result type | None | Built-in `ok`/`err` monad |\n| DateTime | None | Built-in datetime library |\n\n---\n\n## The Jerboa Philosophy\n\n1. **One import to start**: `(import (jerboa prelude))` gives you a complete language\n2. **`.ss` files are the language**: You never need to write `.sls` files\n3. **Gerbil-familiar, Chez-powered**: Syntax is Gerbil-like, performance is Chez\n4. **Batteries included**: JSON, CSV, datetime, result types, iterators \u2014 all in the prelude\n5. **Functional first**: Threading macros, combinators, result monads \u2014 but mutation when needed\n6. **No boilerplate**: `def` over `define`, `defstruct` over `define-record-type`, `match` over nested `cond`\n"} {"text": "<!-- FILE: implement-me.md -->\n# Jerboa Runtime: Features to Implement\n\n## GC Finalizer Safety Net for Unclosed Resources\n\n**ID:** jerboa-finalizer-safety-net \n**Impact:** high \n**Votes:** 1\n\n### What\n\nRegister Chez guardians on resource-acquiring functions (`sqlite-open`, `tcp-connect`, `open-input-file`, etc.). When a resource is garbage collected without being explicitly closed, log a warning that includes the allocation site. This catches resource leaks that `with-resource` would have prevented, without crashing.\n\n### Why\n\nClaude-generated code frequently forgets `with-resource` and uses bare `(let ([db (sqlite-open ...)]) ...)`. The connection leaks silently and is only discovered in production under load. With a finalizer safety net, a warning appears in the log during testing so the leak is caught early.\n\n### Example\n\n```\nWARNING: sqlite handle #7 GC'd without close \u2014 allocated at handler.ss:42\n```\n\nDeveloper then wraps the `sqlite-open` in `with-resource`. Bug fixed before production.\n\n### How to Implement\n\nIn the relevant resource-opening functions (e.g. `sqlite-open` in `lib/std/db/sqlite.sls`, `tcp-connect` in `lib/std/net/tcp.sls`), register a Chez guardian after the resource is created:\n\n```scheme\n;; After creating the resource handle:\n(let ([guardian (make-guardian)])\n (guardian handle)\n (spawn\n (lambda ()\n (let loop ()\n (let ([collected (guardian)])\n (when collected\n (unless (resource-closed? collected)\n (log-warning\n (str \"WARNING: \" (resource-type-name collected)\n \" handle GC'd without close\"\n (if (resource-alloc-site collected)\n (str \" \u2014 allocated at \" (resource-alloc-site collected))\n \"\"))))\n (loop)))))))\n```\n\nKey details:\n- Use `make-guardian` (Chez SRFI-115 guardian API)\n- The guardian thread should be a daemon thread (low priority, doesn't prevent exit)\n- Capture the allocation site via `(call-with-current-continuation ...)` or a `(fluid-let ([*alloc-site* (current-source-location)]) ...)` wrapper at the call site\n- The warning should go to `current-error-port`, not `current-output-port`\n- This is opt-in per module \u2014 add to: `(std db sqlite)`, `(std net tcp)`, `(std net request)`, `(std os file)` at minimum\n\n### Affected Modules\n\n- `lib/std/db/sqlite.sls` \u2014 `sqlite-open`\n- `lib/std/net/tcp.sls` \u2014 `tcp-connect`, `tcp-listen`\n- `lib/std/net/request.sls` \u2014 any connection-holding handle\n- `lib/std/os/file.sls` \u2014 file handles opened without `with-resource`\n\n### Notes\n\n- The warning must NOT prevent GC or cause a crash \u2014 it is purely informational\n- In production, this can be silenced via `(set-resource-leak-warning! #f)`\n- This is a runtime change to the standard library, not an MCP tool\n"} -{"text": "<!-- FILE: AGENTS.md -->\n## The Jerboa Language \u2014 Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** \u2014 those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms \u2014 that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] \u2192 plain parentheses \u2014 same as Gerbil and Chez Scheme\n{method obj args} \u2192 (~ obj 'method args) \u2014 method dispatch\nname: \u2192 keyword #:name\n:std/sort \u2192 (std sort) \u2014 Gerbil-style module path\n#<<END ... END \u2192 heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` \u2192 `hash-key?` (Racket)\n- `hash-table-set!` \u2192 `hash-put!` (Racket)\n- `directory-exists?` \u2192 `file-directory?` (Gambit)\n- `eql?` \u2192 `eqv?` (Common Lisp)\n- `random-integer` \u2192 `random` (Gambit)\n- `read-line` \u2192 `get-line` wrapper (Gambit) \u2014 works with or without port arg\n- `force-output` \u2192 `flush-output-port` wrapper (Gambit) \u2014 works with or without port arg\n- `string-map` \u2192 char-level map (Racket/R7RS) \u2014 `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` \u2014 use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` \u2014 use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` \u2014 use `(defstruct name (fields ...))`\n- `raise` with a string \u2014 use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` \u2014 Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data \u2014 wrong in Jerboa)\n- `time->seconds` \u2014 use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` \u2014 Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` \u2014 no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args \u2014 Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` \u2014 Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` \u2014 Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` \u2014 Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` \u2014 Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` \u2014 Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` \u2014 Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` \u2014 Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` \u2014 R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` \u2014 Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` \u2014 Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` \u2014 NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` \u2014 NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` \u2014 takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` \u2014 takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` \u2014 Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; \u2192 make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; \u2192 color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; \u2192 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; \u2192 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions \u2192 (err condition)\n(try-result* expr) ;; exceptions \u2192 (err \"message string\")\n(sequence-results list-of-results) ;; \u2192 (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; \u2192 (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; \u2192 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access \u2192 (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory \u2192 #t\n((maybe string?) #f) ;; accepts #f or string \u2192 #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; \u2192 val or #f\n(hash-key? ht \"key\") ;; \u2192 #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; \u2192 \"a,b\"\n(string-trim \" hi \") ;; \u2192 \"hi\"\n(string-prefix? \"he\" \"hello\") ;; \u2192 #t\n(string-suffix? \"lo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index, not boolean!)\n(string-empty? \"\") ;; \u2192 #t\n(str \"age: \" 42 \"!\") ;; \u2192 \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3)) ;; \u2192 (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; \u2192 (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; \u2192 hash table\n(json-object->string ht) ;; \u2192 JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; \u2192 (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; \u2192 \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; \u2192 \"/a/b\"\n(path-extension \"file.txt\") ;; \u2192 \"txt\"\n(path-absolute? \"/home\") ;; \u2192 #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; \u2192 entire file\n(read-file-lines \"f.txt\") ;; \u2192 list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available \u2014 the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` \u2014 **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` \u2014 **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` \u2014 Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools \u2014 MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess \u2014 always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** \u2014 BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** \u2014 confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** \u2014 combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** \u2014 for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` \u2014 cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` \u2014 never guess function names |\n| Check function arity/args | `jerboa_function_signature` \u2014 prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` \u2014 one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` \u2014 use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` \u2014 maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` \u2014 source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` \u2014 prefer over bash `make` |\n| Run tests | `jerboa_run_tests` \u2014 prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` \u2014 common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` \u2014 fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` \u2014 use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` \u2014 balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` \u2014 type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` \u2014 see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error\u2192fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche \u2014 every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text": "<!-- FILE: AGENTS.md -->\n## The Jerboa Language \u2014 Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** \u2014 those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms \u2014 that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] \u2192 plain parentheses \u2014 same as Gerbil and Chez Scheme\n{method obj args} \u2192 (~ obj 'method args) \u2014 method dispatch\nname: \u2192 keyword #:name\n:std/sort \u2192 (std sort) \u2014 Gerbil-style module path\n#<<END ... END \u2192 heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` \u2192 `hash-key?` (Racket)\n- `hash-table-set!` \u2192 `hash-put!` (Racket)\n- `directory-exists?` \u2192 `file-directory?` (Gambit)\n- `eql?` \u2192 `eqv?` (Common Lisp)\n- `random-integer` \u2192 `random` (Gambit)\n- `read-line` \u2192 `get-line` wrapper (Gambit) \u2014 works with or without port arg\n- `force-output` \u2192 `flush-output-port` wrapper (Gambit) \u2014 works with or without port arg\n- `string-map` \u2192 char-level map (Racket/R7RS) \u2014 `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` \u2014 use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` \u2014 use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` \u2014 use `(defstruct name (fields ...))`\n- `raise` with a string \u2014 use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` \u2014 Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data \u2014 wrong in Jerboa)\n- `time->seconds` \u2014 use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` \u2014 Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` \u2014 no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args \u2014 Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` \u2014 Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` \u2014 Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` \u2014 Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` \u2014 Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` \u2014 Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` \u2014 Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` \u2014 Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` \u2014 R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` \u2014 Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` \u2014 Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` \u2192 returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` \u2014 NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` \u2014 NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` \u2014 takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` \u2014 takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` \u2014 Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; \u2192 make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; \u2192 color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; \u2192 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; \u2192 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions \u2192 (err condition)\n(try-result* expr) ;; exceptions \u2192 (err \"message string\")\n(sequence-results list-of-results) ;; \u2192 (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; \u2192 (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; \u2192 (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; \u2192 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access \u2192 (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory \u2192 #t\n((maybe string?) #f) ;; accepts #f or string \u2192 #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; \u2192 val or #f\n(hash-key? ht \"key\") ;; \u2192 #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; \u2192 (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; \u2192 \"a,b\"\n(string-trim \" hi \") ;; \u2192 \"hi\"\n(string-prefix? \"he\" \"hello\") ;; \u2192 #t\n(string-suffix? \"lo\" \"hello\") ;; \u2192 #t\n(string-contains \"hello\" \"ell\") ;; \u2192 1 (index, not boolean!)\n(string-empty? \"\") ;; \u2192 #t\n(str \"age: \" 42 \"!\") ;; \u2192 \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; \u2192 (1 2 3)\n(unique '(1 2 2 3)) ;; \u2192 (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; \u2192 (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; \u2192 hash table\n(json-object->string ht) ;; \u2192 JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; \u2192 (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; \u2192 list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; \u2192 \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; \u2192 \"/a/b\"\n(path-extension \"file.txt\") ;; \u2192 \"txt\"\n(path-absolute? \"/home\") ;; \u2192 #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; \u2192 entire file\n(read-file-lines \"f.txt\") ;; \u2192 list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; \u2192 \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; \u2192 ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available \u2014 the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` \u2014 Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` \u2014 **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` \u2014 Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools \u2014 MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess \u2014 always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** \u2014 BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** \u2014 confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** \u2014 combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** \u2014 for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` \u2014 cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` \u2014 never guess function names |\n| Check function arity/args | `jerboa_function_signature` \u2014 prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` \u2014 one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` \u2014 use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` \u2014 maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` \u2014 source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` \u2014 prefer over bash `make` |\n| Run tests | `jerboa_run_tests` \u2014 prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` \u2014 common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` \u2014 fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` \u2014 use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` \u2014 balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` \u2014 type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` \u2014 see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error\u2192fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche \u2014 every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text": "<!-- FILE: libraries.md -->\n# Jerboa Library Gap Analysis\n\nGerbil has ~438 `:std/*` modules. Jerboa currently implements 51. This document tracks coverage and what's needed to close the gap.\n\n## Current Coverage (51 modules)\n\n| Category | Jerboa | Gerbil | Coverage |\n|----------|--------|--------|----------|\n| Core (sort, format, error, sugar, pregexp, logger, test) | 7 | ~15 | 47% |\n| text/* (json, csv, hex, base64, utf8, xml, yaml) | 7 | ~15 | 47% |\n| misc/* (string, list, alist, ports, channel, thread, process, queue, bytes, uuid, repr, completion) | 12 | ~38 | 32% |\n| os/* (path, env, signal, temporaries, fdio, epoll, inotify) | 7 | ~16 | 44% |\n| crypto/* (digest, cipher, hmac, pkey, kdf, etc) | 6 | ~9 | 67% |\n| net/* (request, httpd, ssl) | 3 | ~40+ | 8% |\n| db/* (leveldb, sqlite, postgresql) | 3 | ~4 | 75% |\n| cli/* (getopt) | 1 | ~4 | 25% |\n| srfi/* (13, 19) | 2 | ~60+ | 3% |\n| compress/* (zlib) | 1 | 0 | N/A |\n| pcre2 | 1 | 0 | N/A |\n\n## External chez-* Libraries\n\n### Already Integrated\n\n| Library | Wraps | Jerboa Modules |\n|---------|-------|---------------|\n| [chez-ssl](https://github.com/ober/chez-ssl) | OpenSSL TLS/TCP | `(std net ssl)` |\n| [chez-https](https://github.com/ober/chez-https) | HTTP client+server | `(std net request)`, `(std net httpd)` |\n| [chez-zlib](https://github.com/ober/chez-zlib) | zlib compression | `(std compress zlib)` |\n| [chez-pcre2](https://github.com/ober/chez-pcre2) | PCRE2 regex | `(std pcre2)` |\n| [chez-leveldb](https://github.com/ober/chez-leveldb) | LevelDB | `(std db leveldb)` |\n\n### Completed (New)\n\n| Library | Wraps | Jerboa Modules | Status |\n|---------|-------|---------------|--------|\n| [chez-epoll](https://github.com/ober/chez-epoll) | Linux epoll | `(std os epoll)` | Done |\n| [chez-inotify](https://github.com/ober/chez-inotify) | Linux inotify | `(std os inotify)` | Done |\n| [chez-crypto](https://github.com/ober/chez-crypto) | OpenSSL EVP | `(std crypto cipher)`, `(std crypto hmac)`, `(std crypto pkey)`, `(std crypto kdf)`, `(std crypto etc)` | Done |\n| [chez-sqlite](https://github.com/ober/chez-sqlite) | SQLite3 | `(std db sqlite)` | Done |\n| [chez-postgresql](https://github.com/ober/chez-postgresql) | libpq | `(std db postgresql)` | Done |\n\n### Replaced (No Longer Needed)\n\n| Library | Replaced By | Notes |\n|---------|------------|-------|\n| [chez-yaml](https://github.com/ober/chez-yaml) | Pure Scheme `(std text yaml)` | Roundtrip support: preserves comments, key ordering, scalar styles. No C dependency. 58 tests. |\n\n## Pure Scheme Modules (No External Deps)\n\n### High Priority \u2014 Commonly Used\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std iter)` | Iteration protocol | TODO |\n| `(std interface)` | Interface/protocol system | TODO |\n| `(std generic)` | Generic functions (CLOS-lite) | TODO |\n| `(std event)` | Event/sync system | TODO |\n| `(std coroutine)` | Coroutines via continuations | TODO |\n| `(std lazy)` | Lazy evaluation (delay/force) | TODO |\n| `(std values)` | Multiple-values utilities | TODO |\n| `(std ref)` | Generic ref/set! | TODO |\n| `(std contract)` | Design-by-contract | TODO |\n| `(std amb)` | Nondeterminism | TODO |\n| `(std net uri)` | URI parsing/encoding | TODO |\n| `(std net address)` | Network address parsing | TODO |\n| `(std net json-rpc)` | JSON-RPC protocol | TODO |\n| `(std parser)` | Parser combinators | TODO |\n| `(std protobuf)` | Protocol Buffers | TODO |\n\n### misc/* \u2014 Data Structures & Utilities\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std misc hash)` | Extended hash utilities | TODO |\n| `(std misc func)` | Function combinators | TODO |\n| `(std misc number)` | Number utilities | TODO |\n| `(std misc decimal)` | Decimal arithmetic | TODO |\n| `(std misc deque)` | Double-ended queue | TODO |\n| `(std misc pqueue)` | Priority queue | TODO |\n| `(std misc rbtree)` | Red-black tree | TODO |\n| `(std misc lru)` | LRU cache | TODO |\n| `(std misc dag)` | DAG operations | TODO |\n| `(std misc shuffle)` | Random shuffle | TODO |\n| `(std misc vector)` | Vector utilities | TODO |\n| `(std misc symbol)` | Symbol utilities | TODO |\n| `(std misc plist)` | Property lists | TODO |\n| `(std misc text)` | Text utilities | TODO |\n| `(std misc walist)` | Weak-alist | TODO |\n| `(std misc list-builder)` | List builder pattern | TODO |\n| `(std misc timeout)` | Timeout utilities | TODO |\n| `(std misc barrier)` | Thread barrier | TODO |\n| `(std misc rwlock)` | Read-write lock | TODO |\n| `(std misc concurrent-plan)` | Concurrent DAG executor | TODO |\n| `(std misc atom)` | Atomic reference | TODO |\n| `(std misc sync)` | Synchronization primitives | TODO |\n| `(std misc wg)` | WaitGroup | TODO |\n| `(std misc evector)` | Extensible vector | TODO |\n| `(std misc shared)` | Shared structure detection | TODO |\n| `(std misc path)` | Path utilities (beyond os/path) | TODO |\n| `(std misc prime)` | Prime numbers | TODO |\n| `(std misc template)` | String templates | TODO |\n\n### text/* \u2014 Text Processing\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std text base58)` | Base58 encode/decode | TODO |\n| `(std text utf16)` | UTF-16 utilities | TODO |\n| `(std text utf32)` | UTF-32 utilities | TODO |\n| `(std text char-set)` | Character sets (SRFI-14) | TODO |\n| `(std text zlib)` | zlib in text format | Covered by `(std compress zlib)` |\n\n### os/* \u2014 Operating System\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std os hostname)` | Get hostname | TODO |\n| `(std os pid)` | Process ID utilities | TODO |\n| `(std os pipe)` | Pipe creation | TODO |\n| `(std os flock)` | File locking | TODO |\n| `(std os fcntl)` | fcntl operations | TODO |\n| `(std os error)` | OS error codes | TODO |\n| `(std os fd)` | File descriptor utilities | TODO |\n| `(std os socket)` | Raw socket operations | TODO |\n| `(std os epoll)` | Linux epoll | Done |\n| `(std os inotify)` | Linux inotify | Done |\n| `(std os kqueue)` | BSD kqueue | N/A (Linux only) |\n| `(std os signalfd)` | Linux signalfd | TODO |\n\n### cli/* \u2014 Command Line\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std cli multicall)` | Busybox-style multicall | TODO |\n| `(std cli shell)` | Shell completion generation | TODO |\n| `(std cli print-exit)` | Print-and-exit patterns | TODO |\n\n### net/* \u2014 Networking (beyond HTTP)\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std net websocket)` | WebSocket client/server | TODO |\n| `(std net smtp)` | SMTP email sending | TODO |\n| `(std net socks)` | SOCKS proxy | TODO |\n| `(std net s3)` | AWS S3 client | TODO |\n| `(std net repl)` | Network REPL | TODO |\n| `(std net bio)` | Buffered network I/O | TODO |\n| `(std net socket)` | Socket abstraction | TODO |\n\n### markup/* \u2014 HTML/XML/TAL\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std markup html)` | HTML generation | TODO |\n| `(std markup xml)` | XML processing | Partially covered by `(std text xml)` |\n| `(std markup sxml)` | SXML processing | TODO |\n| `(std markup tal)` | TAL templates | TODO |\n\n### Other\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std mime types)` | MIME type database | TODO |\n| `(std io)` | Buffered I/O framework | TODO |\n| `(std debug DBG)` | Debug printing | TODO |\n| `(std debug heap)` | Heap analysis | TODO |\n| `(std debug threads)` | Thread debugging | TODO |\n| `(std web fastcgi)` | FastCGI protocol | TODO |\n| `(std web rack)` | Rack-style web framework | TODO |\n\n### srfi/* \u2014 Scheme Requests for Implementation\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std srfi 1)` | List library | TODO |\n| `(std srfi 8)` | receive (multiple values) | TODO |\n| `(std srfi 9)` | Records | TODO |\n| `(std srfi 14)` | Character sets | TODO |\n| `(std srfi 41)` | Streams (lazy lists) | TODO |\n| `(std srfi 42)` | Eager comprehensions | TODO |\n| `(std srfi 43)` | Vector library | TODO |\n| `(std srfi 78)` | Lightweight testing | TODO |\n| `(std srfi 95)` | Sorting and merging | TODO |\n| `(std srfi 101)` | Purely functional random-access pairs | TODO |\n| `(std srfi 113)` | Sets and bags | TODO |\n| `(std srfi 115)` | Regexp | TODO |\n| `(std srfi 116)` | Immutable pairs | TODO |\n| `(std srfi 117)` | Queues based on lists | TODO |\n| `(std srfi 121)` | Generators | TODO |\n| `(std srfi 124)` | Ephemerons | TODO |\n| `(std srfi 125)` | Hash tables | TODO |\n| `(std srfi 127)` | Lazy sequences | TODO |\n| `(std srfi 128)` | Comparators | TODO |\n| `(std srfi 130)` | Cursor-based string library | TODO |\n| `(std srfi 132)` | Sort libraries | TODO |\n| `(std srfi 133)` | Vector library (R7RS-compatible) | TODO |\n| `(std srfi 134)` | Immutable deques | TODO |\n| `(std srfi 135)` | Immutable texts | TODO |\n| `(std srfi 141)` | Integer division | TODO |\n| `(std srfi 143)` | Fixnums | TODO |\n| `(std srfi 144)` | Flonums | TODO |\n| `(std srfi 145)` | Assumptions | TODO |\n| `(std srfi 146)` | Mappings | TODO |\n| `(std srfi 151)` | Bitwise operations | TODO |\n| `(std srfi 158)` | Generators and accumulators | TODO |\n| `(std srfi 159)` | Combinator formatting | TODO |\n| `(std srfi 160)` | Homogeneous numeric vector | TODO |\n| `(std srfi 212)` | Aliases | TODO |\n\n## Actor System\n\nThe Gerbil actor system (v13 + v18, ~30+ modules) is deeply tied to the Gerbil runtime and would require significant design work to port. This is out of scope for initial coverage.\n\n## I/O System\n\nGerbil's `:std/io` subsystem (~30+ modules) provides a layered buffered I/O framework. Chez Scheme's built-in port system covers most use cases, but a compatibility layer could be built for code that depends on bio/strio APIs.\n"} {"text": "<!-- FILE: CLAUDE.md -->\n## Pre-commit Requirements\n\n**ALWAYS** run a clean build **before** committing any code to this repository. Pick the right target for the *current* platform:\n\n- **Linux**: run `make docker-build` \u2014 the Docker image must build cleanly against the full musl-static release pipeline.\n- **macOS / FreeBSD / other**: run `make binary` \u2014 the native local build must succeed. Do **not** run `make docker-build` here; Docker on non-Linux hosts is slow and not the canonical pipeline for those platforms.\n\nDo not commit if the build fails.\n\n## Act First, Read Less\n\nWhen making changes, read only what you need to make the edit, then make it.\nDo not read more than 3 files before acting. Do not re-read files you already\nread. Do not verify things you already know. If you have enough context to make\na change, make it. The user will interrupt you if you are wrong.\n\n"} {"text": "<!-- FILE: secure.md -->\n# Jerboa Secure Binary Strategy\n\n## The Problem\n\nJerboa compiles to Chez Scheme native code. A static musl binary (e.g., jerboa-secmon at 11MB) embeds:\n\n| Component | Size | ROP Gadgets |\n|-----------|------|-------------|\n| petite.boot | ~1.9MB | None (`.rodata` data) |\n| scheme.boot | ~1.0MB | None (data) |\n| app.boot | ~2.6MB | None (data) |\n| libkernel (Chez runtime) | ~1.0MB | **Thousands** \u2014 GC, compiler, thread scheduler, I/O |\n| musl libc | ~200KB | Some |\n| Rust native lib | ~500KB | Minimal (memory-safe code) |\n| ffi-shim + program | ~25KB | Minimal |\n\nThe Chez runtime (`libkernel`) is the primary source of ROP gadgets. At ~1MB of native code, it contains thousands of potentially usable gadget sequences. It is heavily interconnected (GC references compiler, compiler references I/O, I/O references threading) so `--gc-sections` removes very little.\n\nBoot files are pure data \u2014 zero gadget contribution. The Rust native library contributes minimal gadgets due to memory safety.\n\n---\n\n## Path 1: Harden the Chez Binary\n\n**Effort**: Days. **Impact**: Highest bang for buck.\n\nThis doesn't shrink the binary but makes gadgets effectively unusable through hardware and OS enforcement.\n\n### Intel CET (Control-flow Enforcement Technology)\n\nRequires CPU support (`ibt` and `user_shstk` in `/proc/cpuinfo`). Available on Intel 12th gen+ and AMD Zen 4+.\n\n#### Shadow Stack (SHSTK) \u2014 Priority: Very High\n\nHardware maintains a second copy of return addresses on a separate, protected shadow stack. On every `ret`, the CPU cross-checks the return address against the shadow copy. If they differ (because an attacker overwrote the real stack), the CPU faults with `#CP`.\n\nThis **directly defeats classical ROP**, which fundamentally relies on corrupted return addresses.\n\n**Chez compatibility**: Likely works without modification. Chez uses standard `call`/`ret` calling conventions. The JIT-generated code uses normal x86_64 function prologues/epilogues. Shadow stack enforcement should be transparent.\n\n**To enable**: Rebuild Chez with `-fcf-protection=return` (SHSTK only) or `-fcf-protection=full` (SHSTK + IBT). The binary must also be linked with CET-aware linker flags.\n\n#### Indirect Branch Tracking (IBT) \u2014 Priority: Medium\n\nEvery indirect jump/call target must begin with an `ENDBR64` instruction. If control flow arrives at a non-`ENDBR64` instruction via indirect branch, the CPU faults.\n\n**Chez compatibility**: Problematic. Chez's code generator emits native x86_64 code at runtime (during `compile-program` and boot file loading). This JIT-generated code does **not** have `ENDBR64` instructions at function entries. IBT will fault on calls into Chez-compiled code.\n\n**Fix**: Patch Chez's code generator (`compile.ss` and `gc.c`) to emit `ENDBR64` (4 bytes: `f3 0f 1e fa`) at every compiled function entry point. This is a targeted change \u2014 feasible but requires understanding Chez internals.\n\n**Alternative**: Enable SHSTK-only mode via `prctl(PR_SET_SHADOW_STACK, ...)` without IBT. Gets return-address protection without the indirect-branch requirement.\n\n### Standard Hardening CFLAGS\n\nRebuild Chez and all C code with:\n\n```\n-fstack-protector-strong # Stack canaries on functions with arrays/address-taken vars\n-fstack-clash-protection # Probe large stack allocations (prevent guard-page bypass)\n-fcf-protection=full # CET: shadow stack + indirect branch tracking\n-D_FORTIFY_SOURCE=2 # Compile-time and runtime buffer overflow checks\n-Wl,-z,relro,-z,now # Full RELRO (read-only GOT/PLT after startup)\n-pie # Position-independent executable (for ASLR)\n```\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** \u2014 all of the above are now applied by\ndefault. The `build-musl-binary` and `musl-link-command` functions automatically add these\nflags. Pass `no-harden: #t` to disable for debugging. CET flags (`-fcf-protection=full`)\nare only added on x86_64 Linux machine types.\n\n**Status: DONE in `jerboa-native-rs/.cargo/config.toml`** \u2014 Rust builds now pass\n`-Wl,-z,relro,-z,now` for all targets and `-fcf-protection=full` for x86_64 Linux.\n\n**NOT YET DONE \u2014 downstream projects**: jerboa-secmon and jerboa-dns have their own\nbuild scripts (`build-secmon-musl.ss`, `build-secmon-musl.sh`, `Dockerfile`) that hardcode\n`musl-gcc -c -O2` and `musl-gcc -static` directly instead of using `(jerboa build musl)`.\nThese need the same flags added manually, or better, ported to use the shared build module.\n\n**NOT YET DONE \u2014 Chez Scheme itself (libkernel.a)**: This is the biggest gap. The\nDockerfile builds Chez with `./configure --threads --disable-x11 --static CC=musl-gcc`\nand no `CFLAGS` override. The resulting `libkernel.a` \u2014 the ~1MB primary source of ROP\ngadgets \u2014 has **zero hardening**: no stack canaries, no CET, no FORTIFY_SOURCE. Fix by\npassing hardening flags when building Chez:\n\n```bash\n./configure --threads --disable-x11 --static \\\n CC=musl-gcc \\\n CFLAGS=\"-O2 -fstack-protector-strong -fstack-clash-protection -D_FORTIFY_SOURCE=2 -fPIE -fcf-protection=full\"\n```\n\nThis is the single highest-impact change remaining \u2014 it hardens the code that contributes\nthe most ROP gadgets.\n\n### Static PIE\n\nSwitch musl build from `-static` to **`-static-pie`**. This enables full ASLR for the entire binary \u2014 the base address, stack, heap, and mmap regions are all randomized on each execution.\n\nStatic linking actually slightly increases the gadget set (musl code is embedded rather than at a separate randomized address), but static PIE with ASLR makes all gadget addresses unpredictable. An attacker needs an information leak before they can chain gadgets.\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** \u2014 `musl-link-command` now uses\n`-static-pie` by default instead of `-static`.\n\n### Namespace Isolation\n\nAdd Linux namespace isolation to the security cage module (`lib/std/security/cage.sls`). After initialization, call:\n\n```c\nunshare(CLONE_NEWPID | CLONE_NEWNS | CLONE_NEWNET)\n```\n\nThis creates:\n- **PID namespace**: Process can't see or signal other processes\n- **Mount namespace**: Process sees only an allow-listed filesystem\n- **Network namespace**: Process has only its own network stack (or a specific pre-bound socket)\n\nCombined with existing seccomp + Landlock/Capsicum, this creates micro-VM-like isolation without VM overhead.\n\n**Requirement**: `CAP_SYS_ADMIN` or unprivileged user namespaces enabled (`sysctl kernel.unprivileged_userns_clone=1`).\n\n### Hardening Summary\n\n| Technique | Works with Chez JIT? | Effort | ROP Impact |\n|-----------|---------------------|--------|------------|\n| **SHSTK (shadow stack)** | Likely yes | Low (rebuild Chez) | **Directly defeats ROP** |\n| **IBT (indirect branch)** | No (needs Chez patch) | High | Constrains gadgets to function entries |\n| Stack canaries | C code only, not JIT | Low (add CFLAG) | Detects stack buffer overflows |\n| Static PIE + ASLR | Yes | Low (change linker flag) | Gadget addresses unpredictable |\n| `-fstack-clash-protection` | Yes | Trivial | Prevents guard-page bypass |\n| seccomp post-init | Yes | **Already done** | Blocks ptrace, process_vm_readv |\n| Landlock/Capsicum post-init | Yes | **Already done** | Blocks filesystem escape |\n| Anti-debug | Yes | **Already done** | Blocks dynamic analysis |\n| Integrity verification | Yes | **Already done** | Detects binary modification |\n| Namespace isolation | Yes | Medium | PID/mount/network containment |\n\n### FreeBSD Portability (Path 1)\n\n**Intel CET is not available on any released FreeBSD.** Kernel SHSTK plumbing exists in\n15-CURRENT only (Konstantin Belousov's work). IBT enforcement has not been implemented.\nUserland CET support (rtld awareness, base compiled with `-fcf-protection`) is incomplete\neven in -CURRENT. This means the highest-value ROP mitigation \u2014 hardware shadow stacks \u2014\nis Linux-only for the foreseeable future.\n\n**What FreeBSD 14.x provides today:**\n\n| Feature | FreeBSD Status | vs Linux |\n|---------|---------------|----------|\n| ASLR + PIE | On by default since 13.0 | **Lower entropy**: ~14 bits (stack) vs Linux ~22 bits |\n| Stack canaries (`-strong`) | Since 12.0 | Comparable |\n| `_FORTIFY_SOURCE=2` | Since 14.0 | Linux distros had this since ~2006 |\n| Full RELRO + BIND_NOW | Since 12.0 | Comparable |\n| Stack clash protection | Since ~13.x (clang) | Comparable |\n| Capsicum capability mode | Mature, since 9.0 | No Linux equivalent (seccomp is different) |\n| ARM PAC | Since 13.0 (arm64) | Comparable (Linux 5.0+) |\n| ARM BTI | Since 14.0 (arm64) | Comparable (Linux 5.10+) |\n| W^X opt-in (PROTMAX) | Since 14.0 via `procctl` | Linux has `prctl(SET_MDWE)` since 6.3 |\n| SafeStack | Available (clang), not default | Same on Linux |\n\n**The Capsicum vs seccomp gap for ROP containment:**\n\nCapsicum and seccomp solve different problems. Capsicum restricts *which resources* a process\ncan access (file descriptors, paths). seccomp restricts *which syscalls* a process can make.\n\nFor ROP mitigation specifically, seccomp has a critical advantage: it can **block\n`mprotect(PROT_EXEC)`** after initialization, preventing a ROP chain from making attacker-\ncontrolled data executable (the typical second stage after gaining control flow). Capsicum\ncannot do this \u2014 it does not filter memory operations.\n\nFreeBSD's `procctl(PROC_PROTMAX_CTL)` partially addresses this gap: when enabled, the\nmaximum protection on a mapping is set at `mmap` time and cannot be escalated via `mprotect`.\nHowever, this breaks Chez's JIT pattern (`mmap(RW)` then `mprotect(RX)`) unless all JIT\ncompilation completes before PROTMAX is enabled. A post-init PROTMAX call \u2014 after boot files\nare loaded and all code is compiled \u2014 could work but requires careful sequencing.\n\n**FreeBSD-specific hardening not available on Linux:**\n\n- **Capsicum**: Process-level capability confinement with per-fd rights limiting. More\n principled than seccomp for resource access control. Already integrated into Jerboa's\n cage module.\n- **HardenedBSD**: A FreeBSD fork with PaX-like features (strict W^X via NOEXEC, SEGVGUARD\n for brute-force ASLR defeat prevention, mandatory SafeStack). Tracks FreeBSD 14/15\n branches. Worth considering as a deployment target for maximum hardening.\n\n**Practical implication**: On FreeBSD, the lack of CET makes **Path 2 (WASM sandbox) more\nimportant** than on Linux. Without hardware return-address protection, software isolation of\nsecurity-critical parsers becomes the primary ROP defense rather than a defense-in-depth layer.\n\n**ARM64 FreeBSD** (e.g., AWS Graviton) is a notable bright spot: PAC (since 13.0) provides\nhardware return-address signing, and BTI (since 14.0) provides landing-pad enforcement. These\nare the ARM equivalents of CET SHSTK and IBT respectively, and they are available on released\nFreeBSD. For maximum hardware security on FreeBSD, target arm64.\n\n---\n\n## Path 2: WASM Sandbox for Parsers\n\n**Effort**: Weeks. **Impact**: Strongest isolation for the most-attacked code.\n\n### Why WASM Eliminates ROP\n\nWebAssembly is **structurally immune** to classical ROP:\n\n- **Separate code and data spaces**: Linear memory (where attacker-controlled input lives) cannot address the code section. You cannot scan executable pages for gadget sequences because they are in a completely separate address space managed by the runtime.\n- **No raw jumps**: All control flow uses `block`/`loop`/`if`/`br`/`br_table`. There is no `ret` instruction that pops an address off the stack.\n- **Opaque execution stack**: The WASM call stack is managed by the runtime, invisible to guest code. Buffer overflows in linear memory cannot overwrite return addresses because return addresses don't exist in linear memory.\n- **Typed indirect calls**: `call_indirect` validates function type signatures at runtime. You cannot redirect an indirect call to an arbitrary function.\n\nEven with arbitrary write within WASM linear memory, an attacker cannot hijack control flow. The attack surface shifts entirely to bugs in the WASM runtime itself.\n\n### Architecture: Split Design\n\n```\nJerboa binary\n\u251c\u2500\u2500 Chez runtime (orchestration, policy, configuration DSL)\n\u251c\u2500\u2500 Rust native lib (crypto via ring, TLS via rustls)\n\u2514\u2500\u2500 wasmi WASM interpreter (security-critical parsers)\n \u251c\u2500\u2500 dns_parser.wasm (DNS packet parsing)\n \u251c\u2500\u2500 http_parser.wasm (HTTP request parsing)\n \u2514\u2500\u2500 proto_fsm.wasm (protocol state machines)\n```\n\nSecurity-critical parsing code is written in Rust, compiled to `.wasm`, and executed inside an interpreter-mode WASM runtime embedded in the Jerboa binary. The Chez/Jerboa layer handles orchestration, policy evaluation, and configuration.\n\n### WASM Runtime Options\n\n| Runtime | Binary overhead | Mode | Gadgets in runtime | Best for |\n|---------|----------------|------|-------------------|----------|\n| **wasm3** | ~100KB static | Interpreter | Near-zero (tiny loop) | Maximum minimality |\n| **WAMR** | ~50-85KB | Interpreter | Near-zero | Embedded/IoT |\n| **wasmi** | ~2-3MB as Rust lib | Interpreter | Near-zero | Pure Rust, integrates with jerboa-native-rs |\n| **Wasmtime** | ~15-20MB | JIT (Cranelift) | Some (JIT code) | Full WASI, best tooling |\n\n**Key insight**: Interpreter-mode runtimes generate **zero native code at runtime**. The entire attack surface is the statically-compiled interpreter loop. A wasm3 interpreter is ~3,000 lines of C. Compare that to the millions of gadget-contributing instructions in Chez's runtime.\n\n### Integration with jerboa-native-rs\n\nAdd wasmi as a dependency in `jerboa-native-rs/Cargo.toml`. Expose FFI functions:\n\n```rust\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_load(module_bytes: *const u8, len: usize) -> i32;\n\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_call(\n func_name: *const u8, name_len: usize,\n input: *const u8, input_len: usize,\n output: *mut u8, output_len: usize,\n actual_len: *mut usize\n) -> i32;\n```\n\nScheme code calls through `foreign-procedure`:\n\n```scheme\n(define wasm-call\n (foreign-procedure \"jerboa_wasm_call\" (string int u8* int u8* int void*) int))\n```\n\n### Performance\n\nInterpreter-mode WASM is 10-100x slower than native. For a DNS server, the bottleneck is network I/O, not parsing compute. A DNS response parser running in wasm3 at 1/50th native speed still finishes in microseconds \u2014 acceptable for security-critical paths.\n\n### Existing WASM Infrastructure\n\nJerboa already has embryonic WASM support in `lib/jerboa/wasm/`:\n- `codegen.sls` \u2014 Compile restricted Scheme subset to WASM binary (i32-only, no closures)\n- `runtime.sls` \u2014 Stack-based WASM interpreter for testing\n- `format.sls` \u2014 LEB128 encoding, section parsing, binary format primitives\n\nThis is currently educational/testing-grade but the format layer is real and could serve as a foundation.\n\n---\n\n## Path 3: Minimal Interpreter Binary\n\n**Effort**: Months. **Impact**: Smallest possible footprint (~500KB).\n\nFor tools where binary size and gadget count are the absolute priority, replace the Chez runtime entirely with a minimal Scheme interpreter.\n\n### s7 Scheme\n\n- Single C file, ~35,000 lines. Compiles to **~400KB**.\n- Interpreter-only: no JIT means no W+X pages, no dynamically generated gadgets.\n- Full access to C hardening flags: `-fcf-protection=full`, `-fstack-protector-strong`, etc.\n- R7RS-ish with extensions. Not Chez-compatible.\n- ~50-100x slower than Chez for compute-heavy code. Acceptable for I/O-bound servers.\n\n### Architecture\n\n```\nStatic binary (~500KB-1MB)\n\u251c\u2500\u2500 s7 Scheme interpreter (400KB, fully hardened C)\n\u251c\u2500\u2500 Rust native lib (crypto, TLS, WASM runtime)\n\u2514\u2500\u2500 Application logic in s7 Scheme\n```\n\n### Tradeoff\n\nThis means **leaving Jerboa** for those specific tools. You'd be writing a different program in a different Scheme dialect. The Jerboa prelude, reader syntax, defstruct/defclass/defmethod, capability system, effects, contracts \u2014 none of it carries over.\n\nThis path only makes sense if you're willing to write the security tools as standalone projects that don't depend on Jerboa's ecosystem. Jerboa could still be used for development, prototyping, and testing, with the production binary being a separate s7-based build.\n\n---\n\n## Approaches NOT Worth Pursuing\n\n### Scheme-to-Rust Transpilation\n\nFundamental type system mismatch makes automated translation impossible:\n- **Continuations**: Chez's `call/cc` captures the native stack. Rust has no equivalent.\n- **Garbage collection**: Scheme values are GC-managed. Rust uses ownership. No mechanical translation exists.\n- **Dynamic typing**: Every Scheme value is a tagged pointer. Translating to Rust means `enum Value { Int(i64), String(Rc<String>), ... }` everywhere, losing Rust's type safety benefits.\n\nNo tool exists for this. Building one would take years. The few academic efforts (Ribbit Scheme) produce minimal subsets lacking Jerboa's features.\n\n### Alternative Scheme Compilers (Chicken, Gambit)\n\nChicken compiles Scheme to C via Cheney-on-the-MTA. A minimal program produces a ~400KB binary. Gambit is similar but larger (~1-2MB). Both give full access to C hardening flags.\n\n**What you lose**: Chez's native-code performance (3-10x slower), the entire Jerboa prelude, all MCP tooling, reader syntax extensions, defstruct/defclass/defmethod, the capability system, taint tracking, effects, contracts.\n\nNot worth it unless starting from scratch.\n\n### Full LTO Across Chez + Rust\n\nNot technically feasible. Chez's `libkernel.a` is pre-built; LTO would require recompiling Chez with `-flto`. Even then, cross-language LTO (C + Rust) is not supported by current toolchains for this combination.\n\n---\n\n## Recommended Architecture\n\n### Target: Self-Sandboxing Static PIE Binary\n\nThe architecture adapts to platform capabilities. WASM-sandboxed parsing is the\nuniversal constant; OS-level confinement and hardware enforcement vary.\n\n```\n+--------------------------------------------------+\n| Static PIE ELF (~8MB) |\n| Full ASLR + platform-specific HW enforcement |\n| |\n| +-----------+ +-----------+ +---------------+ |\n| | Chez | | Rust | | wasmi WASM | |\n| | Runtime | | Native | | Interpreter | |\n| | | | (ring, | | (DNS parser | |\n| | | | rustls) | | in sandboxed | |\n| | | | | | WASM module) | |\n| +-----------+ +-----------+ +---------------+ |\n| |\n| Jerboa orchestration layer: |\n| - Capability-gated network I/O |\n| - Policy evaluation (who queries what) |\n| - Audit logging (hash-chain) |\n| - Configuration via Jerboa DSL |\n| |\n| Post-init self-sandbox (platform-dependent): |\n| +---------------------+------------------------+ |\n| | Linux | FreeBSD | |\n| +---------------------+------------------------+ |\n| | CET/SHSTK (hw ROP) | ARM PAC+BTI (arm64) | |\n| | seccomp (syscall | Capsicum (resource | |\n| | filter, block | confinement, block | |\n| | mprotect(EXEC)) | path-based access) | |\n| | Landlock (fs paths) | PROTMAX (post-init, | |\n| | Namespaces (PID, | block mprotect | |\n| | mount, network) | escalation) | |\n| | Anti-debug (ptrace) | Anti-debug (ptrace) | |\n| | Integrity check | Integrity check | |\n| +---------------------+------------------------+ |\n+--------------------------------------------------+\n```\n\n### Defense Layers by Platform\n\n**Linux (x86_64 with CET)** \u2014 Six independent layers:\n\n1. **ASLR** (~22 bits entropy) \u2014 Information leak to discover gadget addresses\n2. **CET/SHSTK** \u2014 Hardware bypass to use corrupted return addresses\n3. **WASM sandbox** \u2014 Runtime bug to escape parser isolation\n4. **seccomp** \u2014 Kernel exploit to make blocked syscalls (including `mprotect(EXEC)`)\n5. **Namespaces** \u2014 Kernel exploit to escape PID/mount/network isolation\n6. **Landlock** \u2014 Kernel exploit to access blocked filesystem paths\n\n**FreeBSD (x86_64)** \u2014 Five layers, no hardware ROP protection:\n\n1. **ASLR** (~14 bits entropy) \u2014 Information leak (lower bar than Linux)\n2. **WASM sandbox** \u2014 Runtime bug to escape parser isolation (**primary ROP defense**)\n3. **Capsicum** \u2014 Kernel exploit to escape capability mode\n4. **PROTMAX** \u2014 Kernel exploit or pre-PROTMAX timing to escalate memory protections\n5. **Anti-debug + integrity** \u2014 Bypass tracing detection and hash verification\n\n**FreeBSD (arm64)** \u2014 Six layers, with hardware enforcement:\n\n1. **ASLR** \u2014 Information leak to discover gadget addresses\n2. **ARM PAC** \u2014 Hardware bypass to forge signed return addresses\n3. **ARM BTI** \u2014 Hardware bypass to jump to non-BTI-landing-pad instructions\n4. **WASM sandbox** \u2014 Runtime bug to escape parser isolation\n5. **Capsicum** \u2014 Kernel exploit to escape capability mode\n6. **PROTMAX** \u2014 Kernel exploit to escalate memory protections\n\n**Key insight**: On FreeBSD x86_64, the WASM sandbox is not defense-in-depth \u2014 it is the\n**primary** control-flow integrity mechanism. This elevates Path 2 from \"nice to have\" to\n\"essential\" on that platform. On FreeBSD arm64, PAC+BTI restore hardware-level protection,\nmaking it the strongest FreeBSD deployment target.\n\n### Platform Feature Matrix\n\n| Defense | Linux x86_64 | FreeBSD x86_64 | FreeBSD arm64 |\n|---------|-------------|----------------|---------------|\n| ASLR | High entropy | Low entropy | Low entropy |\n| HW return-addr protection | CET/SHSTK | **None** | ARM PAC |\n| HW indirect-branch protection | CET/IBT (needs Chez patch) | **None** | ARM BTI |\n| Syscall filtering | seccomp-bpf | **None** (Capsicum is resource-based) | **None** |\n| Block mprotect(EXEC) | seccomp | PROTMAX (post-init only) | PROTMAX (post-init only) |\n| Resource confinement | Landlock | Capsicum | Capsicum |\n| Process isolation | Namespaces | **None** (jails require root) | **None** |\n| WASM parser sandbox | Yes | Yes | Yes |\n| Anti-debug | ptrace self-trace | ptrace self-trace | ptrace self-trace |\n| Compiler hardening (CFLAGS) | Full | Full | Full |\n\n### Implementation Priority\n\nPriority is adjusted for cross-platform impact. Items that benefit both Linux and FreeBSD\nare ranked higher than Linux-only features.\n\n| Phase | Work | Effort | Linux | FreeBSD | Notes |\n|-------|------|--------|-------|---------|-------|\n| **1a** | Embed wasmi in jerboa-native-rs | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform, highest priority |\n| **1b** | Write DNS parser in Rust \u2192 WASM | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform |\n| **1c** | Switch musl build to static PIE | Hours | Full ASLR | Full ASLR | Cross-platform |\n| **1d** | Rebuild Chez with hardening CFLAGS | Days | All flags | All except CET | Cross-platform (flag subset varies) |\n| **2a** | Enable CET/SHSTK in Chez build | Days | **Defeats ROP** | N/A | Linux-only, highest HW impact |\n| **2b** | Add namespace isolation to cage | Days | Micro-VM containment | N/A | Linux-only |\n| **2c** | Enable PROTMAX post-init on FreeBSD | Days | N/A | Block mprotect escalation | FreeBSD-only, requires post-JIT sequencing |\n| **2d** | ARM PAC+BTI build target | Days | N/A | HW ROP defense (arm64) | FreeBSD arm64 only |\n| **3a** | Patch Chez codegen for ENDBR64 | Weeks | Full CET (IBT+SHSTK) | N/A | Linux-only, enables IBT |\n| **3b** | Encrypted boot files | Weeks | Resist static analysis | Resist static analysis | Cross-platform |\n| **3c** | Firecracker deployment wrapper | Weeks | VM-level isolation | N/A (bhyve possible) | Linux-primary |\n| **3d** | HardenedBSD deployment target | Days | N/A | Strict W^X, SEGVGUARD | FreeBSD fork, maximum hardening |\n"} --- a/cpt_corpus_v6_prep.jsonl +++ b/cpt_corpus_v6_prep.jsonl @@ -6,7 +6,7 @@ {"text":"<!-- FILE: README.md -->\n# Jerboa\n\nA Gerbil-syntax, Clojure-compatible Scheme dialect for production\nconcurrent systems, running on stock [Chez Scheme](https://cisco.github.io/ChezScheme/).\n\nJerboa implements Gerbil's user-facing language (`def`, `defstruct`,\n`match`, hash tables, `:std/*` libraries) **and** a substantial Clojure\ncompatibility layer (atoms, refs/STM, agents, persistent collections,\ncore.async, transducers, protocols, multimethods) as Chez Scheme\nmacros and native libraries. No Gerbil expander, no Gambit\ncompatibility layer, no patched Chez. The standard Chez compiler\nproduces the binaries.\n\n## Why Chez Scheme\n\nJerboa picks Chez Scheme as its host because its concurrency model is\nthe rare combination that real production systems need:\n\n- **Real OS threads, no GIL.** Chez Scheme's threaded build\n (`--threads`) gives you native OS threads with a thread-safe\n generational GC. CPU-bound work scales linearly across cores; you\n do not pay for parallelism with a global interpreter lock.\n- **First-class synchronization primitives.** `make-mutex`,\n `make-condition`, `with-mutex`, `condition-wait`,\n `condition-broadcast`, and atomic CAS on tc-mutex slots are\n exposed in the language. Jerboa's higher-level concurrency\n abstractions (`(std atom)`, `(std stm)`, `(std csp)`,\n `(std net io)` fibers) are built directly on these.\n- **Cheap closures, fast call paths.** Chez compiles to machine code\n through the nanopass framework — its closure allocation and\n call-through-pointer costs are competitive with what Go achieves\n via its runtime. That gives Jerboa room to express tens of\n thousands of fibers as plain procedures over a small worker pool\n without the cost dominating the workload.\n- **Fixnum-tagged arithmetic and unboxed bytevectors.** Hot paths in\n protocol handling (HTTP/2, WebSocket framing, base64, SHA) stay\n in fixnums and unboxed bytes, so a Scheme implementation of a\n protocol can sit within a small constant factor of a hand-written\n C version.\n- **A stable, fast FFI.** `foreign-procedure` and `foreign-callable`\n let Jerboa drop into a Rust shared library (`libjerboa_native`)\n for everything that genuinely needs sharp edges — ring for\n crypto, rustls for TLS, regex for ReDoS-immune matching,\n rusqlite/postgres/duckdb for storage. The Scheme side stays\n high-level; the Rust side stays memory-safe.\n- **A self-hosting compiler.** When Jerboa needs a primitive that\n Chez does not ship (e.g. `bytevector-slice`, `bytevector-append`,\n `base64-encode`/`base64-decode`, `sha1-bytevector`,\n `sha256-bytevector`), we add it to our Chez fork in pure Scheme\n with full backwards compatibility. No patched bootstrap, no\n vendored compiler — just additional primitives in `(chezscheme)`.\n- **Apache 2.0**, no license entanglements.\n\nThe result: a single language where green threads (fibers), OS\nthreads, atomic state, software-transactional memory, and CSP\nchannels all coexist on top of the same scheduler primitives, with\npredictable performance and no runtime to fight.\n\n## Quick Start\n\n```scheme\n(import (jerboa prelude))\n\n(def (main)\n (defstruct point (x y))\n (let ([p (make-point 3 4)])\n (displayln (point-x p)) ;; 3\n (displayln (sort < [5 1 3])) ;; (1 3 5)\n (displayln (string-join [\"a\" \"b\"] \",\")) ;; a,b\n (displayln (json-object->string [1 2 3])))) ;; [1,2,3]\n\n(main)\n```\n\nRun with:\n```bash\nscheme --libdirs lib --script your-file.ss\n```\n\n## Architecture\n\n```\n┌──────────────────────────────────────────────┐\n│ User's Gerbil-like code │\n│ (def (main) (displayln (sort < [3 1 2]))) │\n└──────────────┬───────────────────────────────┘\n │\n┌──────────────▼───────────────────────────────┐\n│ Reader: [...] = (...), {...} → (~ ..) │\n│ :std/sort → (std sort), keyword:, heredocs │\n│ Optional Clojure mode (#!cloj) │\n├──────────────────────────────────────────────┤\n│ Core Macros: def, defstruct, match, try │\n│ All expand to standard Chez Scheme │\n├──────────────────────────────────────────────┤\n│ Runtime: hash tables, method dispatch, │\n│ persistent collections, transients │\n├──────────────────────────────────────────────┤\n│ Concurrency: fibers, CSP, STM, atoms, │\n│ agents, futures, work-stealing scheduler │\n├──────────────────────────────────────────────┤\n│ Standard Library: 229 (std *) modules │\n├──────────────────────────────────────────────┤\n│ Native FFI: libjerboa_native.so (Rust) │\n│ ring · flate2 · regex · sqlite · │\n│ postgres · rustls · landlock · ed25519 │\n├──────────────────────────────────────────────┤\n│ Stock Chez Scheme — additive primitives, │\n│ no fork, no patches │\n└──────────────────────────────────────────────┘\n```\n\n## What's Landed in the Last Month\n\nThe recent push has expanded Jerboa from \"Gerbil syntax on Chez\" into\na full production stack. The additions group into seven themes.\n\n### 1. Fiber-aware concurrency stack\n\nA green-thread system layered on Chez OS threads with epoll-integrated\nI/O. The eight-phase rollout (`docs/green-wins.md`) is now complete.\n\n| Module | Provides |\n|---|---|\n| `(std net io)` | epoll-integrated I/O core for fibers |\n| `(std net fiber-httpd)` | Fiber-native HTTP/1.1 server with URL-param routing |\n| `(std net fiber-ws)` | Fiber-aware WebSocket server, integrates with httpd |\n| `(std workpool)` | Bounded worker pool for blocking syscalls |\n| `(std net dns)` | Fiber-friendly resolver with caching |\n| `(std net filepool)` | File-descriptor pool offloading slow disk I/O |\n| `(std net sendfile)` | Zero-copy `sendfile(2)` paths for static content |\n| `(std net connpool)` | Fiber-aware connection pooling for outbound TCP |\n| `(std net rate)` | Token bucket, sliding/fixed-window limiters |\n| `(std net router)` | HTTP routing with `:param` captures + middleware |\n| `(std semaphore)` / `(std net admission)` | Production hardening: admission control + circuit metrics |\n| `(std fiber)` | Cancellation, fiber-locals, join, link, select, timeouts, groups |\n\nInternally, the scheduler now uses **per-worker work-stealing deques**\ninstead of a shared run-queue, and the completion / wait API was\nre-wired through fibers so that ports and channels block fibers\nwithout parking the OS thread.\n\n### 2. Clojure compatibility layer — `(std clojure)`\n\nA substantial Clojure-on-Scheme port: sequences, atoms, agents, refs,\nmultimethods, protocols, transducers, persistent collections, lazy\nsequences, core.async, EDN, specter, zippers, and the rest of the\ncommon idiom.\n\n**Persistent collections** (HAMT- and RRB-backed):\n\n| Module | Provides |\n|---|---|\n| `(std pmap)` | Persistent hash-array-mapped trie map + `transient-map` for fast bulk build |\n| `(std pvec)` | Persistent RRB vector |\n| `(std pset)` | Persistent set on top of `pmap` |\n| `(std sorted-set)` | Sorted persistent set |\n| `(std sorted-map)` | Sorted persistent map |\n| `(std pqueue)` | Persistent FIFO queue (SRFI-134-backed) |\n\nAll persistent collections participate in Chez's `equal?` /\n`equal-hash` / `display`, integrate with the `for/collect` / `for/fold`\niterator protocol, and are destructurable via `match`. They use\nnongenerative RTDs so equality survives separate compilation.\n\n**Concurrency primitives** (Clojure-style names, Chez-thread-safe):\n\n| Module | Provides |\n|---|---|\n| `(std atom)` | `atom`, `swap!`, `reset!`, `compare-and-set!`, `add-watch!`, `volatile!` family |\n| `(std agent)` | Async state cells with bounded send queues |\n| `(std stm)` | `ref`, `dosync`, `alter`, `commute`, `ensure` on top of TVars |\n| `(std multi)` | `defmulti` / `defmethod` with `:hierarchy` and `derive!` |\n| `(std protocol)` | Open-world protocols (`defprotocol`, `extend-type`, `extend!`) |\n| `(std meta)` | Metadata wrappers (`with-meta`, `meta`) |\n| `(std component)` | Stuart Sierra-style lifecycle (`start`, `stop`, dependency graph) |\n\n**core.async-style CSP** — `(std csp)`:\n\n- `(chan n xform)` — transducer-backed channels\n- Sliding / dropping / blocking buffers\n- `alts!` / `alts!!` non-deterministic select\n- `pipe`, `mult`, `mix` (with `'block` / `'drop` / `'timeout` policies)\n- `pub` / `sub` topic filtering\n- `split` / `chan-classify-by` n-way split\n- `async-reduce`, `onto-chan!`, `onto-chan!!`\n- `put!` / `take!` non-blocking callback variants\n- Timer wheel for scalable timeouts (`JERBOA_CSP_TIMER_WHEEL=1`)\n- `(std csp fiber-chan)` integrates channels with fibers\n\n**Sequence / data manipulation**:\n\n| Module | Provides |\n|---|---|\n| `(std clojure)` | Umbrella with `delay`, `future`, `promise`, polymorphic `deref` |\n| `(std clojure walk)` | `prewalk`, `postwalk`, `keywordize-keys`, etc. |\n| `(std clojure data)` | `diff` |\n| `(std clojure zip)` | Tree zippers |\n| `(std clojure seq)` | Lazy sequences: `range`, `iterate`, `repeat`, `cycle`, `take-while`, `drop-while` |\n| `(std clojure reducers)` | Reducible/transducible adapters |\n| `(std specter)` | Composable path navigation for nested data |\n| `(std zipper)` | Functional tree zippers |\n| `(std text edn)` | EDN reader/writer (#inst, #uuid, tagged literals) |\n| `(std misc nested)` | `get-in`, `assoc-in`, `update-in` |\n| `(std injest)` | Smart thread-last with transducer fusion |\n\nThe `(std clojure)` module also lands `ex-info`, `condp =>`,\n`reduce-kv`, set relational ops (`select`, `project`, `rename`,\n`index`, `join`), and full destructuring.\n\n`(std test check)` is a property-based testing library with\nshrinking, in the style of `test.check`.\n\n### 3. Slang + WebAssembly backend\n\nSlang is a secure language compiler that targets WebAssembly, with\ntwo execution backends.\n\n- Full WASM MVP plus post-MVP features: saturating conversions, bulk\n memory operations, reference types, tables, tail calls, exception\n handling, GC, host imports.\n- `(jerboa wasm format)` — binary format primitives (LEB128, IEEE 754).\n- `(jerboa wasm codegen)` — Scheme→WASM compiler for an i32 subset\n (closures, tail calls, exceptions, variadic lambdas).\n- `(jerboa wasm runtime)` — stack-based interpreter for testing.\n- **wasmi backend** — Rust embedding with fuel metering and bounded\n memory; security-hardened (bounds checks, exception boundary,\n import validation, module-size limits).\n- **SpiderMonkey backend** via the `mozjs` crate — production JIT for\n benchmarks where wasmi is the bottleneck.\n- Argon2id key derivation, message HMAC, sandbox limits, taint checks\n baked in.\n- `wasm-sandbox-instantiate-hosted` provides a Scheme FFI binding for\n hosting third-party WASM modules with capability-based imports.\n\n### 4. Native Rust backend — `libjerboa_native.so`\n\nA unified Rust shared library replaces the previous C-FFI surface\nwith memory-safe implementations behind a small extern-\"C\" facade.\n\n| Module | Crate(s) | Provides |\n|---|---|---|\n| `(std crypto native-rust)` | ring | SHA-1/256/384/512, HMAC, AES-256-GCM, PBKDF2, CSPRNG, ed25519 sign/verify |\n| `(std crypto secure-mem)` | libc (mmap/mlock) | Guard-paged, mlocked memory outside GC |\n| `(std compress native-rust)` | flate2 | `deflate`/`inflate`/`gzip`/`gunzip` with size limits |\n| `(std regex-native)` | regex (NFA) | Compile / match / find / replace — ReDoS-immune |\n| `(std db sqlite-native)` | rusqlite (bundled) | Open / exec / prepare with parameterized queries |\n| `(std db postgresql-native)` | rust-postgres | Connect / exec / query |\n| `(std db duckdb-native)` | duckdb-rs | Native DuckDB integration |\n| `(std os epoll-native)` | libc | epoll create / ctl / wait |\n| `(std os inotify-native)` | libc | inotify init / add_watch / read_events |\n| `(std os landlock-native)` | libc | Landlock LSM ABI v1–v7 (FS + network confinement) |\n| `(std net tls-rustls)` | rustls | HTTPS / `wss://` with pinned cert verification |\n| `(std net request)` | rustls | HTTPS via the Rust TLS path |\n| `(std pcap)` | rscap | Live packet capture |\n\n`panic.rs` wraps every extern \"C\" entry point in `catch_unwind` so a\nRust panic never crosses the FFI boundary as undefined behavior.\n\n### 5. Cross-platform ports\n\nJerboa now runs on Linux (glibc + musl), FreeBSD, macOS (Intel + Apple\nSilicon), and Android (Termux).\n\n- **FreeBSD**: full Capsicum support in `(std security cage)`,\n `__error` errno binding, correct platform constants for O_* flags,\n `struct stat`, `sockaddr_in`, signals (SIGTSTP/SIGCHLD/SIGCONT and\n six others were hardcoded to Linux values), and integrity check via\n `sysctl` instead of `/proc/curproc/file`.\n- **macOS**: BPF live capture activation via `BIOCSETF` + `BIOCIMMEDIATE`\n (replacing `BIOCSETFNR` which doesn't exist on macOS), portable\n libc/libm names, dylib path fallback, AArch64 seccomp.\n- **Android**: bionic libc errno symbol support in TCP layer.\n\n`(std security cage)` provides pledge/unveil-style process\nconfinement that maps to the strongest mechanism available on each\nplatform: Landlock + seccomp on Linux, Capsicum on FreeBSD, sandbox-exec\non macOS.\n\n### 6. Security hardening\n\n- `(std security)` — `audit`, `auth`, `cage`, `capability`,\n `flow`, `import-audit`, `io-intercept`, `landlock`,\n `metrics`, `privsep`, `restrict`, `sandbox`, `sanitize`,\n `seatbelt`, `seccomp`, `secret`, `taint`, `capsicum`,\n `capability-typed`, `errors`.\n- mTLS with **pinned cert verifier** (replacing\n `WebPkiClientVerifier`); in-memory cert/key APIs.\n- Argon2id, TOCTOU-safe path handling, message HMAC.\n- Binary-hardening flags wired into the musl static build (PIE,\n RELRO, stack-canaries, NX) — see `docs/secure-binary.md`.\n- aarch64 seccomp filter.\n\n### 7. Performance work — phases 4–22\n\nA multi-phase optimization push, each with a benchmark gate to detect\nregressions. The scaffolding lives in `(std bench)` and runs in CI.\n\n| Phase | Optimization |\n|---|---|\n| 4 | Memoize regex compilation for literal reuse |\n| 5 | Fuse `for` / `for/collect` / `for/fold` over `in-range` / `in-vector` / `in-string` |\n| 6 | Single-pass keyword-arg extraction in `def` expansion |\n| 7 | Build the prelude aggregator to produce WPO for `std/*` |\n| 8 | Bench-suite harness + regression gate |\n| 12 | Arity-specialized method dispatch in `(~ obj 'name ...)` |\n| 13 | Fuse `in-hash-keys` / `in-hash-values` in `for/collect` |\n| 14 | Fuse runs of `(list 'TAG p ...)` clauses in `match` |\n| 17 | Method dispatch cost vs direct call (baseline) |\n| 18 | Kwarg call overhead (baseline) |\n| 22 | `string-append` adjacent-literal fold (Chez-side) |\n| — | `defstruct` / `defrecord` / `ok` / `err` seal by default |\n| — | `str` expand-time constant folding for literal args |\n| — | Persistent-collection nongenerative UIDs |\n| — | Iter fusion: `for/or` / `for/and` over known iterator heads |\n| — | Match2 fast-path `(: Type)` with fused RTD dispatch |\n\n### 8. Reader & build infrastructure\n\n- **Clojure reader compatibility mode** (`#!cloj`) — switch a file or\n REPL session into Clojure surface syntax (`#\"regex\"`, `#{}` sets,\n `#_form` discard, etc.).\n- **Regex tier 1–3** — raw strings, unified `(re ...)` API across the\n pure-Scheme and Rust backends, `rx` macros, full PEG grammar\n system in `(std peg)`.\n- **Single-file packages** — `jerboa exec` reads a self-contained\n `.ss` file with header metadata and runs it without project\n scaffolding.\n- **jerbuild** improvements — per-project feature gating so a\n static-musl build only links the dependencies the project\n actually uses.\n- **Docker base image** for static musl binary builds; CI workflow\n for macOS Rust libraries; jemacs static build TUI deps included.\n- **nREPL** — `(std nrepl)` is the canonical source; full CIDER /\n Calva middleware plus Jerboa extensions.\n- **AI compatibility aliases** — `(jerboa prelude)` exports common\n names from Racket / Gambit / Common Lisp that LLMs frequently\n hallucinate (`hash-has-key?` → `hash-key?`,\n `directory-exists?` → `file-directory?`, `random-integer` →\n `random`, `eql?` → `eqv?`, etc.).\n\n### 9. Documentation push\n\n`docs/` is now ~90 files. Highlights:\n\n- `docs/anti-cookbook.md` — common Scheme/Clojure mistakes and how\n Jerboa makes them explicit.\n- `docs/api-index.md` — comprehensive API reference (~700KB,\n generated).\n- `docs/clojure-vs-jerboa.md` — feature scorecard with status\n markers.\n- `docs/clojure-left.md` — gap analysis driving the parity work.\n- `docs/green-wins.md` — fiber roadmap (now complete).\n- `docs/jerboa-edge.md` — edge-computing roadmap.\n- `docs/jerboa-db.md` — database integration tracking.\n- `docs/native-rust.md` — Rust backend architecture and migration.\n- `docs/regex-rx-peg.md` — unified regex/SRE/PEG reference.\n\n## What's Included\n\n### Core Macros (`(jerboa core)`)\n- `def`, `def*` — functions with optional / multi-arity / rest args\n- `defstruct` — sealed Chez records with auto-generated accessors\n- `defclass` — records with single inheritance\n- `defmethod`, `defmulti` — method dispatch and multimethods\n- `match`, `match2` — pattern matching (lists, predicates,\n `and`/`or`/`not`, cons, type patterns, persistent-collection\n destructuring, wildcards)\n- `try`/`catch`/`finally`, `errdefer`, `defvariant` (Zig-inspired)\n- `defrule`/`defrules` — syntax-rules shortcuts\n- `while`/`until`, `for` family\n- `hash-literal`/`let-hash`\n- Threading macros: `chain`, `chain-and`, `->`, `->>`, `as->`,\n `some->`, `cond->`\n\n### Runtime (`(jerboa runtime)`)\n- Full Gerbil hash table API\n- Method dispatch: `~`, `bind-method!`, `call-method`\n- Keywords, ports, displayln, `iota`, `1+`, `1-`\n- `(jerboa pkg)`, `(jerboa lock)` — semver, dep resolution,\n manifests, lockfile management\n- `(jerboa hot)` — hot code reload via mtime polling\n- `(jerboa embed)` — sandboxed evaluation environments\n- `(jerboa cross)` — cross-compilation config and ABI naming\n\n### Standard Library — 229 modules under `lib/std/`\n\nMajor areas:\n\n- **Concurrency**: `(std atom)`, `(std agent)`, `(std stm)`,\n `(std csp)`, `(std multi)`, `(std protocol)`, `(std meta)`,\n `(std component)`, `(std clojure)`, `(std fiber)`, `(std raft)`,\n `(std actor)`, `(std concur hash)`, `(std concur stm)`,\n `(std concur structured)`.\n- **Networking**: 35+ `(std net *)` modules — `request`, `httpd`,\n `fiber-httpd`, `fiber-ws`, `websocket`, `http2`, `dns`,\n `sendfile`, `connpool`, `workpool`, `tcp`, `udp`, `tls`,\n `tls-rustls`, `ssh`, `s3`, `smtp`, `socks5-server`, `9p`,\n `grpc`, `json-rpc`, `router`, `rate`, `uri`.\n- **Data**: `(std pmap)`, `(std pvec)`, `(std pset)`,\n `(std sorted-set)`, `(std sorted-map)`, `(std pqueue)`,\n `(std specter)`, `(std zipper)`, `(std injest)`,\n `(std clojure data/walk/zip)`, `(std misc nested)`.\n- **Persistence / DB**: `(std db sqlite/postgresql/duckdb/leveldb)`,\n native-Rust variants, `(std db dbi)`, `(std db query-compile)`,\n `(std db conpool)`.\n- **Text**: `(std text json/edn/csv/xml/yaml/base64/hex/utf8)`,\n `(std regex-native)`, `(std rx)`, `(std peg)`.\n- **OS / runtime**: `(std os env/path/temporaries/signal/fdio)`,\n native epoll/inotify/landlock, `(std os capsicum)`,\n `(std misc process)`, `(std misc thread)`, `(std misc cpu)`.\n- **Crypto**: `(std crypto digest/cipher/hmac/pkey/kdf)`,\n `(std crypto native-rust)` (ring), `(std crypto secure-mem)`.\n- **Production infra**: `(std log)`, `(std metrics)`, `(std span)`,\n `(std health)`, `(std circuit)`, `(std semaphore)`, `(std lint)`,\n `(std test)`, `(std test check)`, `(std bench)`.\n- **Security**: 21 `(std security *)` modules — pledge/unveil,\n Landlock, Capsicum, seccomp, capability-typed I/O, taint, sandbox.\n\n### FFI (`(jerboa ffi)`)\n- `c-lambda` → `foreign-procedure` with automatic type translation\n- `define-c-lambda`, `begin-ffi`, `c-declare`\n- Full Gambit-to-Chez type mapping\n- `native-available?` guards for build-time platform feature gating\n\n### Reader (`(jerboa reader)`)\n- `[...]` = `(...)` (same as Gerbil and Chez)\n- `{method obj}` → `(~ obj 'method)`\n- `keyword:` → keyword objects\n- `:std/sort` → `(std sort)` module paths\n- Heredoc strings, datum comments, block comments\n- Optional Clojure surface syntax under `#!cloj`\n\n### Prelude (`(jerboa prelude)`)\nOne import for everything:\n```scheme\n(import (jerboa prelude))\n```\n\n## Examples\n\n### Fiber-based HTTP server\n```scheme\n(import (jerboa prelude)\n (std net fiber-httpd))\n\n(define (handler req)\n (let-values ([(method path) (request-method+path req)])\n (case method\n [(GET) (respond-text 200 \"hello\\n\")]\n [else (respond-text 405 \"method not allowed\\n\")])))\n\n(fiber-httpd-serve port: 8080 handler: handler workers: 4)\n```\n\n### CSP pipeline\n```scheme\n(import (jerboa prelude)\n (std csp) (std csp ops))\n\n(let ([in (chan 100)]\n [out (chan 100 (map (lambda (x) (* x x))))])\n (pipe in out)\n (go (let loop ([i 0])\n (when (< i 1000) (put! in i) (loop (+ i 1)))))\n (let consume ([n 0])\n (when (< n 1000)\n (displayln (take! out)) (consume (+ n 1)))))\n```\n\n### STM (Clojure refs)\n```scheme\n(import (jerboa prelude) (std stm))\n\n(define account-a (ref 100))\n(define account-b (ref 50))\n\n(define (transfer! from to amount)\n (dosync\n (alter from - amount)\n (alter to + amount)))\n\n(transfer! account-a account-b 25)\n```\n\n### Persistent map\n```scheme\n(import (jerboa prelude) (std pmap))\n\n(define m1 (pmap 'a 1 'b 2 'c 3))\n(define m2 (pmap-assoc m1 'd 4))\n(displayln (pmap-ref m2 'b)) ;; 2\n(displayln (pmap-ref m1 'd #f)) ;; #f (m1 unchanged)\n```\n\n## Testing\n\n```bash\nmake test # Core tests (289 tests)\nmake test-features # Phase 2+3 feature tests (637 tests)\nmake test-native # Rust native backend tests\nmake test-wrappers # Legacy chez-* C library wrappers (27 tests)\nmake test-clojure # Clojure compatibility layer tests\nmake test-fiber # Fiber + CSP + STM tests\nmake test-wasm # Slang/WASM backend tests\nmake test-all # Everything (1500+ tests)\n```\n\nProperty-based testing is available via `(std test check)`:\n\n```scheme\n(import (std test) (std test check))\n\n(check 'sort-is-idempotent\n (lambda (xs) (equal? (sort < xs) (sort < (sort < xs))))\n (gen-list (gen-integer)))\n```\n\n## Requirements\n\n- [Chez Scheme](https://cisco.github.io/ChezScheme/) 10.x (stock,\n unmodified — though we maintain an additive fork at\n [github.com/ober/ChezScheme](https://github.com/ober/ChezScheme)\n with a handful of pure-Scheme primitives that the standard\n library uses). Both work.\n- Optional: [Rust toolchain](https://rustup.rs/) for building\n `libjerboa_native.so` (crypto, compression, regex, databases,\n TLS, OS integration, ed25519).\n- Optional (legacy): [chez-*](https://github.com/ober) libraries for\n the older C-FFI shims (still functional, being superseded by the\n Rust backend).\n\n### Supported platforms\n\n| OS | Architecture | Notes |\n|---|---|---|\n| Linux | x86_64, aarch64 | glibc + musl static both supported |\n| FreeBSD | x86_64 | Capsicum enabled by default |\n| macOS | x86_64, aarch64 | Apple Silicon native; sandbox-exec for `(std security cage)` |\n| Android | aarch64 | Termux; bionic libc compat |\n\n## Project Structure\n\n```\nlib/\n jerboa/ # Reader, core macros, runtime, FFI, prelude\n # + pkg, lock, hot, embed, cross, wasm, build\n std/ # 229 modules — see \"Standard Library\" above\njerboa-native-rs/ # Unified Rust shared library\n src/\n lib.rs # module declarations, init\n crypto.rs # ring digests, hmac, aead, csprng, ed25519\n compress.rs # flate2: deflate, inflate, gzip\n regex_native.rs # regex crate\n sqlite.rs # rusqlite\n postgres_native.rs # rust-postgres\n duckdb.rs # duckdb-rs\n epoll.rs / inotify_native.rs / landlock.rs\n secure_mem.rs # mlock + guard pages + explicit_bzero\n tls_rustls.rs # rustls-based TLS\n panic.rs # catch_unwind wrapper for FFI\nslang/ # Slang language compiler\n src/ # IR, lowering, codegen\n wasm/ # WASM backend (wasmi + SpiderMonkey)\ndocs/ # ~90 files — green-wins, clojure-vs-jerboa, native-rust, …\ntests/ # Test suite (1500+ tests)\nbenchmarks/ # Bench harness with regression gate\nsupport/ # Static-build artifacts, Docker base image\n```\n\n## What Gerbil Code Works\n\nMost user-level Gerbil code works unchanged:\n\n```scheme\n(import :std/sugar :std/sort :std/format)\n\n(def (run-command cmd env)\n (try\n (let* ([tokens (tokenize cmd)]\n [expanded (expand-aliases tokens env)])\n (match expanded\n ([prog . args] (exec-pipeline prog args env))\n (else (displayln \"empty command\"))))\n (catch (e) (displayln \"error: \" (error-message e)))))\n```\n\n## What Won't Work\n\n1. **Gerbil expander API** (`:gerbil/expander`) — not applicable\n2. **Gambit `##` primitives** — provided case-by-case\n3. **`(export #t)`** — re-export-everything needs explicit exports\n4. **Gerbil-specific `syntax-case` binding semantics** — uses Chez R6RS\n5. **Gambit thread API** is wrapped (`(std misc thread)`); some\n Gambit-specific primitives (e.g. `thread-yield!` quirks) are not\n 1:1 — see `docs/concurrency-extended.md`.\n\n## License\n\nApache 2.0\n"} {"text":"<!-- FILE: JERBOA-LANG.md -->\n# The Jerboa Programming Language\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own\nlanguage — with features that differ from and exceed Gerbil. All user-facing code is\nwritten in `.ss` files. The `.sls` files are implementation internals.\n\n## Quick Start\n\n```scheme\n;; hello.ss\n(import (jerboa prelude))\n\n(def (main)\n (def name \"world\")\n (displayln (str \"Hello, \" name \"!\")))\n\n(main)\n```\n\nRun with:\n```\nscheme --libdirs lib --script hello.ss\n```\n\nOne import gives you the entire language:\n```scheme\n(import (jerboa prelude))\n```\n\n---\n\n## Table of Contents\n\n1. [File Structure](#file-structure)\n2. [Reader Syntax](#reader-syntax)\n3. [Definitions](#definitions)\n4. [Data Structures](#data-structures)\n5. [Pattern Matching](#pattern-matching)\n6. [Control Flow](#control-flow)\n7. [Error Handling](#error-handling)\n8. [Result Types](#result-types)\n9. [Iterators](#iterators)\n10. [Threading Macros](#threading-macros)\n11. [Ergonomic Typing](#ergonomic-typing)\n12. [Hash Tables](#hash-tables)\n13. [Functions & Combinators](#functions--combinators)\n14. [Standard Library](#standard-library)\n15. [FFI](#ffi)\n16. [Differences from Gerbil](#differences-from-gerbil)\n17. [Differences from Chez Scheme](#differences-from-chez-scheme)\n\n---\n\n## File Structure\n\nA Jerboa `.ss` file has this shape:\n\n```scheme\n(import (jerboa prelude))\n;; Optional extra imports for modules not in the prelude:\n;; (import (std net request))\n;; (import (std db sqlite))\n\n;; Definitions\n(def (my-function x y)\n (+ x y))\n\n;; Top-level code\n(displayln (my-function 1 2))\n```\n\nKey points:\n- **No `(library ...)` wrapper** — that's for `.sls` internals only\n- **`(import (jerboa prelude))`** gives you everything: core macros, runtime,\n result types, datetime, iterators, CSV, pretty-printer, JSON, paths, strings,\n lists, alists, hash tables, functional combinators, ergo typing, FFI, and more\n- For specialized modules not in the prelude, add extra imports\n\n---\n\n## Reader Syntax\n\nJerboa extends the Chez Scheme reader with Gerbil-inspired syntax.\n\n### Square Brackets — Plain Parentheses\n\nSquare brackets are interchangeable with parentheses, exactly like Gerbil and\nstock Chez Scheme. Use them freely in bindings, match clauses, cond, etc.:\n\n```scheme\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([i (in-range 5)]) (* i i))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### Curly Braces → Method Dispatch\n\n```scheme\n{draw canvas} ;; → (~ canvas 'draw)\n{move sprite 10 20} ;; → (~ sprite 'move 10 20)\n{name person} ;; → (~ person 'name)\n```\n\n### Keywords (trailing colon)\n\n```scheme\nname: ;; → keyword object #:name\ncolor: ;; → keyword object #:color\n(keyword? name:) ;; → #t\n```\n\n### Module Paths (Gerbil-style)\n\n```scheme\n:std/sort ;; → (std sort)\n:std/text/json ;; → (std text json)\n:std/misc/string ;; → (std misc string)\n```\n\nBoth forms work in `import`:\n```scheme\n(import :std/net/request) ;; Gerbil style\n(import (std net request)) ;; R6RS style — both are equivalent\n```\n\n### Heredoc Strings\n\n```scheme\n#<<END\nThis is a multi-line\nstring literal.\nEND\n```\n\n### Standard Scheme Syntax\n\nAll standard Chez Scheme reader features work:\n- `'expr` — quote\n- `` `expr `` — quasiquote, with `,expr` unquote and `,@expr` splicing\n- `#(1 2 3)` — vector\n- `#u8(1 2 3)` — bytevector\n- `#\\space`, `#\\newline`, `#\\x41` — characters\n- `#xFF`, `#b1010`, `#o77` — number radix prefixes\n- `#;expr` — datum comment (skip next form)\n- `#| ... |#` — block comment (nestable)\n- `#&value` — box\n- `#!void`, `#!eof` — void and eof literals\n\n---\n\n## Definitions\n\n### `def` — Define Variables and Functions\n\n```scheme\n;; Simple binding\n(def x 42)\n(def name \"Alice\")\n\n;; Function\n(def (add a b)\n (+ a b))\n\n;; Optional parameters (default values)\n(def (greet name (greeting \"hello\"))\n (str greeting \", \" name \"!\"))\n\n(greet \"Bob\") ;; → \"hello, Bob!\"\n(greet \"Bob\" \"howdy\") ;; → \"howdy, Bob!\"\n\n;; Rest arguments\n(def (first-and-rest first . rest)\n (list first rest))\n\n;; Type-checked parameters (via ergo)\n(def (add (x : number?) (y : number?)) : number?\n (+ x y))\n```\n\n### `def*` — Multiple Arities\n\n```scheme\n(def* greet\n ((name) (greet name \"hello\"))\n ((name greeting) (str greeting \", \" name \"!\")))\n```\n\n### `defrule` / `defrules` — Define Macros\n\n```scheme\n;; Single-pattern macro\n(defrule (swap! a b)\n (let ((tmp a)) (set! a b) (set! b tmp)))\n\n;; Multi-pattern macro\n(defrules my-or ()\n ((_ a) a)\n ((_ a b ...) (let ((t a)) (if t t (my-or b ...)))))\n```\n\n---\n\n## Data Structures\n\n### `defstruct` — Record Types\n\n```scheme\n(defstruct point (x y))\n\n;; Generated:\n;; make-point — constructor\n;; point? — predicate\n;; point-x — accessor\n;; point-y — accessor\n;; point-x-set! — mutator\n;; point-y-set! — mutator\n;; point::t — record type descriptor\n\n(def p (make-point 3 4))\n(point-x p) ;; → 3\n(point-y-set! p 10)\n(point-y p) ;; → 10\n```\n\n### Inheritance\n\n```scheme\n(defstruct shape (color))\n(defstruct (circle shape) (radius))\n\n(def c (make-circle \"red\" 5))\n(shape-color c) ;; → \"red\" (inherited field)\n(circle-radius c) ;; → 5\n(shape? c) ;; → #t\n(circle? c) ;; → #t\n```\n\nOnly **single inheritance** is supported.\n\n### `defclass` — Alias for `defstruct`\n\n```scheme\n(defclass point (x y)) ;; same as defstruct\n(defclass (circle shape) (r)) ;; same as defstruct with parent\n```\n\n### `defrecord` — Struct with Pretty Printing\n\n```scheme\n(defrecord person (name age))\n\n;; Same as defstruct plus:\n;; person->alist — convert to association list\n;; Custom printer: #<person name=\"Alice\" age=30>\n```\n\n### `defmethod` — Method Dispatch\n\n```scheme\n(defstruct circle (radius))\n(defstruct rect (width height))\n\n(defmethod (area (self circle))\n (* 3.14159 (expt (circle-radius self) 2)))\n\n(defmethod (area (self rect))\n (* (rect-width self) (rect-height self)))\n\n;; Call with ~ or {} syntax\n(def c (make-circle 5))\n(~ c 'area) ;; → 78.53975\n{area c} ;; → 78.53975 (same thing)\n\n;; Methods with extra args\n(defmethod (move (self point) dx dy)\n (make-point (+ (point-x self) dx)\n (+ (point-y self) dy)))\n\n{move p 10 20} ;; → new point shifted by (10, 20)\n```\n\nMethod dispatch walks the inheritance chain — a method defined on `shape`\nworks on `circle` too.\n\n### `define-enum` — Enumeration Types\n\n```scheme\n(define-enum color (red green blue))\n\n;; Generated:\n;; color-red → 0\n;; color-green → 1\n;; color-blue → 2\n;; color? — predicate (checks 0..2)\n;; color->name — number to string\n;; name->color — string to number\n```\n\n---\n\n## Pattern Matching\n\n### `match`\n\n```scheme\n(match value\n ;; Literal patterns\n (0 \"zero\")\n (#t \"true\")\n (\"hello\" \"greeting\")\n\n ;; Variable binding\n (x (str \"got: \" x)))\n\n;; List destructuring\n(match (list 1 2 3)\n ((list a b c) (+ a b c))) ;; → 6\n\n;; Nested patterns\n(match '(1 (2 3))\n ((list a (list b c)) (+ a b c))) ;; → 6\n\n;; Cons patterns\n(match '(1 2 3)\n ((cons head tail) head)) ;; → 1\n\n;; Predicate patterns\n(match 42\n ((? string?) \"a string\")\n ((? number?) \"a number\")) ;; → \"a number\"\n\n;; Guards\n(match x\n (n (where (> n 0)) \"positive\")\n (n (where (< n 0)) \"negative\")\n (_ \"zero\"))\n\n;; Logical combinators\n(match x\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\" \"true\") #t)\n ((not #f) \"truthy\"))\n\n;; Wildcard\n(match x\n (_ \"anything\"))\n\n;; View patterns — apply function, match result\n(match \"123\"\n ((=> string->number n) (+ n 1))) ;; → 124\n\n;; Struct patterns (requires define-match-type registration)\n(define-match-type point point? point-x point-y)\n(match (make-point 3 4)\n ((point x y) (+ x y))) ;; → 7\n```\n\n### `match/strict` — Exhaustiveness-Checked Matching\n\n```scheme\n(define-sealed-hierarchy shape\n (circle circle? circle-radius)\n (rect rect? rect-width rect-height))\n\n(match/strict shape my-shape\n ((circle r) (* 3.14 r r))\n ((rect w h) (* w h)))\n;; Warns at runtime if a variant is missing\n```\n\n### `define-active-pattern` — Custom Extractors\n\n```scheme\n(define-active-pattern (even? n)\n (and (number? n) (zero? (mod n 2)) n))\n\n(match 42\n ((even? n) (str n \" is even\")))\n```\n\n---\n\n## Control Flow\n\n### Conditionals\n\n```scheme\n;; Standard\n(if test then else)\n(cond (test1 expr1) (test2 expr2) (else default))\n(when test body ...)\n(unless test body ...)\n\n;; Anaphoric — binds result to `it`\n(awhen (find-user name)\n (send-email it))\n\n(aif (lookup key)\n (use it)\n (handle-missing))\n\n;; Conditional binding\n(when-let (x (get-thing))\n (process x))\n\n(if-let (user (find-user id))\n (greet user)\n (show-login))\n```\n\n### Loops\n\n```scheme\n;; Counted loop\n(dotimes (i 10)\n (displayln i)) ;; prints 0..9\n\n;; While/until\n(while (< x 10)\n (set! x (+ x 1)))\n\n(until (> x 10)\n (set! x (+ x 1)))\n\n;; Iterators (see Iterators section)\n(for ((x (in-range 10)))\n (displayln x))\n```\n\n### `assert!`\n\n```scheme\n(assert! (> x 0)) ;; raises error if false\n(assert! (> x 0) \"x must be positive\") ;; with message\n```\n\n---\n\n## Error Handling\n\n### `try` / `catch` / `finally`\n\n```scheme\n;; Basic try/catch\n(try\n (risky-operation)\n (catch (e)\n (displayln \"Error: \" (error-message e))))\n\n;; With predicate\n(try\n (/ 1 0)\n (catch (error? e)\n (displayln \"caught: \" e)))\n\n;; With finally (always runs)\n(try\n (def port (open-input-file \"data.txt\"))\n (process port)\n (catch (e)\n (displayln \"failed\"))\n (finally\n (close-input-port port)))\n```\n\n### Resource Management\n\n```scheme\n;; Guaranteed cleanup\n(unwind-protect\n (do-work)\n (cleanup))\n\n;; Resource lifecycle\n(with-resource (port (open-input-file \"f.txt\") close-input-port)\n (read-all-as-string port))\n\n;; Mutex\n(with-lock my-mutex\n (modify-shared-state))\n```\n\n---\n\n## Result Types\n\nRust-inspired `Result<T,E>` for composable error handling without exceptions.\n\n### Constructors & Predicates\n\n```scheme\n(ok 42) ;; success value\n(err \"not found\") ;; error value\n\n(ok? (ok 42)) ;; → #t\n(err? (err \"x\")) ;; → #t\n(result? (ok 1)) ;; → #t\n```\n\n### Extracting Values\n\n```scheme\n(unwrap (ok 42)) ;; → 42\n(unwrap (err \"x\")) ;; raises error!\n\n(unwrap-or (err \"x\") 0) ;; → 0 (safe default)\n(unwrap-or-else (err \"x\")\n (lambda () (compute-default))) ;; → lazy default\n\n(unwrap-err (err \"bad\")) ;; → \"bad\"\n```\n\n### Transforming Results\n\n```scheme\n;; Map over ok values\n(map-ok (lambda (x) (* x 2)) (ok 5)) ;; → (ok 10)\n(map-ok (lambda (x) (* x 2)) (err \"x\")) ;; → (err \"x\")\n\n;; Map over error values\n(map-err string-upcase (err \"bad\")) ;; → (err \"BAD\")\n\n;; Monadic bind (chain operations)\n(and-then (ok 5) (lambda (x)\n (if (> x 0) (ok (* x 2)) (err \"negative\"))))\n;; → (ok 10)\n\n;; Error recovery\n(or-else (err \"bad\") (lambda (e) (ok 0))) ;; → (ok 0)\n```\n\n### Exception ↔ Result Conversion\n\n```scheme\n;; Wrap exceptions as err\n(try-result (/ 1 0)) ;; → (err <condition>)\n(try-result* (/ 1 0)) ;; → (err \"...message string...\")\n(try-result (+ 1 2)) ;; → (ok 3)\n```\n\n### Collection Operations\n\n```scheme\n;; All-or-nothing\n(sequence-results (list (ok 1) (ok 2) (ok 3)))\n;; → (ok (1 2 3))\n\n(sequence-results (list (ok 1) (err \"x\") (ok 3)))\n;; → (err \"x\")\n\n;; Partition successes and failures\n(results-partition (list (ok 1) (err \"a\") (ok 2)))\n;; → ((1 2) . (\"a\"))\n\n;; Filter\n(filter-ok (list (ok 1) (err \"a\") (ok 2))) ;; → (1 2)\n(filter-err (list (ok 1) (err \"a\") (ok 2))) ;; → (\"a\")\n```\n\n### Result-Aware Threading\n\n```scheme\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30)\n(->? (err \"x\") (+ 5) (* 2)) ;; → (err \"x\") — short circuits\n(->>? (ok 10) (- 3)) ;; → (ok -7) — thread last\n```\n\n---\n\n## Iterators\n\n### `for` — Side Effects\n\n```scheme\n(for ((x (in-range 5)))\n (displayln x))\n;; prints 0 1 2 3 4\n\n;; Multiple iterators (zipped, stops at shortest)\n(for ((name (in-list '(\"Alice\" \"Bob\")))\n (age (in-list '(30 25))))\n (displayln name \": \" age))\n```\n\n### `for/collect` — Build a List\n\n```scheme\n(for/collect ((x (in-range 5)))\n (* x x))\n;; → (0 1 4 9 16)\n```\n\n### `for/fold` — Accumulate\n\n```scheme\n(for/fold ((sum 0)) ((x (in-range 10)))\n (+ sum x))\n;; → 45\n```\n\n### `for/or` — First Truthy\n\n```scheme\n(for/or ((x (in-list '(1 -2 3 -4))))\n (and (negative? x) x))\n;; → -2\n```\n\n### `for/and` — All Truthy\n\n```scheme\n(for/and ((x (in-list '(2 4 6))))\n (even? x))\n;; → #t\n```\n\n### Iterator Constructors\n\n| Constructor | Description | Example |\n|-------------|-------------|---------|\n| `(in-list lst)` | Iterate over list | `(in-list '(a b c))` |\n| `(in-vector vec)` | Iterate over vector | `(in-vector #(1 2 3))` |\n| `(in-string str)` | Iterate over chars | `(in-string \"abc\")` |\n| `(in-range end)` | 0 to end-1 | `(in-range 5)` → 0..4 |\n| `(in-range start end)` | start to end-1 | `(in-range 2 5)` → 2..4 |\n| `(in-range start end step)` | with step | `(in-range 0 10 2)` → 0,2,4,6,8 |\n| `(in-hash-keys ht)` | Hash table keys | |\n| `(in-hash-values ht)` | Hash table values | |\n| `(in-hash-pairs ht)` | Key-value pairs | `(key . val)` |\n| `(in-naturals)` | 0, 1, 2, ... | Bounded to 100k |\n| `(in-naturals start)` | start, start+1, ... | |\n| `(in-indexed lst)` | `(idx . elem)` pairs | |\n| `(in-port [port [reader]])` | Read datums | |\n| `(in-lines [port])` | Read lines | |\n| `(in-chars [port])` | Read characters | |\n| `(in-bytes [port])` | Read bytes | |\n| `(in-producer thunk [sentinel])` | Call thunk until done | |\n\n---\n\n## Threading Macros\n\n### `->` Thread First\n\nInsert value as **first** argument at each step:\n\n```scheme\n(-> 10\n (+ 5) ;; (+ 10 5) → 15\n (* 2)) ;; (* 15 2) → 30\n```\n\n### `->>` Thread Last\n\nInsert value as **last** argument:\n\n```scheme\n(->> '(1 2 3 4 5)\n (filter even?) ;; (filter even? '(...)) → (2 4)\n (map (cut * <> 10)) ;; (map ... '(2 4)) → (20 40)\n (apply +)) ;; → 60\n```\n\n### `as->` Thread with Explicit Name\n\n```scheme\n(as-> 1 x\n (+ x 10) ;; → 11\n (* x 2) ;; → 22\n (- 100 x)) ;; → 78\n```\n\n### `some->` / `some->>` Short-Circuit on `#f`\n\n```scheme\n(some-> user\n (get-address) ;; returns #f if no address\n (get-city)) ;; skipped if previous was #f\n;; → city or #f\n```\n\n### `cond->` / `cond->>` Conditional Steps\n\n```scheme\n(cond-> base-query\n include-deleted? (add-filter \"deleted = true\")\n limit (add-limit limit))\n```\n\n---\n\n## Ergonomic Typing\n\n### `:` Type Cast\n\n```scheme\n(: value predicate?) ;; checked cast — raises if wrong type\n(: x number?) ;; asserts x is a number\n```\n\n### `using` — Typed Bindings with Dot Access\n\n```scheme\n(defstruct point (x y))\n\n(using (p (make-point 3 4) : point?)\n (+ p.x p.y)) ;; p.x → (point-x p)\n;; → 7\n\n;; Multiple bindings\n(using ((p (make-point 1 2) : point?)\n (c (make-circle 5) : circle?))\n (displayln p.x c.radius))\n\n;; `as` skips the type check (trust mode)\n(using (p some-expr as point?)\n p.x)\n```\n\n### Contract Predicates\n\n```scheme\n;; Predicate factory — returns a predicate\n((list-of? number?) '(1 2 3)) ;; → #t\n((list-of? string?) '(1 2 3)) ;; → #f\n\n;; Maybe — accepts #f or matching value\n((maybe string?) \"hello\") ;; → #t\n((maybe string?) #f) ;; → #t\n((maybe string?) 42) ;; → #f\n```\n\n---\n\n## Hash Tables\n\n### Construction\n\n```scheme\n;; Empty\n(def ht (make-hash-table))\n\n;; From pairs (literal macro)\n(def ht (hash-literal (\"name\" \"Alice\") (\"age\" 30)))\n\n;; From list of pairs\n(def ht (list->hash-table '((\"a\" . 1) (\"b\" . 2))))\n\n;; From property list\n(def ht (plist->hash-table '(\"name\" \"Alice\" \"age\" 30)))\n```\n\n### Access\n\n```scheme\n(hash-ref ht \"name\") ;; → \"Alice\" (error if missing)\n(hash-ref ht \"missing\" \"default\") ;; → \"default\"\n(hash-get ht \"name\") ;; → \"Alice\" or #f\n(hash-key? ht \"name\") ;; → #t\n```\n\n### Mutation\n\n```scheme\n(hash-put! ht \"email\" \"alice@example.com\")\n(hash-update! ht \"age\" add1)\n(hash-remove! ht \"email\")\n(hash-merge! target source) ;; merge source into target\n```\n\n### Iteration\n\n```scheme\n(hash-for-each (lambda (k v) (displayln k \": \" v)) ht)\n(hash-map (lambda (k v) (cons k (add1 v))) ht)\n(hash-fold (lambda (k v acc) (+ acc v)) 0 ht)\n\n;; With iterators\n(for ((k (in-hash-keys ht)))\n (displayln k))\n(for (((k . v) (in-hash-pairs ht)))\n (displayln k \" → \" v))\n```\n\n### Conversion\n\n```scheme\n(hash->list ht) ;; → ((key . val) ...)\n(hash->plist ht) ;; → (key val key val ...)\n(hash-keys ht) ;; → (key ...)\n(hash-values ht) ;; → (val ...)\n(hash-length ht) ;; → count\n(hash-copy ht) ;; → shallow copy\n```\n\n### Destructuring\n\n```scheme\n(let-hash ht (name age)\n (displayln name \" is \" age))\n```\n\n---\n\n## Functions & Combinators\n\n### Partial Application\n\n```scheme\n;; cut / cute (SRFI-26) — <> marks slots\n((cut + 1 <>) 5) ;; → 6\n((cut map <> '(1 2 3)) add1) ;; → (2 3 4)\n((cut string-append <> \"!\" <>) \"hi\" \"?\") ;; → \"hi!?\"\n\n;; partial (Clojure-style)\n((partial + 10) 5) ;; → 15\n```\n\n### Composition\n\n```scheme\n((compose add1 add1) 5) ;; → 7\n((comp add1 (* 2)) 5) ;; same (alias)\n((complement even?) 3) ;; → #t\n((negate even?) 3) ;; → #t\n((constantly 42) 'anything) ;; → 42\n(identity 42) ;; → 42\n((flip cons) '(2 3) 1) ;; → (1 2 3)\n```\n\n### Higher-Order Utilities\n\n```scheme\n((conjoin positive? even?) 4) ;; → #t (both true)\n((disjoin zero? negative?) -1) ;; → #t (either true)\n((every-pred number? positive?) 5) ;; → #t\n((some-fn string? number?) \"hi\") ;; → #t\n\n((curry + 1) 2) ;; → 3\n((juxt min max) 3 1 4 1 5) ;; → (1 5)\n((fnil + 0 0) #f 5) ;; → 5 (replaces #f with 0)\n\n(def slow-fib (memo-proc fib)) ;; memoize a procedure\n```\n\n---\n\n## Standard Library\n\nEverything below is available from `(import (jerboa prelude))`.\n\n### Strings — `(std misc string)`\n\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\")\n(string-join '(\"a\" \"b\" \"c\") \",\") ;; → \"a,b,c\"\n(string-trim \" hello \") ;; → \"hello\"\n(string-prefix? \"hel\" \"hello\") ;; → #t\n(string-suffix? \"llo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index)\n(string-index \"hello\" #\\l) ;; → 2\n(string-empty? \"\") ;; → #t\n(string-match? \"^[0-9]+$\" \"123\") ;; → #t\n(string-find \"[0-9]+\" \"abc123\") ;; → \"123\"\n(string-find-all \"[0-9]+\" \"a1b2\");; → (\"1\" \"2\")\n(str \"age: \" 25 \"!\") ;; → \"age: 25!\" (auto-coerce)\n```\n\n### Lists — `(std misc list)`\n\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3 3)) ;; → (1 2 3)\n(take '(1 2 3 4 5) 3) ;; → (1 2 3)\n(drop '(1 2 3 4 5) 3) ;; → (4 5)\n(take-last '(1 2 3 4) 2) ;; → (3 4)\n(drop-last '(1 2 3 4) 2) ;; → (1 2)\n(every number? '(1 2 3)) ;; → #t\n(any negative? '(1 -2 3)) ;; → #t\n(filter-map (lambda (x) (and (> x 0) (* x 2))) '(-1 2 -3 4))\n;; → (4 8)\n(group-by even? '(1 2 3 4 5))\n;; → ((#t 2 4) (#f 1 3 5))\n(zip '(1 2 3) '(a b c)) ;; → ((1 a) (2 b) (3 c))\n(frequencies '(a b a c b a)) ;; → ((a . 3) (b . 2) (c . 1))\n(partition even? '(1 2 3 4 5)) ;; → ((2 4) (1 3 5))\n(interleave '(1 2 3) '(a b c)) ;; → (1 a 2 b 3 c)\n(interpose \", \" '(\"a\" \"b\" \"c\")) ;; → (\"a\" \", \" \"b\" \", \" \"c\")\n(mapcat (lambda (x) (list x x)) '(1 2 3)) ;; → (1 1 2 2 3 3)\n(distinct '(1 2 1 3 2)) ;; → (1 2 3)\n(keep (lambda (x) (and (> x 0) x)) '(-1 2 -3 4)) ;; → (2 4)\n(split-at '(1 2 3 4 5) 3) ;; → ((1 2 3) (4 5))\n(reductions + 0 '(1 2 3)) ;; → (0 1 3 6)\n(append-map (lambda (x) (list x x)) '(1 2)) ;; → (1 1 2 2)\n(snoc '(1 2) 3) ;; → (1 2 3)\n```\n\n### Association Lists — `(std misc alist)`\n\n```scheme\n;; Construction\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n\n;; Access (q=eq?, v=eqv?, default=equal?)\n(aget '((name . \"Alice\")) 'name) ;; → \"Alice\"\n(agetq '((x . 1)) 'x) ;; → 1\n\n;; Mutation\n(aset! '((x . 1)) 'x 2) ;; → ((x . 2))\n\n;; Property lists\n(pgetq '(x 1 y 2) 'y) ;; → 2\n```\n\n### Sorting — `(std sort)`\n\n```scheme\n(sort '(3 1 2) <) ;; → (1 2 3)\n(sort! vec <) ;; in-place on vectors\n(stable-sort lst string<?) ;; preserves order of equal elements\n```\n\n### Formatting — `(std format)`\n\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"count: ~a\\n\" 42) ;; print to stdout\n(eprintf \"error: ~a\\n\" msg) ;; print to stderr\n```\n\n### JSON — `(std text json)`\n\n```scheme\n(def data (string->json-object \"{\\\"name\\\":\\\"Alice\\\",\\\"age\\\":30}\"))\n(hash-ref data \"name\") ;; → \"Alice\"\n\n(json-object->string (hash-literal (\"x\" 1) (\"y\" 2)))\n;; → \"{\\\"x\\\":1,\\\"y\\\":2}\"\n\n;; Port-based\n(read-json port)\n(write-json obj port)\n```\n\n### Paths — `(std os path)`\n\n```scheme\n(path-join \"/home\" \"user\" \"file.txt\") ;; → \"/home/user/file.txt\"\n(path-directory \"/home/user/f.txt\") ;; → \"/home/user\"\n(path-extension \"/home/user/f.txt\") ;; → \"txt\"\n(path-strip-extension \"file.txt\") ;; → \"file\"\n(path-absolute? \"/home\") ;; → #t\n(path-expand \"~/file\") ;; → \"/home/user/file\"\n```\n\n### File I/O — `(std misc ports)`\n\n```scheme\n(read-file-string \"data.txt\") ;; → entire file as string\n(read-file-lines \"data.txt\") ;; → list of lines\n(write-file-string \"out.txt\" \"hello\") ;; write string to file\n(read-all-as-string port) ;; read port to string\n```\n\n### CSV — `(std csv)`\n\n```scheme\n(csv->alists \"name,age\\nAlice,30\\nBob,25\")\n;; → (((name . \"Alice\") (age . \"30\"))\n;; ((name . \"Bob\") (age . \"25\")))\n\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" '((\"a\" \"b\") (\"1\" \"2\")))\n(rows->csv-string '((\"x\" \"y\") (\"1\" \"2\")))\n```\n\n### DateTime — `(std datetime)`\n\n```scheme\n(def now (datetime-now))\n(datetime-year now) ;; → 2026\n(datetime->iso8601 now) ;; → \"2026-03-27T22:13:43Z\"\n\n;; Construction\n(make-datetime 2026 3 27 12 0 0)\n(make-date 2026 3 27)\n(make-time 12 30 0)\n\n;; Parsing\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(parse-date \"2026-03-27\")\n\n;; Arithmetic\n(datetime-add now (make-duration 3600 0)) ;; +1 hour\n(datetime-diff dt1 dt2) ;; → duration\n\n;; Comparison\n(datetime<? dt1 dt2)\n(datetime-min dt1 dt2)\n(datetime-clamp dt lower upper)\n\n;; Calendar\n(day-of-week (make-date 2026 3 27)) ;; → 5 (Friday)\n(leap-year? 2024) ;; → #t\n(days-in-month 2026 2) ;; → 28\n```\n\n### Pretty Printing — `(std debug pp)`\n\n```scheme\n(pp '(a b (c d (e f)))) ;; pretty-print to stdout\n(pp-to-string expr) ;; → formatted string\n(ppd expr) ;; deep pretty-print (shows internals)\n```\n\n### Error Constructors — `(std error)`\n\n```scheme\n(Error \"something went wrong\" irritant1 irritant2)\n(ContractViolation \"expected positive\" value)\n```\n\n---\n\n## FFI\n\n### Quick FFI\n\n```scheme\n(import (jerboa prelude))\n\n(c-declare \"#include <math.h>\")\n(def c-sqrt (c-lambda (double) double \"sqrt\"))\n(c-sqrt 2.0) ;; → 1.4142135623730951\n```\n\n### `begin-ffi` Block\n\n```scheme\n(begin-ffi (my-getpid)\n (c-declare \"#include <unistd.h>\")\n (define my-getpid (c-lambda () int \"getpid\")))\n```\n\n### Direct Chez FFI\n\nFor more control, use Chez's native FFI directly:\n\n```scheme\n(import (chezscheme))\n(load-shared-object \"libm.so.6\")\n(def c-sin (foreign-procedure \"sin\" (double) double))\n```\n\n---\n\n## Additional Modules\n\nThese are **not** in the prelude — import them separately:\n\n```scheme\n;; Networking\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n\n;; Database\n(import (std db sqlite)) ;; SQLite bindings\n\n;; Concurrency\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std concur)) ;; Concurrency primitives\n\n;; Crypto\n(import (std crypto digest)) ;; SHA, MD5, etc.\n(import (std crypto cipher)) ;; AES, etc.\n\n;; Security\n(import (std security sandbox)) ;; Sandboxing\n(import (std security taint)) ;; Taint tracking\n\n;; Text processing\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std text regex)) ;; Regular expressions\n\n;; OS\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std os temp)) ;; Temp files\n```\n\n---\n\n## Differences from Gerbil\n\n| Feature | Gerbil | Jerboa |\n|---------|--------|--------|\n| Backend | Gambit | Chez Scheme |\n| Multiple inheritance | Yes | No (single only) |\n| `[...]` | Various uses | Always `(list ...)` |\n| `{...}` | Method call | Method call (same) |\n| `keyword:` | Keywords | Keywords (same) |\n| Module system | Gerbil modules | R6RS libraries (`.sls`) |\n| Compilation | `gxc` | Load from source / `compile-whole-program` |\n| `export` | `(export ...)` | Part of `(library ...)` form |\n| `##` primitives | Yes (Gambit) | No (use `(chezscheme)` imports) |\n| Iterators | `for/collect` etc. | Same syntax |\n| Result types | Not built-in | Built-in `ok`/`err` |\n| DateTime | Not built-in | Built-in `datetime` |\n| Ergo typing | Not built-in | Built-in `using`, `:` |\n| Threading macros | `->`, `->>` | Same + `->?`, `->>?` (result-aware) |\n\n---\n\n## Differences from Chez Scheme\n\n| Feature | Chez Scheme | Jerboa |\n|---------|-------------|--------|\n| File format | `.sls` with `(library ...)` | `.ss` with `(import ...)` |\n| `define` | `define` | `def` (preferred) |\n| Records | `define-record-type` | `defstruct` / `defclass` |\n| Hash tables | `(make-hashtable ...)` | `(make-hash-table)` with richer API |\n| Pattern matching | None built-in | `match` with guards, views, struct patterns |\n| Error handling | `guard` | `try`/`catch`/`finally` |\n| Macros | `define-syntax` | `defrule`/`defrules` (simpler), or `define-syntax` |\n| Strings | Basic | `string-split`, `string-join`, `str`, regex |\n| Lists | Basic | `take`, `drop`, `flatten`, `group-by`, `zip`, 50+ more |\n| Iteration | `do`, named `let` | `for`/`for/collect`/`for/fold` |\n| Method dispatch | None | `defmethod` + `~` / `{...}` |\n| FFI | `foreign-procedure` | `c-lambda` (simpler) + `foreign-procedure` |\n| JSON | None | Built-in `read-json`/`write-json` |\n| Paths | None | Built-in path operations |\n| CSV | None | Built-in CSV parsing |\n| Result type | None | Built-in `ok`/`err` monad |\n| DateTime | None | Built-in datetime library |\n\n---\n\n## The Jerboa Philosophy\n\n1. **One import to start**: `(import (jerboa prelude))` gives you a complete language\n2. **`.ss` files are the language**: You never need to write `.sls` files\n3. **Gerbil-familiar, Chez-powered**: Syntax is Gerbil-like, performance is Chez\n4. **Batteries included**: JSON, CSV, datetime, result types, iterators — all in the prelude\n5. **Functional first**: Threading macros, combinators, result monads — but mutation when needed\n6. **No boilerplate**: `def` over `define`, `defstruct` over `define-record-type`, `match` over nested `cond`\n"} {"text":"<!-- FILE: implement-me.md -->\n# Jerboa Runtime: Features to Implement\n\n## GC Finalizer Safety Net for Unclosed Resources\n\n**ID:** jerboa-finalizer-safety-net \n**Impact:** high \n**Votes:** 1\n\n### What\n\nRegister Chez guardians on resource-acquiring functions (`sqlite-open`, `tcp-connect`, `open-input-file`, etc.). When a resource is garbage collected without being explicitly closed, log a warning that includes the allocation site. This catches resource leaks that `with-resource` would have prevented, without crashing.\n\n### Why\n\nClaude-generated code frequently forgets `with-resource` and uses bare `(let ([db (sqlite-open ...)]) ...)`. The connection leaks silently and is only discovered in production under load. With a finalizer safety net, a warning appears in the log during testing so the leak is caught early.\n\n### Example\n\n```\nWARNING: sqlite handle #7 GC'd without close — allocated at handler.ss:42\n```\n\nDeveloper then wraps the `sqlite-open` in `with-resource`. Bug fixed before production.\n\n### How to Implement\n\nIn the relevant resource-opening functions (e.g. `sqlite-open` in `lib/std/db/sqlite.sls`, `tcp-connect` in `lib/std/net/tcp.sls`), register a Chez guardian after the resource is created:\n\n```scheme\n;; After creating the resource handle:\n(let ([guardian (make-guardian)])\n (guardian handle)\n (spawn\n (lambda ()\n (let loop ()\n (let ([collected (guardian)])\n (when collected\n (unless (resource-closed? collected)\n (log-warning\n (str \"WARNING: \" (resource-type-name collected)\n \" handle GC'd without close\"\n (if (resource-alloc-site collected)\n (str \" — allocated at \" (resource-alloc-site collected))\n \"\"))))\n (loop)))))))\n```\n\nKey details:\n- Use `make-guardian` (Chez SRFI-115 guardian API)\n- The guardian thread should be a daemon thread (low priority, doesn't prevent exit)\n- Capture the allocation site via `(call-with-current-continuation ...)` or a `(fluid-let ([*alloc-site* (current-source-location)]) ...)` wrapper at the call site\n- The warning should go to `current-error-port`, not `current-output-port`\n- This is opt-in per module — add to: `(std db sqlite)`, `(std net tcp)`, `(std net request)`, `(std os file)` at minimum\n\n### Affected Modules\n\n- `lib/std/db/sqlite.sls` — `sqlite-open`\n- `lib/std/net/tcp.sls` — `tcp-connect`, `tcp-listen`\n- `lib/std/net/request.sls` — any connection-holding handle\n- `lib/std/os/file.sls` — file handles opened without `with-resource`\n\n### Notes\n\n- The warning must NOT prevent GC or cause a crash — it is purely informational\n- In production, this can be silenced via `(set-resource-leak-warning! #f)`\n- This is a runtime change to the standard library, not an MCP tool\n"} -{"text":"<!-- FILE: AGENTS.md -->\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":"<!-- FILE: AGENTS.md -->\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":"<!-- FILE: libraries.md -->\n# Jerboa Library Gap Analysis\n\nGerbil has ~438 `:std/*` modules. Jerboa currently implements 51. This document tracks coverage and what's needed to close the gap.\n\n## Current Coverage (51 modules)\n\n| Category | Jerboa | Gerbil | Coverage |\n|----------|--------|--------|----------|\n| Core (sort, format, error, sugar, pregexp, logger, test) | 7 | ~15 | 47% |\n| text/* (json, csv, hex, base64, utf8, xml, yaml) | 7 | ~15 | 47% |\n| misc/* (string, list, alist, ports, channel, thread, process, queue, bytes, uuid, repr, completion) | 12 | ~38 | 32% |\n| os/* (path, env, signal, temporaries, fdio, epoll, inotify) | 7 | ~16 | 44% |\n| crypto/* (digest, cipher, hmac, pkey, kdf, etc) | 6 | ~9 | 67% |\n| net/* (request, httpd, ssl) | 3 | ~40+ | 8% |\n| db/* (leveldb, sqlite, postgresql) | 3 | ~4 | 75% |\n| cli/* (getopt) | 1 | ~4 | 25% |\n| srfi/* (13, 19) | 2 | ~60+ | 3% |\n| compress/* (zlib) | 1 | 0 | N/A |\n| pcre2 | 1 | 0 | N/A |\n\n## External chez-* Libraries\n\n### Already Integrated\n\n| Library | Wraps | Jerboa Modules |\n|---------|-------|---------------|\n| [chez-ssl](https://github.com/ober/chez-ssl) | OpenSSL TLS/TCP | `(std net ssl)` |\n| [chez-https](https://github.com/ober/chez-https) | HTTP client+server | `(std net request)`, `(std net httpd)` |\n| [chez-zlib](https://github.com/ober/chez-zlib) | zlib compression | `(std compress zlib)` |\n| [chez-pcre2](https://github.com/ober/chez-pcre2) | PCRE2 regex | `(std pcre2)` |\n| [chez-leveldb](https://github.com/ober/chez-leveldb) | LevelDB | `(std db leveldb)` |\n\n### Completed (New)\n\n| Library | Wraps | Jerboa Modules | Status |\n|---------|-------|---------------|--------|\n| [chez-epoll](https://github.com/ober/chez-epoll) | Linux epoll | `(std os epoll)` | Done |\n| [chez-inotify](https://github.com/ober/chez-inotify) | Linux inotify | `(std os inotify)` | Done |\n| [chez-crypto](https://github.com/ober/chez-crypto) | OpenSSL EVP | `(std crypto cipher)`, `(std crypto hmac)`, `(std crypto pkey)`, `(std crypto kdf)`, `(std crypto etc)` | Done |\n| [chez-sqlite](https://github.com/ober/chez-sqlite) | SQLite3 | `(std db sqlite)` | Done |\n| [chez-postgresql](https://github.com/ober/chez-postgresql) | libpq | `(std db postgresql)` | Done |\n\n### Replaced (No Longer Needed)\n\n| Library | Replaced By | Notes |\n|---------|------------|-------|\n| [chez-yaml](https://github.com/ober/chez-yaml) | Pure Scheme `(std text yaml)` | Roundtrip support: preserves comments, key ordering, scalar styles. No C dependency. 58 tests. |\n\n## Pure Scheme Modules (No External Deps)\n\n### High Priority — Commonly Used\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std iter)` | Iteration protocol | TODO |\n| `(std interface)` | Interface/protocol system | TODO |\n| `(std generic)` | Generic functions (CLOS-lite) | TODO |\n| `(std event)` | Event/sync system | TODO |\n| `(std coroutine)` | Coroutines via continuations | TODO |\n| `(std lazy)` | Lazy evaluation (delay/force) | TODO |\n| `(std values)` | Multiple-values utilities | TODO |\n| `(std ref)` | Generic ref/set! | TODO |\n| `(std contract)` | Design-by-contract | TODO |\n| `(std amb)` | Nondeterminism | TODO |\n| `(std net uri)` | URI parsing/encoding | TODO |\n| `(std net address)` | Network address parsing | TODO |\n| `(std net json-rpc)` | JSON-RPC protocol | TODO |\n| `(std parser)` | Parser combinators | TODO |\n| `(std protobuf)` | Protocol Buffers | TODO |\n\n### misc/* — Data Structures & Utilities\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std misc hash)` | Extended hash utilities | TODO |\n| `(std misc func)` | Function combinators | TODO |\n| `(std misc number)` | Number utilities | TODO |\n| `(std misc decimal)` | Decimal arithmetic | TODO |\n| `(std misc deque)` | Double-ended queue | TODO |\n| `(std misc pqueue)` | Priority queue | TODO |\n| `(std misc rbtree)` | Red-black tree | TODO |\n| `(std misc lru)` | LRU cache | TODO |\n| `(std misc dag)` | DAG operations | TODO |\n| `(std misc shuffle)` | Random shuffle | TODO |\n| `(std misc vector)` | Vector utilities | TODO |\n| `(std misc symbol)` | Symbol utilities | TODO |\n| `(std misc plist)` | Property lists | TODO |\n| `(std misc text)` | Text utilities | TODO |\n| `(std misc walist)` | Weak-alist | TODO |\n| `(std misc list-builder)` | List builder pattern | TODO |\n| `(std misc timeout)` | Timeout utilities | TODO |\n| `(std misc barrier)` | Thread barrier | TODO |\n| `(std misc rwlock)` | Read-write lock | TODO |\n| `(std misc concurrent-plan)` | Concurrent DAG executor | TODO |\n| `(std misc atom)` | Atomic reference | TODO |\n| `(std misc sync)` | Synchronization primitives | TODO |\n| `(std misc wg)` | WaitGroup | TODO |\n| `(std misc evector)` | Extensible vector | TODO |\n| `(std misc shared)` | Shared structure detection | TODO |\n| `(std misc path)` | Path utilities (beyond os/path) | TODO |\n| `(std misc prime)` | Prime numbers | TODO |\n| `(std misc template)` | String templates | TODO |\n\n### text/* — Text Processing\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std text base58)` | Base58 encode/decode | TODO |\n| `(std text utf16)` | UTF-16 utilities | TODO |\n| `(std text utf32)` | UTF-32 utilities | TODO |\n| `(std text char-set)` | Character sets (SRFI-14) | TODO |\n| `(std text zlib)` | zlib in text format | Covered by `(std compress zlib)` |\n\n### os/* — Operating System\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std os hostname)` | Get hostname | TODO |\n| `(std os pid)` | Process ID utilities | TODO |\n| `(std os pipe)` | Pipe creation | TODO |\n| `(std os flock)` | File locking | TODO |\n| `(std os fcntl)` | fcntl operations | TODO |\n| `(std os error)` | OS error codes | TODO |\n| `(std os fd)` | File descriptor utilities | TODO |\n| `(std os socket)` | Raw socket operations | TODO |\n| `(std os epoll)` | Linux epoll | Done |\n| `(std os inotify)` | Linux inotify | Done |\n| `(std os kqueue)` | BSD kqueue | N/A (Linux only) |\n| `(std os signalfd)` | Linux signalfd | TODO |\n\n### cli/* — Command Line\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std cli multicall)` | Busybox-style multicall | TODO |\n| `(std cli shell)` | Shell completion generation | TODO |\n| `(std cli print-exit)` | Print-and-exit patterns | TODO |\n\n### net/* — Networking (beyond HTTP)\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std net websocket)` | WebSocket client/server | TODO |\n| `(std net smtp)` | SMTP email sending | TODO |\n| `(std net socks)` | SOCKS proxy | TODO |\n| `(std net s3)` | AWS S3 client | TODO |\n| `(std net repl)` | Network REPL | TODO |\n| `(std net bio)` | Buffered network I/O | TODO |\n| `(std net socket)` | Socket abstraction | TODO |\n\n### markup/* — HTML/XML/TAL\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std markup html)` | HTML generation | TODO |\n| `(std markup xml)` | XML processing | Partially covered by `(std text xml)` |\n| `(std markup sxml)` | SXML processing | TODO |\n| `(std markup tal)` | TAL templates | TODO |\n\n### Other\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std mime types)` | MIME type database | TODO |\n| `(std io)` | Buffered I/O framework | TODO |\n| `(std debug DBG)` | Debug printing | TODO |\n| `(std debug heap)` | Heap analysis | TODO |\n| `(std debug threads)` | Thread debugging | TODO |\n| `(std web fastcgi)` | FastCGI protocol | TODO |\n| `(std web rack)` | Rack-style web framework | TODO |\n\n### srfi/* — Scheme Requests for Implementation\n\n| Module | Description | Status |\n|--------|-------------|--------|\n| `(std srfi 1)` | List library | TODO |\n| `(std srfi 8)` | receive (multiple values) | TODO |\n| `(std srfi 9)` | Records | TODO |\n| `(std srfi 14)` | Character sets | TODO |\n| `(std srfi 41)` | Streams (lazy lists) | TODO |\n| `(std srfi 42)` | Eager comprehensions | TODO |\n| `(std srfi 43)` | Vector library | TODO |\n| `(std srfi 78)` | Lightweight testing | TODO |\n| `(std srfi 95)` | Sorting and merging | TODO |\n| `(std srfi 101)` | Purely functional random-access pairs | TODO |\n| `(std srfi 113)` | Sets and bags | TODO |\n| `(std srfi 115)` | Regexp | TODO |\n| `(std srfi 116)` | Immutable pairs | TODO |\n| `(std srfi 117)` | Queues based on lists | TODO |\n| `(std srfi 121)` | Generators | TODO |\n| `(std srfi 124)` | Ephemerons | TODO |\n| `(std srfi 125)` | Hash tables | TODO |\n| `(std srfi 127)` | Lazy sequences | TODO |\n| `(std srfi 128)` | Comparators | TODO |\n| `(std srfi 130)` | Cursor-based string library | TODO |\n| `(std srfi 132)` | Sort libraries | TODO |\n| `(std srfi 133)` | Vector library (R7RS-compatible) | TODO |\n| `(std srfi 134)` | Immutable deques | TODO |\n| `(std srfi 135)` | Immutable texts | TODO |\n| `(std srfi 141)` | Integer division | TODO |\n| `(std srfi 143)` | Fixnums | TODO |\n| `(std srfi 144)` | Flonums | TODO |\n| `(std srfi 145)` | Assumptions | TODO |\n| `(std srfi 146)` | Mappings | TODO |\n| `(std srfi 151)` | Bitwise operations | TODO |\n| `(std srfi 158)` | Generators and accumulators | TODO |\n| `(std srfi 159)` | Combinator formatting | TODO |\n| `(std srfi 160)` | Homogeneous numeric vector | TODO |\n| `(std srfi 212)` | Aliases | TODO |\n\n## Actor System\n\nThe Gerbil actor system (v13 + v18, ~30+ modules) is deeply tied to the Gerbil runtime and would require significant design work to port. This is out of scope for initial coverage.\n\n## I/O System\n\nGerbil's `:std/io` subsystem (~30+ modules) provides a layered buffered I/O framework. Chez Scheme's built-in port system covers most use cases, but a compatibility layer could be built for code that depends on bio/strio APIs.\n"} {"text":"<!-- FILE: CLAUDE.md -->\n## Pre-commit Requirements\n\n**ALWAYS** run a clean build **before** committing any code to this repository. Pick the right target for the *current* platform:\n\n- **Linux**: run `make docker-build` — the Docker image must build cleanly against the full musl-static release pipeline.\n- **macOS / FreeBSD / other**: run `make binary` — the native local build must succeed. Do **not** run `make docker-build` here; Docker on non-Linux hosts is slow and not the canonical pipeline for those platforms.\n\nDo not commit if the build fails.\n\n## Act First, Read Less\n\nWhen making changes, read only what you need to make the edit, then make it.\nDo not read more than 3 files before acting. Do not re-read files you already\nread. Do not verify things you already know. If you have enough context to make\na change, make it. The user will interrupt you if you are wrong.\n\n"} {"text":"<!-- FILE: secure.md -->\n# Jerboa Secure Binary Strategy\n\n## The Problem\n\nJerboa compiles to Chez Scheme native code. A static musl binary (e.g., jerboa-secmon at 11MB) embeds:\n\n| Component | Size | ROP Gadgets |\n|-----------|------|-------------|\n| petite.boot | ~1.9MB | None (`.rodata` data) |\n| scheme.boot | ~1.0MB | None (data) |\n| app.boot | ~2.6MB | None (data) |\n| libkernel (Chez runtime) | ~1.0MB | **Thousands** — GC, compiler, thread scheduler, I/O |\n| musl libc | ~200KB | Some |\n| Rust native lib | ~500KB | Minimal (memory-safe code) |\n| ffi-shim + program | ~25KB | Minimal |\n\nThe Chez runtime (`libkernel`) is the primary source of ROP gadgets. At ~1MB of native code, it contains thousands of potentially usable gadget sequences. It is heavily interconnected (GC references compiler, compiler references I/O, I/O references threading) so `--gc-sections` removes very little.\n\nBoot files are pure data — zero gadget contribution. The Rust native library contributes minimal gadgets due to memory safety.\n\n---\n\n## Path 1: Harden the Chez Binary\n\n**Effort**: Days. **Impact**: Highest bang for buck.\n\nThis doesn't shrink the binary but makes gadgets effectively unusable through hardware and OS enforcement.\n\n### Intel CET (Control-flow Enforcement Technology)\n\nRequires CPU support (`ibt` and `user_shstk` in `/proc/cpuinfo`). Available on Intel 12th gen+ and AMD Zen 4+.\n\n#### Shadow Stack (SHSTK) — Priority: Very High\n\nHardware maintains a second copy of return addresses on a separate, protected shadow stack. On every `ret`, the CPU cross-checks the return address against the shadow copy. If they differ (because an attacker overwrote the real stack), the CPU faults with `#CP`.\n\nThis **directly defeats classical ROP**, which fundamentally relies on corrupted return addresses.\n\n**Chez compatibility**: Likely works without modification. Chez uses standard `call`/`ret` calling conventions. The JIT-generated code uses normal x86_64 function prologues/epilogues. Shadow stack enforcement should be transparent.\n\n**To enable**: Rebuild Chez with `-fcf-protection=return` (SHSTK only) or `-fcf-protection=full` (SHSTK + IBT). The binary must also be linked with CET-aware linker flags.\n\n#### Indirect Branch Tracking (IBT) — Priority: Medium\n\nEvery indirect jump/call target must begin with an `ENDBR64` instruction. If control flow arrives at a non-`ENDBR64` instruction via indirect branch, the CPU faults.\n\n**Chez compatibility**: Problematic. Chez's code generator emits native x86_64 code at runtime (during `compile-program` and boot file loading). This JIT-generated code does **not** have `ENDBR64` instructions at function entries. IBT will fault on calls into Chez-compiled code.\n\n**Fix**: Patch Chez's code generator (`compile.ss` and `gc.c`) to emit `ENDBR64` (4 bytes: `f3 0f 1e fa`) at every compiled function entry point. This is a targeted change — feasible but requires understanding Chez internals.\n\n**Alternative**: Enable SHSTK-only mode via `prctl(PR_SET_SHADOW_STACK, ...)` without IBT. Gets return-address protection without the indirect-branch requirement.\n\n### Standard Hardening CFLAGS\n\nRebuild Chez and all C code with:\n\n```\n-fstack-protector-strong # Stack canaries on functions with arrays/address-taken vars\n-fstack-clash-protection # Probe large stack allocations (prevent guard-page bypass)\n-fcf-protection=full # CET: shadow stack + indirect branch tracking\n-D_FORTIFY_SOURCE=2 # Compile-time and runtime buffer overflow checks\n-Wl,-z,relro,-z,now # Full RELRO (read-only GOT/PLT after startup)\n-pie # Position-independent executable (for ASLR)\n```\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** — all of the above are now applied by\ndefault. The `build-musl-binary` and `musl-link-command` functions automatically add these\nflags. Pass `no-harden: #t` to disable for debugging. CET flags (`-fcf-protection=full`)\nare only added on x86_64 Linux machine types.\n\n**Status: DONE in `jerboa-native-rs/.cargo/config.toml`** — Rust builds now pass\n`-Wl,-z,relro,-z,now` for all targets and `-fcf-protection=full` for x86_64 Linux.\n\n**NOT YET DONE — downstream projects**: jerboa-secmon and jerboa-dns have their own\nbuild scripts (`build-secmon-musl.ss`, `build-secmon-musl.sh`, `Dockerfile`) that hardcode\n`musl-gcc -c -O2` and `musl-gcc -static` directly instead of using `(jerboa build musl)`.\nThese need the same flags added manually, or better, ported to use the shared build module.\n\n**NOT YET DONE — Chez Scheme itself (libkernel.a)**: This is the biggest gap. The\nDockerfile builds Chez with `./configure --threads --disable-x11 --static CC=musl-gcc`\nand no `CFLAGS` override. The resulting `libkernel.a` — the ~1MB primary source of ROP\ngadgets — has **zero hardening**: no stack canaries, no CET, no FORTIFY_SOURCE. Fix by\npassing hardening flags when building Chez:\n\n```bash\n./configure --threads --disable-x11 --static \\\n CC=musl-gcc \\\n CFLAGS=\"-O2 -fstack-protector-strong -fstack-clash-protection -D_FORTIFY_SOURCE=2 -fPIE -fcf-protection=full\"\n```\n\nThis is the single highest-impact change remaining — it hardens the code that contributes\nthe most ROP gadgets.\n\n### Static PIE\n\nSwitch musl build from `-static` to **`-static-pie`**. This enables full ASLR for the entire binary — the base address, stack, heap, and mmap regions are all randomized on each execution.\n\nStatic linking actually slightly increases the gadget set (musl code is embedded rather than at a separate randomized address), but static PIE with ASLR makes all gadget addresses unpredictable. An attacker needs an information leak before they can chain gadgets.\n\n**Status: DONE in `lib/jerboa/build/musl.sls`** — `musl-link-command` now uses\n`-static-pie` by default instead of `-static`.\n\n### Namespace Isolation\n\nAdd Linux namespace isolation to the security cage module (`lib/std/security/cage.sls`). After initialization, call:\n\n```c\nunshare(CLONE_NEWPID | CLONE_NEWNS | CLONE_NEWNET)\n```\n\nThis creates:\n- **PID namespace**: Process can't see or signal other processes\n- **Mount namespace**: Process sees only an allow-listed filesystem\n- **Network namespace**: Process has only its own network stack (or a specific pre-bound socket)\n\nCombined with existing seccomp + Landlock/Capsicum, this creates micro-VM-like isolation without VM overhead.\n\n**Requirement**: `CAP_SYS_ADMIN` or unprivileged user namespaces enabled (`sysctl kernel.unprivileged_userns_clone=1`).\n\n### Hardening Summary\n\n| Technique | Works with Chez JIT? | Effort | ROP Impact |\n|-----------|---------------------|--------|------------|\n| **SHSTK (shadow stack)** | Likely yes | Low (rebuild Chez) | **Directly defeats ROP** |\n| **IBT (indirect branch)** | No (needs Chez patch) | High | Constrains gadgets to function entries |\n| Stack canaries | C code only, not JIT | Low (add CFLAG) | Detects stack buffer overflows |\n| Static PIE + ASLR | Yes | Low (change linker flag) | Gadget addresses unpredictable |\n| `-fstack-clash-protection` | Yes | Trivial | Prevents guard-page bypass |\n| seccomp post-init | Yes | **Already done** | Blocks ptrace, process_vm_readv |\n| Landlock/Capsicum post-init | Yes | **Already done** | Blocks filesystem escape |\n| Anti-debug | Yes | **Already done** | Blocks dynamic analysis |\n| Integrity verification | Yes | **Already done** | Detects binary modification |\n| Namespace isolation | Yes | Medium | PID/mount/network containment |\n\n### FreeBSD Portability (Path 1)\n\n**Intel CET is not available on any released FreeBSD.** Kernel SHSTK plumbing exists in\n15-CURRENT only (Konstantin Belousov's work). IBT enforcement has not been implemented.\nUserland CET support (rtld awareness, base compiled with `-fcf-protection`) is incomplete\neven in -CURRENT. This means the highest-value ROP mitigation — hardware shadow stacks —\nis Linux-only for the foreseeable future.\n\n**What FreeBSD 14.x provides today:**\n\n| Feature | FreeBSD Status | vs Linux |\n|---------|---------------|----------|\n| ASLR + PIE | On by default since 13.0 | **Lower entropy**: ~14 bits (stack) vs Linux ~22 bits |\n| Stack canaries (`-strong`) | Since 12.0 | Comparable |\n| `_FORTIFY_SOURCE=2` | Since 14.0 | Linux distros had this since ~2006 |\n| Full RELRO + BIND_NOW | Since 12.0 | Comparable |\n| Stack clash protection | Since ~13.x (clang) | Comparable |\n| Capsicum capability mode | Mature, since 9.0 | No Linux equivalent (seccomp is different) |\n| ARM PAC | Since 13.0 (arm64) | Comparable (Linux 5.0+) |\n| ARM BTI | Since 14.0 (arm64) | Comparable (Linux 5.10+) |\n| W^X opt-in (PROTMAX) | Since 14.0 via `procctl` | Linux has `prctl(SET_MDWE)` since 6.3 |\n| SafeStack | Available (clang), not default | Same on Linux |\n\n**The Capsicum vs seccomp gap for ROP containment:**\n\nCapsicum and seccomp solve different problems. Capsicum restricts *which resources* a process\ncan access (file descriptors, paths). seccomp restricts *which syscalls* a process can make.\n\nFor ROP mitigation specifically, seccomp has a critical advantage: it can **block\n`mprotect(PROT_EXEC)`** after initialization, preventing a ROP chain from making attacker-\ncontrolled data executable (the typical second stage after gaining control flow). Capsicum\ncannot do this — it does not filter memory operations.\n\nFreeBSD's `procctl(PROC_PROTMAX_CTL)` partially addresses this gap: when enabled, the\nmaximum protection on a mapping is set at `mmap` time and cannot be escalated via `mprotect`.\nHowever, this breaks Chez's JIT pattern (`mmap(RW)` then `mprotect(RX)`) unless all JIT\ncompilation completes before PROTMAX is enabled. A post-init PROTMAX call — after boot files\nare loaded and all code is compiled — could work but requires careful sequencing.\n\n**FreeBSD-specific hardening not available on Linux:**\n\n- **Capsicum**: Process-level capability confinement with per-fd rights limiting. More\n principled than seccomp for resource access control. Already integrated into Jerboa's\n cage module.\n- **HardenedBSD**: A FreeBSD fork with PaX-like features (strict W^X via NOEXEC, SEGVGUARD\n for brute-force ASLR defeat prevention, mandatory SafeStack). Tracks FreeBSD 14/15\n branches. Worth considering as a deployment target for maximum hardening.\n\n**Practical implication**: On FreeBSD, the lack of CET makes **Path 2 (WASM sandbox) more\nimportant** than on Linux. Without hardware return-address protection, software isolation of\nsecurity-critical parsers becomes the primary ROP defense rather than a defense-in-depth layer.\n\n**ARM64 FreeBSD** (e.g., AWS Graviton) is a notable bright spot: PAC (since 13.0) provides\nhardware return-address signing, and BTI (since 14.0) provides landing-pad enforcement. These\nare the ARM equivalents of CET SHSTK and IBT respectively, and they are available on released\nFreeBSD. For maximum hardware security on FreeBSD, target arm64.\n\n---\n\n## Path 2: WASM Sandbox for Parsers\n\n**Effort**: Weeks. **Impact**: Strongest isolation for the most-attacked code.\n\n### Why WASM Eliminates ROP\n\nWebAssembly is **structurally immune** to classical ROP:\n\n- **Separate code and data spaces**: Linear memory (where attacker-controlled input lives) cannot address the code section. You cannot scan executable pages for gadget sequences because they are in a completely separate address space managed by the runtime.\n- **No raw jumps**: All control flow uses `block`/`loop`/`if`/`br`/`br_table`. There is no `ret` instruction that pops an address off the stack.\n- **Opaque execution stack**: The WASM call stack is managed by the runtime, invisible to guest code. Buffer overflows in linear memory cannot overwrite return addresses because return addresses don't exist in linear memory.\n- **Typed indirect calls**: `call_indirect` validates function type signatures at runtime. You cannot redirect an indirect call to an arbitrary function.\n\nEven with arbitrary write within WASM linear memory, an attacker cannot hijack control flow. The attack surface shifts entirely to bugs in the WASM runtime itself.\n\n### Architecture: Split Design\n\n```\nJerboa binary\n├── Chez runtime (orchestration, policy, configuration DSL)\n├── Rust native lib (crypto via ring, TLS via rustls)\n└── wasmi WASM interpreter (security-critical parsers)\n ├── dns_parser.wasm (DNS packet parsing)\n ├── http_parser.wasm (HTTP request parsing)\n └── proto_fsm.wasm (protocol state machines)\n```\n\nSecurity-critical parsing code is written in Rust, compiled to `.wasm`, and executed inside an interpreter-mode WASM runtime embedded in the Jerboa binary. The Chez/Jerboa layer handles orchestration, policy evaluation, and configuration.\n\n### WASM Runtime Options\n\n| Runtime | Binary overhead | Mode | Gadgets in runtime | Best for |\n|---------|----------------|------|-------------------|----------|\n| **wasm3** | ~100KB static | Interpreter | Near-zero (tiny loop) | Maximum minimality |\n| **WAMR** | ~50-85KB | Interpreter | Near-zero | Embedded/IoT |\n| **wasmi** | ~2-3MB as Rust lib | Interpreter | Near-zero | Pure Rust, integrates with jerboa-native-rs |\n| **Wasmtime** | ~15-20MB | JIT (Cranelift) | Some (JIT code) | Full WASI, best tooling |\n\n**Key insight**: Interpreter-mode runtimes generate **zero native code at runtime**. The entire attack surface is the statically-compiled interpreter loop. A wasm3 interpreter is ~3,000 lines of C. Compare that to the millions of gadget-contributing instructions in Chez's runtime.\n\n### Integration with jerboa-native-rs\n\nAdd wasmi as a dependency in `jerboa-native-rs/Cargo.toml`. Expose FFI functions:\n\n```rust\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_load(module_bytes: *const u8, len: usize) -> i32;\n\n#[no_mangle]\npub extern \"C\" fn jerboa_wasm_call(\n func_name: *const u8, name_len: usize,\n input: *const u8, input_len: usize,\n output: *mut u8, output_len: usize,\n actual_len: *mut usize\n) -> i32;\n```\n\nScheme code calls through `foreign-procedure`:\n\n```scheme\n(define wasm-call\n (foreign-procedure \"jerboa_wasm_call\" (string int u8* int u8* int void*) int))\n```\n\n### Performance\n\nInterpreter-mode WASM is 10-100x slower than native. For a DNS server, the bottleneck is network I/O, not parsing compute. A DNS response parser running in wasm3 at 1/50th native speed still finishes in microseconds — acceptable for security-critical paths.\n\n### Existing WASM Infrastructure\n\nJerboa already has embryonic WASM support in `lib/jerboa/wasm/`:\n- `codegen.sls` — Compile restricted Scheme subset to WASM binary (i32-only, no closures)\n- `runtime.sls` — Stack-based WASM interpreter for testing\n- `format.sls` — LEB128 encoding, section parsing, binary format primitives\n\nThis is currently educational/testing-grade but the format layer is real and could serve as a foundation.\n\n---\n\n## Path 3: Minimal Interpreter Binary\n\n**Effort**: Months. **Impact**: Smallest possible footprint (~500KB).\n\nFor tools where binary size and gadget count are the absolute priority, replace the Chez runtime entirely with a minimal Scheme interpreter.\n\n### s7 Scheme\n\n- Single C file, ~35,000 lines. Compiles to **~400KB**.\n- Interpreter-only: no JIT means no W+X pages, no dynamically generated gadgets.\n- Full access to C hardening flags: `-fcf-protection=full`, `-fstack-protector-strong`, etc.\n- R7RS-ish with extensions. Not Chez-compatible.\n- ~50-100x slower than Chez for compute-heavy code. Acceptable for I/O-bound servers.\n\n### Architecture\n\n```\nStatic binary (~500KB-1MB)\n├── s7 Scheme interpreter (400KB, fully hardened C)\n├── Rust native lib (crypto, TLS, WASM runtime)\n└── Application logic in s7 Scheme\n```\n\n### Tradeoff\n\nThis means **leaving Jerboa** for those specific tools. You'd be writing a different program in a different Scheme dialect. The Jerboa prelude, reader syntax, defstruct/defclass/defmethod, capability system, effects, contracts — none of it carries over.\n\nThis path only makes sense if you're willing to write the security tools as standalone projects that don't depend on Jerboa's ecosystem. Jerboa could still be used for development, prototyping, and testing, with the production binary being a separate s7-based build.\n\n---\n\n## Approaches NOT Worth Pursuing\n\n### Scheme-to-Rust Transpilation\n\nFundamental type system mismatch makes automated translation impossible:\n- **Continuations**: Chez's `call/cc` captures the native stack. Rust has no equivalent.\n- **Garbage collection**: Scheme values are GC-managed. Rust uses ownership. No mechanical translation exists.\n- **Dynamic typing**: Every Scheme value is a tagged pointer. Translating to Rust means `enum Value { Int(i64), String(Rc<String>), ... }` everywhere, losing Rust's type safety benefits.\n\nNo tool exists for this. Building one would take years. The few academic efforts (Ribbit Scheme) produce minimal subsets lacking Jerboa's features.\n\n### Alternative Scheme Compilers (Chicken, Gambit)\n\nChicken compiles Scheme to C via Cheney-on-the-MTA. A minimal program produces a ~400KB binary. Gambit is similar but larger (~1-2MB). Both give full access to C hardening flags.\n\n**What you lose**: Chez's native-code performance (3-10x slower), the entire Jerboa prelude, all MCP tooling, reader syntax extensions, defstruct/defclass/defmethod, the capability system, taint tracking, effects, contracts.\n\nNot worth it unless starting from scratch.\n\n### Full LTO Across Chez + Rust\n\nNot technically feasible. Chez's `libkernel.a` is pre-built; LTO would require recompiling Chez with `-flto`. Even then, cross-language LTO (C + Rust) is not supported by current toolchains for this combination.\n\n---\n\n## Recommended Architecture\n\n### Target: Self-Sandboxing Static PIE Binary\n\nThe architecture adapts to platform capabilities. WASM-sandboxed parsing is the\nuniversal constant; OS-level confinement and hardware enforcement vary.\n\n```\n+--------------------------------------------------+\n| Static PIE ELF (~8MB) |\n| Full ASLR + platform-specific HW enforcement |\n| |\n| +-----------+ +-----------+ +---------------+ |\n| | Chez | | Rust | | wasmi WASM | |\n| | Runtime | | Native | | Interpreter | |\n| | | | (ring, | | (DNS parser | |\n| | | | rustls) | | in sandboxed | |\n| | | | | | WASM module) | |\n| +-----------+ +-----------+ +---------------+ |\n| |\n| Jerboa orchestration layer: |\n| - Capability-gated network I/O |\n| - Policy evaluation (who queries what) |\n| - Audit logging (hash-chain) |\n| - Configuration via Jerboa DSL |\n| |\n| Post-init self-sandbox (platform-dependent): |\n| +---------------------+------------------------+ |\n| | Linux | FreeBSD | |\n| +---------------------+------------------------+ |\n| | CET/SHSTK (hw ROP) | ARM PAC+BTI (arm64) | |\n| | seccomp (syscall | Capsicum (resource | |\n| | filter, block | confinement, block | |\n| | mprotect(EXEC)) | path-based access) | |\n| | Landlock (fs paths) | PROTMAX (post-init, | |\n| | Namespaces (PID, | block mprotect | |\n| | mount, network) | escalation) | |\n| | Anti-debug (ptrace) | Anti-debug (ptrace) | |\n| | Integrity check | Integrity check | |\n| +---------------------+------------------------+ |\n+--------------------------------------------------+\n```\n\n### Defense Layers by Platform\n\n**Linux (x86_64 with CET)** — Six independent layers:\n\n1. **ASLR** (~22 bits entropy) — Information leak to discover gadget addresses\n2. **CET/SHSTK** — Hardware bypass to use corrupted return addresses\n3. **WASM sandbox** — Runtime bug to escape parser isolation\n4. **seccomp** — Kernel exploit to make blocked syscalls (including `mprotect(EXEC)`)\n5. **Namespaces** — Kernel exploit to escape PID/mount/network isolation\n6. **Landlock** — Kernel exploit to access blocked filesystem paths\n\n**FreeBSD (x86_64)** — Five layers, no hardware ROP protection:\n\n1. **ASLR** (~14 bits entropy) — Information leak (lower bar than Linux)\n2. **WASM sandbox** — Runtime bug to escape parser isolation (**primary ROP defense**)\n3. **Capsicum** — Kernel exploit to escape capability mode\n4. **PROTMAX** — Kernel exploit or pre-PROTMAX timing to escalate memory protections\n5. **Anti-debug + integrity** — Bypass tracing detection and hash verification\n\n**FreeBSD (arm64)** — Six layers, with hardware enforcement:\n\n1. **ASLR** — Information leak to discover gadget addresses\n2. **ARM PAC** — Hardware bypass to forge signed return addresses\n3. **ARM BTI** — Hardware bypass to jump to non-BTI-landing-pad instructions\n4. **WASM sandbox** — Runtime bug to escape parser isolation\n5. **Capsicum** — Kernel exploit to escape capability mode\n6. **PROTMAX** — Kernel exploit to escalate memory protections\n\n**Key insight**: On FreeBSD x86_64, the WASM sandbox is not defense-in-depth — it is the\n**primary** control-flow integrity mechanism. This elevates Path 2 from \"nice to have\" to\n\"essential\" on that platform. On FreeBSD arm64, PAC+BTI restore hardware-level protection,\nmaking it the strongest FreeBSD deployment target.\n\n### Platform Feature Matrix\n\n| Defense | Linux x86_64 | FreeBSD x86_64 | FreeBSD arm64 |\n|---------|-------------|----------------|---------------|\n| ASLR | High entropy | Low entropy | Low entropy |\n| HW return-addr protection | CET/SHSTK | **None** | ARM PAC |\n| HW indirect-branch protection | CET/IBT (needs Chez patch) | **None** | ARM BTI |\n| Syscall filtering | seccomp-bpf | **None** (Capsicum is resource-based) | **None** |\n| Block mprotect(EXEC) | seccomp | PROTMAX (post-init only) | PROTMAX (post-init only) |\n| Resource confinement | Landlock | Capsicum | Capsicum |\n| Process isolation | Namespaces | **None** (jails require root) | **None** |\n| WASM parser sandbox | Yes | Yes | Yes |\n| Anti-debug | ptrace self-trace | ptrace self-trace | ptrace self-trace |\n| Compiler hardening (CFLAGS) | Full | Full | Full |\n\n### Implementation Priority\n\nPriority is adjusted for cross-platform impact. Items that benefit both Linux and FreeBSD\nare ranked higher than Linux-only features.\n\n| Phase | Work | Effort | Linux | FreeBSD | Notes |\n|-------|------|--------|-------|---------|-------|\n| **1a** | Embed wasmi in jerboa-native-rs | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform, highest priority |\n| **1b** | Write DNS parser in Rust → WASM | Week | Defense-in-depth | **Primary ROP defense** | Cross-platform |\n| **1c** | Switch musl build to static PIE | Hours | Full ASLR | Full ASLR | Cross-platform |\n| **1d** | Rebuild Chez with hardening CFLAGS | Days | All flags | All except CET | Cross-platform (flag subset varies) |\n| **2a** | Enable CET/SHSTK in Chez build | Days | **Defeats ROP** | N/A | Linux-only, highest HW impact |\n| **2b** | Add namespace isolation to cage | Days | Micro-VM containment | N/A | Linux-only |\n| **2c** | Enable PROTMAX post-init on FreeBSD | Days | N/A | Block mprotect escalation | FreeBSD-only, requires post-JIT sequencing |\n| **2d** | ARM PAC+BTI build target | Days | N/A | HW ROP defense (arm64) | FreeBSD arm64 only |\n| **3a** | Patch Chez codegen for ENDBR64 | Weeks | Full CET (IBT+SHSTK) | N/A | Linux-only, enables IBT |\n| **3b** | Encrypted boot files | Weeks | Resist static analysis | Resist static analysis | Cross-platform |\n| **3c** | Firecracker deployment wrapper | Weeks | VM-level isolation | N/A (bhyve possible) | Linux-primary |\n| **3d** | HardenedBSD deployment target | Days | N/A | Strict W^X, SEGVGUARD | FreeBSD fork, maximum hardening |\n"} @@ -1894,7 +1894,7 @@ {"text":";; FILE: jerboa-coreutils/src/jerboa-coreutils/common/io.ss\n;;; common/io.ss -- File and line processing utilities\n;;;\n;;; Security: Uses audit logging for file access when available.\n;;; Validates paths against NUL injection and path traversal.\n\n(export\n process-files\n for-each-line\n read-line/delim\n write-line/delim\n safe-open-input-file)\n\n(import :jerboa-coreutils/common\n :jerboa-coreutils/common/security\n :std/sugar)\n\n\n;; Validate that a path contains no NUL bytes (injection prevention)\n(define (validate-path! path who)\n (let loop ((i 0))\n (when (< i (string-length path))\n (when (char=? (string-ref path i) #\\nul)\n (die \"~a: path contains NUL byte\" who))\n (loop (+ i 1)))))\n\n;; Open a file with error handling and audit; returns port or calls die\n(define (safe-open-input-file path)\n (validate-path! path path)\n (audit-file-access! path)\n (with-catch\n (lambda (e)\n (die \"~a: No such file or directory\" path))\n (lambda ()\n (open-input-file path))))\n\n;; Process a list of files (or stdin if empty/\"-\")\n;; proc is called with an input port for each file\n(define (process-files files proc)\n (if (or (null? files) (equal? files '(\"-\")))\n (proc (current-input-port))\n (for-each\n (lambda (f)\n (if (equal? f \"-\")\n (proc (current-input-port))\n (let ((port (safe-open-input-file f)))\n (dynamic-wind\n (lambda () (void))\n (lambda () (proc port))\n (lambda () (close-input-port port))))))\n files)))\n\n;; Call proc on each line read from port\n(define (for-each-line port proc)\n (let loop ()\n (let ((line (get-line port)))\n (unless (eof-object? line)\n (proc line)\n (loop)))))\n\n;; Read until delimiter character (for NUL support)\n(define (read-line/delim port delim)\n (if (char=? delim #\\newline)\n (get-line port)\n (let ((out (open-output-string)))\n (let loop ()\n (let ((c (read-char port)))\n (cond\n ((eof-object? c)\n (let ((s (get-output-string out)))\n (if (string=? s \"\") c s)))\n ((char=? c delim)\n (get-output-string out))\n (else\n (write-char c out)\n (loop))))))))\n\n;; Write line with delimiter\n(define (write-line/delim line delim)\n (display line)\n (write-char delim))\n"} {"text":";; FILE: jerboa-coreutils/src/jerboa-coreutils/common/security.ss\n;;; common/security.ss -- Shared security infrastructure for jerboa-coreutils\n;;;\n;;; Centralizes security integration so individual commands can opt-in\n;;; to Landlock, seccomp, capabilities, audit logging, and taint tracking\n;;; with minimal boilerplate.\n\n(export\n ;; Seccomp profiles (pre-built for coreutils use cases)\n install-readonly-seccomp!\n install-io-seccomp!\n install-process-seccomp!\n\n ;; Landlock presets\n install-proc-only-landlock!\n install-readonly-landlock!\n install-readwrite-landlock!\n\n ;; Capability enforcement\n with-fs-read-capability\n with-fs-write-capability\n with-process-capability\n check-fs-read!\n check-fs-write!\n\n ;; Audit logging\n coreutils-audit-logger\n audit-file-access!\n audit-file-modify!\n audit-file-delete!\n audit-process-spawn!\n audit-process-signal!\n\n ;; Taint helpers\n taint-argv-path\n untaint-after-sanitize\n\n ;; Path sanitization (re-export from std)\n sanitize-path\n safe-path-join/checked\n\n ;; Secret wiping\n with-sensitive-buffer\n\n ;; Combined security initialization\n init-security!\n security-available?)\n\n(import (only-in :std/sugar with-catch)\n (only-in :std/format eprintf))\n\n\n;; ========== Feature Detection ==========\n;; Gracefully degrade when security modules aren't available or\n;; when the kernel doesn't support the feature.\n\n(define *seccomp-available* #f)\n(define *landlock-available* #f)\n(define *audit-logger* #f)\n\n(define (security-available?)\n (or *seccomp-available* *landlock-available*))\n\n;; ========== Lazy Loading ==========\n;; We use dynamic loading so the security modules are optional.\n;; If jerboa stdlib isn't available, security features silently degrade.\n\n;; --- Seccomp ---\n\n(define seccomp-install-proc #f)\n(define seccomp-make-filter-proc #f)\n(define seccomp-kill-action #f)\n\n(define (load-seccomp!)\n (with-catch\n (lambda (e) (set! *seccomp-available* #f))\n (lambda ()\n (let ((env (environment '(std security seccomp))))\n (set! seccomp-install-proc (eval 'seccomp-install! env))\n (set! seccomp-make-filter-proc (eval 'make-seccomp-filter env))\n (set! seccomp-kill-action (eval 'seccomp-kill env))\n (set! *seccomp-available*\n ((eval 'seccomp-available? env)))))))\n\n;; Syscall lists for different profiles\n(define readonly-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group))\n\n(define io-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group\n ;; File modification\n rename mkdir rmdir creat link unlink\n ftruncate))\n\n(define process-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group\n ;; Process management\n clone fork execve wait4 kill getpid getppid))\n\n(define (install-readonly-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n readonly-syscalls))))))\n\n(define (install-io-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n io-syscalls))))))\n\n(define (install-process-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n process-syscalls))))))\n\n;; --- Landlock ---\n\n(define landlock-make-ruleset-proc #f)\n(define landlock-add-read-only-proc #f)\n(define landlock-add-read-write-proc #f)\n(define landlock-add-execute-proc #f)\n(define landlock-install-proc #f)\n\n(define (load-landlock!)\n (with-catch\n (lambda (e) (set! *landlock-available* #f))\n (lambda ()\n (let ((env (environment '(std security landlock))))\n (set! landlock-make-ruleset-proc (eval 'make-landlock-ruleset env))\n (set! landlock-add-read-only-proc (eval 'landlock-add-read-only! env))\n (set! landlock-add-read-write-proc (eval 'landlock-add-read-write! env))\n (set! landlock-add-execute-proc (eval 'landlock-add-execute! env))\n (set! landlock-install-proc (eval 'landlock-install! env))\n (set! *landlock-available*\n ((eval 'landlock-available? env)))))))\n\n(define (install-proc-only-landlock!)\n ;; Restrict to /proc, /sys, /dev/null, /dev/tty (for top, uptime, etc.)\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (landlock-add-read-only-proc rs \"/proc\" \"/sys\" \"/dev\" \"/etc\"\n \"/usr/lib\" \"/lib\")\n (landlock-install-proc rs))))))\n\n(define (install-readonly-landlock! . paths)\n ;; Restrict to reading only the specified paths + /proc, /dev, /etc, system libs\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (apply landlock-add-read-only-proc rs\n \"/proc\" \"/sys\" \"/dev\" \"/etc\" \"/usr/lib\" \"/lib\"\n paths)\n (landlock-install-proc rs))))))\n\n(define (install-readwrite-landlock! read-paths write-paths)\n ;; Read access to read-paths, read+write to write-paths\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (apply landlock-add-read-only-proc rs\n \"/proc\" \"/sys\" \"/dev\" \"/etc\" \"/usr/lib\" \"/lib\"\n read-paths)\n (apply landlock-add-read-write-proc rs write-paths)\n (landlock-install-proc rs))))))\n\n;; --- Capabilities ---\n\n(define *current-capabilities* (make-parameter '()))\n\n(define-syntax with-fs-read-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'fs-read (*current-capabilities*))])\n body ...)]))\n\n(define-syntax with-fs-write-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'fs-write (*current-capabilities*))])\n body ...)]))\n\n(define-syntax with-process-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'process (*current-capabilities*))])\n body ...)]))\n\n(define (check-fs-read!)\n (unless (memq 'fs-read (*current-capabilities*))\n (error 'check-fs-read! \"filesystem read capability not granted\")))\n\n(define (check-fs-write!)\n (unless (memq 'fs-write (*current-capabilities*))\n (error 'check-fs-write! \"filesystem write capability not granted\")))\n\n;; --- Audit Logging ---\n\n(define audit-make-logger-proc #f)\n(define audit-log-proc #f)\n\n(define (load-audit!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security audit))))\n (set! audit-make-logger-proc (eval 'make-audit-logger env))\n (set! audit-log-proc (eval 'audit-log! env))\n ;; Initialize logger if env var is set\n (let ((log-path (getenv \"COREUTILS_AUDIT_LOG\")))\n (when (and log-path (> (string-length log-path) 0))\n (set! *audit-logger*\n (audit-make-logger-proc log-path))))))))\n\n(define (coreutils-audit-logger)\n *audit-logger*)\n\n(define (audit-file-access! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-access\n 'resource: path)))))\n\n(define (audit-file-modify! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-modify\n 'resource: path)))))\n\n(define (audit-file-delete! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-delete\n 'resource: path)))))\n\n(define (audit-process-spawn! cmd)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'process-spawn\n 'command: cmd)))))\n\n(define (audit-process-signal! pid sig)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'process-signal\n 'pid: (number->string pid)\n 'signal: (number->string sig))))))\n\n;; --- Taint Tracking ---\n\n(define taint-file-proc #f)\n(define untaint-proc #f)\n(define check-untainted-proc #f)\n\n(define (load-taint!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security taint))))\n (set! taint-file-proc (eval 'taint-file env))\n (set! untaint-proc (eval 'untaint env))\n (set! check-untainted-proc (eval 'check-untainted! env))))))\n\n(define (taint-argv-path path)\n ;; Mark a path from command-line arguments as file-input tainted\n (if taint-file-proc\n (taint-file-proc path)\n path))\n\n(define (untaint-after-sanitize value)\n ;; Remove taint after validation/sanitization\n (if untaint-proc\n (untaint-proc value)\n value))\n\n;; --- Path Sanitization ---\n\n(define sanitize-path-proc #f)\n\n(define (load-sanitize!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security sanitize))))\n (set! sanitize-path-proc (eval 'sanitize-path env))))))\n\n(define (sanitize-path path)\n ;; Canonicalize path and reject traversal attempts\n (if sanitize-path-proc\n (sanitize-path-proc path)\n path))\n\n(define (safe-path-join/checked base relative)\n ;; Join paths with traversal protection\n (let ((joined (string-append base \"/\" relative)))\n ;; Validate no NUL bytes\n (let check ((i 0))\n (when (< i (string-length relative))\n (when (char=? (string-ref relative i) #\\nul)\n (error 'safe-path-join/checked \"NUL byte in path\"))\n (check (+ i 1))))\n ;; Validate no escape via ..\n (let ((sanitized (sanitize-path joined)))\n (let ((blen (string-length base)))\n (if (and (>= (string-length sanitized) blen)\n (string=? (substring sanitized 0 blen) base))\n sanitized\n (error 'safe-path-join/checked\n \"path traversal detected\" relative))))))\n\n;; --- Secret Wiping ---\n\n(define wipe-bv-proc #f)\n\n(define (load-secret!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security secret))))\n (set! wipe-bv-proc (eval 'wipe-bytevector! env))))))\n\n(define-syntax with-sensitive-buffer\n (syntax-rules ()\n [(_ ([name size]) body ...)\n (let ([name (make-bytevector size 0)])\n (dynamic-wind\n (lambda () (void))\n (lambda () body ...)\n (lambda ()\n ;; Zero the buffer on scope exit\n (let loop ([i 0])\n (when (< i (bytevector-length name))\n (bytevector-u8-set! name i 0)\n (loop (+ i 1)))))))]))\n\n;; --- Combined Initialization ---\n\n(define (init-security!)\n ;; Load all security modules. Call once at startup.\n ;; Failures are silently ignored — security degrades gracefully.\n (load-seccomp!)\n (load-landlock!)\n (load-audit!)\n (load-taint!)\n (load-sanitize!)\n (load-secret!))\n"} {"text":";; FILE: jerboa-sed/main.ss\n#!chezscheme\n;;; Sed main entry point and file processing\n\n(import (except (chezscheme) compile-program) (sed ast) (sed parser) (sed engine))\n\n(define (main args)\n (guard (e [else\n (display \"sed: \" (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n (exit 1)])\n (run-sed args)))\n\n(define (run-sed args)\n (let-values ([(scripts files suppress? extended? in-place-suffix\n sandbox? null-data? separate?)\n (parse-args args)])\n (when (null? scripts)\n (display \"sed: no script\\nTry 'jsed --help' for more information.\\n\"\n (current-error-port))\n (exit 1))\n (let* ([full-script (string-join-sep scripts \"\\n\")]\n [parsed-cmds (parse-sed-script full-script extended?)]\n [prog (compile-program parsed-cmds)]\n [state (make-initial-sed-state suppress? extended?\n sandbox? null-data? separate?)])\n (if in-place-suffix\n (process-in-place state prog files in-place-suffix)\n (process-files state prog files (current-output-port))))))\n\n;;; Argument parsing\n\n(define (parse-args args)\n (let loop ([args args]\n [scripts '()]\n [files '()]\n [suppress? #f]\n [extended? #f]\n [in-place #f]\n [sandbox? #f]\n [null-data? #f]\n [separate? #f])\n (if (null? args)\n (values (reverse scripts) (reverse files)\n suppress? extended? in-place sandbox? null-data? separate?)\n (let ([arg (car args)] [rest (cdr args)])\n (cond\n [(string=? arg \"--\")\n (loop '() scripts (append (reverse rest) files)\n suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--quiet\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--silent\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(or (string=? arg \"--regexp-extended\") (string=? arg \"-E\") (string=? arg \"-r\"))\n (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)]\n [(string=? arg \"--sandbox\")\n (loop rest scripts files suppress? extended? in-place #t null-data? separate?)]\n [(or (string=? arg \"--null-data\") (string=? arg \"-z\"))\n (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)]\n [(or (string=? arg \"--separate\") (string=? arg \"-s\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)]\n [(or (string=? arg \"--posix\") (string=? arg \"--follow-symlinks\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--in-place\")\n (loop rest scripts files suppress? extended? \"\" sandbox? null-data? separate?)]\n [(string-prefix? \"--in-place=\" arg)\n (loop rest scripts files suppress? extended?\n (substring arg 11 (string-length arg))\n sandbox? null-data? separate?)]\n [(string-prefix? \"--expression=\" arg)\n (loop rest (cons (substring arg 13 (string-length arg)) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string-prefix? \"--file=\" arg)\n (loop rest (cons (read-script-file (substring arg 7 (string-length arg))) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--help\")\n (display-help)\n (exit 0)]\n [(string=? arg \"--version\")\n (display \"jsed (jerboa-sed) 0.1.0\\n\")\n (exit 0)]\n [(and (fx> (string-length arg) 1) (char=? (string-ref arg 0) #\\-))\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?\n (substring arg 1 (string-length arg)))]\n [(null? scripts)\n (loop rest (list arg) files suppress? extended? in-place sandbox? null-data? separate?)]\n [else\n (loop rest scripts (cons arg files)\n suppress? extended? in-place sandbox? null-data? separate?)])))))\n\n(define (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? opts)\n (if (string=? opts \"\")\n (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? separate? \"\")\n (let ([c (string-ref opts 0)]\n [tail (substring opts 1 (string-length opts))])\n (case c\n [(#\\n)\n (re-parse rest scripts files #t extended? in-place sandbox? null-data? separate? tail)]\n [(#\\E #\\r)\n (re-parse rest scripts files suppress? #t in-place sandbox? null-data? separate? tail)]\n [(#\\s)\n (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? #t tail)]\n [(#\\z)\n (re-parse rest scripts files suppress? extended? in-place sandbox? #t separate? tail)]\n [(#\\e)\n (if (string=? tail \"\")\n (if (null? rest)\n (begin\n (display \"sed: option requires an argument -- 'e'\\n\" (current-error-port))\n (exit 1))\n (re-parse (cdr rest) (cons (car rest) scripts) files suppress? extended? in-place\n sandbox? null-data? separate? \"\"))\n (re-parse rest (cons tail scripts) files suppress? extended? in-place\n sandbox? null-data? separate? \"\"))]\n [(#\\f)\n (if (string=? tail \"\")\n (if (null? rest)\n (begin\n (display \"sed: option requires an argument -- 'f'\\n\" (current-error-port))\n (exit 1))\n (re-parse (cdr rest) (cons (read-script-file (car rest)) scripts) files\n suppress? extended? in-place sandbox? null-data? separate? \"\"))\n (re-parse rest (cons (read-script-file tail) scripts) files\n suppress? extended? in-place sandbox? null-data? separate? \"\"))]\n [(#\\i)\n (re-parse rest scripts files suppress? extended? tail\n sandbox? null-data? separate? \"\")]\n [else\n (display (string-append \"sed: invalid option -- '\" (string c) \"'\\n\")\n (current-error-port))\n (exit 1)]))))\n\n(define (re-parse rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? remaining-opts)\n (if (string=? remaining-opts \"\")\n (parse-args-continue rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?)\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? remaining-opts)))\n\n(define (parse-args-continue rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?)\n (let loop ([args rest]\n [scripts scripts]\n [files files]\n [suppress? suppress?]\n [extended? extended?]\n [in-place in-place]\n [sandbox? sandbox?]\n [null-data? null-data?]\n [separate? separate?])\n (if (null? args)\n (values (reverse scripts) (reverse files)\n suppress? extended? in-place sandbox? null-data? separate?)\n (let ([arg (car args)] [rest (cdr args)])\n (cond\n [(string=? arg \"--\")\n (loop '() scripts (append (reverse rest) files)\n suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--quiet\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--silent\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(or (string=? arg \"--regexp-extended\") (string=? arg \"-E\") (string=? arg \"-r\"))\n (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)]\n [(string=? arg \"--sandbox\")\n (loop rest scripts files suppress? extended? in-place #t null-data? separate?)]\n [(or (string=? arg \"--null-data\") (string=? arg \"-z\"))\n (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)]\n [(or (string=? arg \"--separate\") (string=? arg \"-s\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)]\n [(or (string=? arg \"--posix\") (string=? arg \"--follow-symlinks\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--in-place\")\n (loop rest scripts files suppress? extended? \"\" sandbox? null-data? separate?)]\n [(string-prefix? \"--in-place=\" arg)\n (loop rest scripts files suppress? extended?\n (substring arg 11 (string-length arg)) sandbox? null-data? separate?)]\n [(string-prefix? \"--expression=\" arg)\n (loop rest (cons (substring arg 13 (string-length arg)) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string-prefix? \"--file=\" arg)\n (loop rest (cons (read-script-file (substring arg 7 (string-length arg))) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--help\") (display-help) (exit 0)]\n [(string=? arg \"--version\") (display \"jsed (jerboa-sed) 0.1.0\\n\") (exit 0)]\n [(and (fx> (string-length arg) 1) (char=? (string-ref arg 0) #\\-))\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?\n (substring arg 1 (string-length arg)))]\n [(null? scripts)\n (loop rest (list arg) files suppress? extended? in-place sandbox? null-data? separate?)]\n [else\n (loop rest scripts (cons arg files)\n suppress? extended? in-place sandbox? null-data? separate?)])))))\n\n(define (read-script-file filename)\n (guard (e [else\n (display (string-append \"sed: can't read \" filename \"\\n\")\n (current-error-port))\n (exit 1)])\n (call-with-input-file filename\n (lambda (port)\n (let loop ([lines '()])\n (let ([line (get-line port)])\n (if (eof-object? line)\n (string-join-sep (reverse lines) \"\\n\")\n (loop (cons line lines)))))))))\n\n(define (display-help)\n (display \"Usage: jsed [OPTION]... {script-only-if-no-other-script} [input-file]...\n\n -n, --quiet, --silent\n suppress automatic printing of pattern space\n -e script, --expression=script\n add the script to the commands to be executed\n -f script-file, --file=script-file\n add the contents of script-file to the commands to be executed\n -E, -r, --regexp-extended\n use extended regular expressions in the script\n -i[SUFFIX], --in-place[=SUFFIX]\n edit files in-place (makes backup if SUFFIX supplied)\n -s, --separate\n consider files as separate rather than as a single continuous stream\n -z, --null-data\n separate lines by NUL characters\n --sandbox operate in sandbox mode\n --help display this help and exit\n --version output version information and exit\n\n\"))\n\n;;; File processing\n\n(define (read-line-or-eof port)\n (let ([line (get-line port)])\n (if (eof-object? line) 'eof line)))\n\n(define (open-file-or-stdin filename)\n (if (string=? filename \"-\")\n (current-input-port)\n (guard (e [else\n (display (string-append \"sed: \" filename \": \")\n (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n #f])\n (open-input-file filename))))\n\n(define (process-files state prog files out-port)\n (let* ([file-list (if (null? files) '(\"-\") files)]\n [n (length file-list)])\n (if (sed-state-separate? state)\n (let loop ([lst file-list])\n (unless (null? lst)\n (sed-state-line-num-set! state 0)\n (sed-state-sub-succeeded?-set! state #f)\n (process-one-file! state prog (car lst) #t out-port)\n (loop (cdr lst))))\n (let loop ([lst file-list] [i 0])\n (unless (null? lst)\n (process-one-file! state prog (car lst) (fx= i (fx- n 1)) out-port)\n (loop (cdr lst) (fx+ i 1)))))))\n\n(define (process-one-file! state prog filename is-last-file? out-port)\n (sed-state-filename-set! state filename)\n (let ([port (open-file-or-stdin filename)])\n (when port\n (let ([first (read-line-or-eof port)])\n (unless (eq? first 'eof)\n (let ([nxt (box (read-line-or-eof port))])\n (let main-loop ([cur first])\n (unless (eq? cur 'eof)\n (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state cur)\n (sed-state-sub-succeeded?-set! state #f)\n (let cycle-loop ([start-pc 0])\n (let ([sig (run-sed-cycle-from! state prog out-port start-pc)])\n (cond\n [(eq? sig 'next)\n (let ([new-cur (unbox nxt)])\n (unless (eq? new-cur 'eof)\n (set-box! nxt (read-line-or-eof port)))\n (main-loop new-cur))]\n [(eq? sig 'restart)\n (cycle-loop 0)]\n [(and (pair? sig) (eq? (car sig) 'append-next))\n (let ([resume-pc (fx+ (cdr sig) 1)]\n [next-line (unbox nxt)])\n (if (eq? next-line 'eof)\n (begin\n (unless (sed-state-suppress? state)\n (put-string out-port (sed-state-pattern-space state))\n (newline out-port))\n (flush-append-queue! state out-port))\n (begin\n (sed-state-line-num-set! state\n (fx+ (sed-state-line-num state) 1))\n (set-box! nxt (read-line-or-eof port))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state\n (string-append (sed-state-pattern-space state)\n \"\\n\" next-line))\n (cycle-loop resume-pc))))]\n [(and (pair? sig) (eq? (car sig) 'read-next))\n (let ([resume-pc (fx+ (cdr sig) 1)]\n [next-line (unbox nxt)])\n (unless (eq? next-line 'eof)\n (sed-state-line-num-set! state\n (fx+ (sed-state-line-num state) 1))\n (set-box! nxt (read-line-or-eof port))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state next-line)\n (sed-state-sub-succeeded?-set! state #f)\n (cycle-loop resume-pc)))]\n [(and (pair? sig) (eq? (car sig) 'quit))\n (unless (string=? filename \"-\")\n (close-input-port port))\n (exit (cdr sig))]\n [else\n (let ([new-cur (unbox nxt)])\n (unless (eq? new-cur 'eof)\n (set-box! nxt (read-line-or-eof port)))\n (main-loop new-cur))]))))))))\n (when (and port (not (string=? filename \"-\")))\n (close-input-port port)))))\n\n;;; In-place editing\n\n(define (process-in-place state prog files suffix)\n (when (null? files)\n (display \"sed: no input files for in-place editing\\n\" (current-error-port))\n (exit 1))\n (for-each\n (lambda (filename)\n (unless (string=? filename \"-\")\n (let ([tmp (string-append filename \".jsed-tmp\")])\n (guard (e [else\n (display (string-append \"sed: \" filename \": \")\n (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n (when (file-exists? tmp) (delete-file tmp))])\n (let ([out-port (open-file-output-port tmp\n (file-options no-fail)\n (buffer-mode block)\n (make-transcoder (utf-8-codec)))])\n (process-one-file! state prog filename #t out-port)\n (close-port out-port))\n (when (and suffix (not (string=? suffix \"\")))\n (rename-file filename (string-append filename suffix)))\n (rename-file tmp filename)))))\n files))\n\n;;; Utilities\n\n(define (string-prefix? prefix str)\n (let ([plen (string-length prefix)])\n (and (fx<= plen (string-length str))\n (string=? prefix (substring str 0 plen)))))\n\n(define (string-join-sep strs sep)\n (if (null? strs) \"\"\n (let loop ([rest (cdr strs)] [acc (car strs)])\n (if (null? rest) acc\n (loop (cdr rest) (string-append acc sep (car rest)))))))\n\n;;; Entry point\n\n(main (cdr (command-line)))\n"} -{"text":";; FILE: jerboa-sed/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-sed/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-sed/.jerboa/security.json\n{\n \"version\": 1,\n \"repo\": \"jerboa-sed\",\n \"extends\": [\"jerboa:cli\", \"jerboa:parser\"],\n \"paths\": {\n \"production\": [\"*.ss\", \"*.sls\", \"lib/**/*.ss\", \"lib/**/*.sls\", \"src/**/*.ss\", \"src/**/*.sls\", \"bin/**\", \"Makefile\"],\n \"tests\": [\"test/**\", \"tests/**\", \"**/*-test.ss\"],\n \"generated\": [\"build/**\", \"dist/**\", \"target/**\"],\n \"vendor\": [\"vendor/**\", \"third_party/**\"],\n \"docs\": [\"README.md\", \"docs/**\", \"*.md\", \"AGENTS.md\"]\n },\n \"policy\": {\n \"failOn\": [\"critical\", \"high\"],\n \"imports\": { \"directChezscheme\": \"deny\" },\n \"ffi\": { \"allowed\": false },\n \"process\": { \"shellInterpolation\": \"deny\" },\n \"network\": { \"requireTimeouts\": false },\n \"eval\": { \"stringEval\": \"deny\", \"bareRead\": \"deny\", \"allowReadEval\": false },\n \"parser\": { \"requireLimits\": true }\n },\n \"suppressions\": []\n}\n"} {"text":";; FILE: jerboa-awk/AGENTS.md\n# AGENTS.md for jerboa-$app Repositories\n\nThese instructions apply to agents working in this repository.\n\n## Language: Jerboa ONLY\n\nAll code in any `jerboa-*` directory or repository must be written in **Jerboa**\n— `.ss` files using `(jerboa prelude)`, `def`, `defstruct`, the Jerboa reader\nextras (`[...]` lists, `{...}` method dispatch, `keyword:` args), and\n`(std ...)` modules. The Jerboa toolchain compiles `.ss` → `.sls`.\n\nNever write raw Chez `.sls` files with `#!chezscheme` + R6RS\n`define`/`define-record-type`/`(library ...)` forms, and never write the\napplication logic in another language (shell, Python, Rust, etc.) — that\nbypasses Jerboa entirely and defeats the purpose of these repos.\n\n## Build Contract\n\nThe Makefile must provide these targets:\n\n- `make` prints the available targets. It must not build, install, test, or mutate artifacts.\n- `make binary` builds the application binary for the local host OS and architecture.\n- `make linux-amd64` cross-builds the Linux amd64 binary from the current host.\n- `make linux-arm64` cross-builds the Linux arm64 binary from the current host.\n- `make freebsd-amd64` cross-builds the FreeBSD amd64 binary from the current host.\n\nThe cross-build targets must use the local cross toolchains and Jerboa/Chez\ncross-build setup. Never use Docker or Podman for building, testing, smoke\ntesting, packaging, or verifying these targets.\n\n## Required Verification\n\nBefore committing or pushing any code, all required build targets must succeed:\n\n```sh\nmake\nmake binary\nmake linux-amd64\nmake linux-arm64\nmake freebsd-amd64\n```\n\nDo not commit or push if any target fails. If a cross-build cannot run because\nthe host is missing a required toolchain or sysroot, stop and report the missing\ndependency instead of committing or pushing partially verified code.\n\n## Working Rules\n\n- Keep changes inside the current repository unless the user explicitly names another path.\n- Preserve the target semantics above when editing the Makefile.\n- Treat the cross-build targets as release-critical, not optional follow-up work.\n- Do not add Dockerfiles, container scripts, Podman invocations, or container-based verification paths.\n"} {"text":";; FILE: jerboa-awk/bin/jawk-program.ss\n#!chezscheme\n;;;; jawk — AWK interpreter entry point (for binary compilation).\n;;;;\n;;;; jerbuild's main.c runs this file as a program: the top-level forms\n;;;; execute and (command-line-arguments) holds argv[1..]. (No scheme-start\n;;;; hook fires under jerbuild, so call main directly.)\n\n(import (chezscheme) (jerboa-awk main))\n\n(suppress-greeting #t)\n\n(main (command-line-arguments))\n"} @@ -2050,7 +2050,7 @@ {"text":";; FILE: jerboa-shell/lineedit.ss\n;;; lineedit.ss — Terminal line editor for gsh\n;;; Custom line editor with emacs/vi modes, history, search, kill ring.\n\n(export #t)\n(import :std/sugar\n :std/format\n (only (std misc string) string-contains)\n :jsh/util\n :jsh/history\n :jsh/ffi\n (only (compat gambit) tty-mode-set!))\n\n;;; --- fzf callback hooks (set by fzf.ss at startup) ---\n;;; These are set to actual functions after fzf.ss loads.\n;;; Initialized to make-parameter so the compiler sees them as procedures.\n(def *fzf-history-fn* (make-parameter #f)) ;; parameter: (lambda (commands) -> string or #f) or #f\n(def *fzf-files-fn* (make-parameter #f)) ;; parameter: (lambda () -> string or #f) or #f\n(def *fzf-dirs-fn* (make-parameter #f)) ;; parameter: (lambda () -> string or #f) or #f\n\n;;; --- Constants ---\n\n(def ESC #\\escape)\n(def ESC-BYTE 27)\n(def CTRL-A 1)\n(def CTRL-B 2)\n(def CTRL-C 3)\n(def CTRL-D 4)\n(def CTRL-E 5)\n(def CTRL-F 6)\n(def CTRL-G 7)\n(def CTRL-H 8)\n(def CTRL-K 11)\n(def CTRL-L 12)\n(def CTRL-N 14)\n(def CTRL-P 16)\n(def CTRL-R 18)\n(def CTRL-S 19)\n(def CTRL-T 20)\n(def CTRL-U 21)\n(def CTRL-W 23)\n(def CTRL-Y 25)\n(def CTRL-Z 26)\n(def CTRL-UNDERSCORE 31)\n(def TAB-KEY 9)\n(def ENTER-KEY 13)\n(def NEWLINE-KEY 10)\n\n(def (enter-key? key)\n (and (char? key)\n (let ([code (char->integer key)])\n (or (= code ENTER-KEY) (= code NEWLINE-KEY)))))\n(def BACKSPACE 127)\n\n;;; --- Editor state ---\n\n(defstruct line-state\n (buffer ;; string: current line content\n cursor ;; integer: cursor position in buffer\n prompt ;; string: display prompt\n prompt-width ;; integer: visible width of last line of prompt\n prompt-lines ;; integer: number of newlines in prompt (cached)\n history-index ;; integer or #f: current history position\n saved-line ;; string: saved current line before history nav\n kill-ring ;; list of strings\n undo-stack ;; list of (buffer . cursor) pairs\n search-mode ;; #f, 'reverse, or 'forward\n search-string ;; string: current search query\n search-result ;; string or #f: matched history entry\n columns ;; integer: terminal width\n multiline? ;; boolean: whether to support multiline\n mode ;; 'emacs or 'vi\n vi-mode ;; 'insert or 'command (only for vi mode)\n complete-fn ;; completion callback or #f\n done? ;; boolean: editing complete\n result ;; string or 'eof: final result\n )\n transparent: #t)\n\n;;; --- Terminal I/O ---\n\n(def (term-raw! port)\n ;; Set terminal to raw mode: char-at-a-time, no echo, no signal processing\n ;; Args: port input-allow-special input-echo input-raw output-raw speed\n ;; Must use Gambit's tty-mode-set! exclusively — calling tcsetattr via FFI\n ;; desynchronizes Gambit's cached terminal state and breaks read-char.\n (tty-mode-set! port #f #f #t #t 0))\n\n(def (term-cooked! port)\n ;; Restore terminal to cooked mode: canonical, echo\n (tty-mode-set! port #t #t #f #f 0))\n\n;; Write ANSI escape sequences\n(def ESC-STR (string #\\escape))\n\n;; Cursor hide/show — used to prevent visible flicker during line redraws\n(def CURSOR-HIDE (string-append ESC-STR \"[?25l\"))\n(def CURSOR-SHOW (string-append ESC-STR \"[?25h\"))\n\n(def (term-move-cursor-col col port)\n (fprintf port \"\\r~a[~aC\" ESC-STR (+ col 1)))\n\n(def (term-clear-to-eol port)\n (display (string-append ESC-STR \"[K\") port))\n\n(def (term-clear-line port)\n (display (string-append \"\\r\" ESC-STR \"[K\") port))\n\n(def (term-clear-screen port)\n (display (string-append ESC-STR \"[H\" ESC-STR \"[2J\") port))\n\n(def (term-move-up n port)\n (when (> n 0)\n (fprintf port \"~a[~aA\" ESC-STR n)))\n\n(def (term-move-down n port)\n (when (> n 0)\n (fprintf port \"~a[~aB\" ESC-STR n)))\n\n(def (term-cursor-forward n port)\n (when (> n 0)\n (fprintf port \"~a[~aC\" ESC-STR n)))\n\n(def (term-cursor-back n port)\n (when (> n 0)\n (fprintf port \"~a[~aD\" ESC-STR n)))\n\n;;; --- Terminal size ---\n\n(def *terminal-columns* 80)\n\n(def (get-terminal-columns)\n *terminal-columns*)\n\n(def (set-terminal-columns! cols)\n (set! *terminal-columns* cols))\n\n(def (detect-terminal-columns)\n (let ([cols (ffi-terminal-columns 0)])\n ;; Fallback to 80 if detection fails\n (if (or (not cols) (= cols 0))\n 80\n cols)))\n\n;;; --- Read input bytes ---\n\n(def (read-key port)\n ;; Read a key from the terminal. Returns:\n ;; - A character for regular keys\n ;; - A symbol for special keys: 'up, 'down, 'left, 'right, 'home, 'end,\n ;; 'delete, 'page-up, 'page-down\n ;; - A list '(alt char) for Alt-X keys\n ;; - 'eof for end of input\n (let ([ch (read-char port)])\n (cond\n ((eof-object? ch) 'eof)\n ;; Escape sequence\n ((char=? ch ESC)\n (if (char-ready? port)\n (let ([ch2 (read-char port)])\n (cond\n ((eof-object? ch2) 'escape)\n ;; CSI sequence: ESC [\n ((char=? ch2 #\\[)\n (let ([ch3 (read-char port)])\n (cond\n ((eof-object? ch3) 'escape)\n ((char=? ch3 #\\A) 'up)\n ((char=? ch3 #\\B) 'down)\n ((char=? ch3 #\\C) 'right)\n ((char=? ch3 #\\D) 'left)\n ((char=? ch3 #\\H) 'home)\n ((char=? ch3 #\\F) 'end)\n ;; Extended sequences: ESC [ N ~\n ((and (char>=? ch3 #\\0) (char<=? ch3 #\\9))\n (let ([num (- (char->integer ch3) (char->integer #\\0))])\n (let ([ch4 (read-char port)])\n (cond\n ((eof-object? ch4) 'escape)\n ((char=? ch4 #\\~)\n (case num\n ((1) 'home)\n ((3) 'delete)\n ((4) 'end)\n ((5) 'page-up)\n ((6) 'page-down)\n ((7) 'home)\n ((8) 'end)\n (else 'unknown)))\n ;; Two-digit sequences\n ((and (char>=? ch4 #\\0) (char<=? ch4 #\\9))\n ;; Read until ~\n (let loop ()\n (let ([c (read-char port)])\n (if (or (eof-object? c) (char=? c #\\~))\n 'unknown\n (loop))))\n 'unknown)\n (else 'unknown)))))\n (else 'unknown))))\n ;; SS3 sequence: ESC O\n ((char=? ch2 #\\O)\n (let ([ch3 (read-char port)])\n (cond\n ((eof-object? ch3) 'escape)\n ((char=? ch3 #\\A) 'up)\n ((char=? ch3 #\\B) 'down)\n ((char=? ch3 #\\C) 'right)\n ((char=? ch3 #\\D) 'left)\n ((char=? ch3 #\\H) 'home)\n ((char=? ch3 #\\F) 'end)\n (else 'unknown))))\n ;; Alt-key: ESC followed by printable char\n (else (list 'alt ch2))))\n ;; Bare escape (no following chars ready)\n 'escape))\n ;; Regular character (possibly ctrl)\n (else ch))))\n\n;;; --- Rendering ---\n\n(def (refresh-line state port)\n (let* ([prompt (line-state-prompt state)]\n [buf (line-state-buffer state)]\n [cursor (line-state-cursor state)]\n [pwidth (line-state-prompt-width state)]\n [cols (line-state-columns state)]\n ;; Count newlines in prompt to handle multi-line prompts\n [prompt-lines (count-newlines prompt)]\n ;; Calculate the width of the LAST line of the prompt\n ;; This is what we need for cursor positioning on multi-line prompts\n [last-line-width (visible-width-last-line prompt)])\n ;; Move to start of prompt (handle multi-line prompts)\n ;; Move up by number of newlines in prompt, then carriage return\n (when (> prompt-lines 0)\n (term-move-up prompt-lines port))\n (display \"\\r\" port)\n ;; Display prompt with explicit \\r after each \\n\n ;; This ensures cursor returns to column 0 on each new line\n (let ([len (string-length prompt)])\n (let loop ([i 0])\n (when (< i len)\n (let ([ch (string-ref prompt i)])\n (display (string ch) port)\n (when (char=? ch #\\newline)\n (display \"\\r\" port)))\n (loop (+ i 1)))))\n (display buf port)\n (term-clear-to-eol port)\n ;; Position cursor - use last-line-width instead of pwidth for multi-line prompts\n (let ([cursor-col (+ last-line-width cursor)])\n ;; Move cursor back from end of line to cursor position\n (let ([end-col (+ last-line-width (string-length buf))])\n (when (> end-col cursor-col)\n (term-cursor-back (- end-col cursor-col) port))))\n (force-output port)))\n\n(def (refresh-search state port)\n (let* ([search-str (line-state-search-string state)]\n [result (or (line-state-search-result state) \"\")]\n [mode-str (if (eq? (line-state-search-mode state) 'reverse)\n \"(reverse-i-search)\" \"(i-search)\")])\n (display \"\\r\" port)\n (term-clear-to-eol port)\n (fprintf port \"~a`~a': ~a\" mode-str search-str result)\n (force-output port)))\n\n(def (refresh-cursor-move delta port)\n ;; Fix #3: Fast path for pure cursor movement (left/right/Ctrl-B/Ctrl-F).\n ;; Emits a single cursor escape instead of redrawing the entire line.\n ;; Delta > 0 = move right, delta < 0 = move left.\n (cond\n ((> delta 0) (term-cursor-forward delta port))\n ((< delta 0) (term-cursor-back (- delta) port)))\n (force-output port))\n\n;;; --- Line buffer operations ---\n\n(def (buf-insert state ch)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)]\n [new (make-string (+ len 1))])\n (save-undo! state)\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (string-set! new pos ch)\n (let loop ((i pos))\n (when (< i len)\n (string-set! new (+ i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (+ pos 1))))\n\n(def (buf-insert-string state str)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [blen (string-length buf)]\n [slen (string-length str)]\n [new (make-string (+ blen slen))])\n (save-undo! state)\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i 0))\n (when (< i slen)\n (string-set! new (+ pos i) (string-ref str i))\n (loop (+ i 1))))\n (let loop ((i pos))\n (when (< i blen)\n (string-set! new (+ i slen) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (+ pos slen))))\n\n(def (buf-delete-char state)\n ;; Delete character at cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (< pos len)\n (save-undo! state)\n (let ((new (make-string (- len 1))))\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i (+ pos 1)))\n (when (< i len)\n (string-set! new (- i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)))))\n\n(def (buf-backspace state)\n ;; Delete character before cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (> pos 0)\n (save-undo! state)\n (let ((new (make-string (- len 1))))\n (let loop ((i 0))\n (when (< i (- pos 1))\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i pos))\n (when (< i len)\n (string-set! new (- i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (- pos 1))))))\n\n(def (buf-kill-to-end state)\n ;; Kill from cursor to end of line\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [killed (substring buf pos (string-length buf))])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state) (substring buf 0 pos)))))\n\n(def (buf-kill-to-start state)\n ;; Kill from start to cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [killed (substring buf 0 pos)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state) (substring buf pos (string-length buf)))\n (set! (line-state-cursor state) 0))))\n\n(def (buf-kill-word-back state)\n ;; Kill word backward (Ctrl-W)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n ;; Skip trailing whitespace\n [start (let loop ([i (- pos 1)])\n (if (and (>= i 0) (char-whitespace? (string-ref buf i)))\n (loop (- i 1))\n (+ i 1)))]\n ;; Find word start\n [word-start (let loop ([i (- start 1)])\n (if (and (>= i 0) (not (char-whitespace? (string-ref buf i))))\n (loop (- i 1))\n (+ i 1)))]\n [killed (substring buf word-start pos)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state)\n (string-append (substring buf 0 word-start)\n (substring buf pos (string-length buf))))\n (set! (line-state-cursor state) word-start))))\n\n(def (buf-kill-word-forward state)\n ;; Kill word forward (Alt-D)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)]\n ;; Skip whitespace\n [start (let loop ([i pos])\n (if (and (< i len) (char-whitespace? (string-ref buf i)))\n (loop (+ i 1))\n i))]\n ;; Find word end\n [word-end (let loop ([i start])\n (if (and (< i len) (not (char-whitespace? (string-ref buf i))))\n (loop (+ i 1))\n i))]\n [killed (substring buf pos word-end)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state)\n (string-append (substring buf 0 pos)\n (substring buf word-end len))))))\n\n(def (buf-transpose-chars state)\n ;; Transpose the two characters before cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (and (> pos 0) (> len 1))\n (save-undo! state)\n (let* ([p (if (= pos len) (- pos 1) pos)]\n [c1 (string-ref buf (- p 1))]\n [c2 (string-ref buf p)]\n [new-buf (string-copy buf)])\n (string-set! new-buf (- p 1) c2)\n (string-set! new-buf p c1)\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state)\n (min (+ p 1) len))))))\n\n;;; --- Word movement ---\n\n(def (word-forward-pos buf pos)\n ;; Find position after next word\n (let ([len (string-length buf)])\n ;; Skip non-word chars\n (let loop ([i pos])\n (if (and (< i len) (not (char-alphanumeric? (string-ref buf i))))\n (loop (+ i 1))\n ;; Skip word chars\n (let loop2 ([i i])\n (if (and (< i len) (char-alphanumeric? (string-ref buf i)))\n (loop2 (+ i 1))\n i))))))\n\n(def (word-backward-pos buf pos)\n ;; Find position before previous word\n (if (<= pos 0) 0\n ;; Skip non-word chars\n (let loop ([i (- pos 1)])\n (if (and (> i 0) (not (char-alphanumeric? (string-ref buf i))))\n (loop (- i 1))\n ;; Skip word chars\n (let loop2 ([i i])\n (if (and (> i 0) (char-alphanumeric? (string-ref buf (- i 1))))\n (loop2 (- i 1))\n i))))))\n\n(def (char-alphanumeric? ch)\n (or (char-alphabetic? ch) (char-numeric? ch) (char=? ch #\\_)))\n\n;;; --- Kill ring ---\n\n(def (kill-ring-push! state text)\n (set! (line-state-kill-ring state)\n (cons text (take-at-most (line-state-kill-ring state) 31))))\n\n(def (kill-ring-top state)\n (let ([kr (line-state-kill-ring state)])\n (if (null? kr) #f (car kr))))\n\n(def (take-at-most lst n)\n (if (or (null? lst) (<= n 0)) (list)\n (cons (car lst) (take-at-most (cdr lst) (- n 1)))))\n\n;;; --- Undo ---\n\n(def (save-undo! state)\n (set! (line-state-undo-stack state)\n (cons (cons (string-copy (line-state-buffer state))\n (line-state-cursor state))\n (take-at-most (line-state-undo-stack state) 99))))\n\n(def (undo! state)\n (let ([stack (line-state-undo-stack state)])\n (when (pair? stack)\n (let ([entry (car stack)])\n (set! (line-state-buffer state) (car entry))\n (set! (line-state-cursor state) (cdr entry))\n (set! (line-state-undo-stack state) (cdr stack))))))\n\n;;; --- History navigation ---\n\n(def (history-prev state)\n (let ([idx (or (line-state-history-index state) 0)])\n (let ([entry (history-get-relative idx)])\n (when entry\n ;; Save current line if first navigation\n (unless (line-state-history-index state)\n (set! (line-state-saved-line state)\n (string-copy (line-state-buffer state))))\n (set! (line-state-history-index state) (+ idx 1))\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry))))))\n\n(def (history-next state)\n (let ([idx (line-state-history-index state)])\n (when (and idx (> idx 0))\n (let ([new-idx (- idx 1)])\n (if (= new-idx 0)\n ;; Back to current line\n (begin\n (set! (line-state-history-index state) #f)\n (set! (line-state-buffer state)\n (string-copy (or (line-state-saved-line state) \"\")))\n (set! (line-state-cursor state)\n (string-length (line-state-buffer state))))\n ;; Navigate to history entry\n (let ([entry (history-get-relative (- new-idx 1))])\n (when entry\n (set! (line-state-history-index state) new-idx)\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry)))))))))\n\n;;; --- Incremental search ---\n;;; Fix #9: Maintain a filtered candidate list.\n;;; When the user types another character (query grows), filter the existing\n;;; candidates instead of rescanning the full history.\n;;; When the query shrinks (backspace), rebuild from full history (unavoidable).\n\n(def *search-candidates* (list)) ;; All matching history entries for current query\n(def *search-query-cache* \"\") ;; Query string that produced *search-candidates*\n\n(def (search-all-matching substr)\n ;; Return all history entries containing substr, most recent first.\n (filter (lambda (cmd) (string-contains cmd substr))\n (history-list)))\n\n(def (search-start state mode)\n (set! (line-state-search-mode state) mode)\n (set! (line-state-search-string state) \"\")\n (set! (line-state-search-result state) #f)\n (set! *search-candidates* (list))\n (set! *search-query-cache* \"\"))\n\n(def (search-update state)\n ;; Update search results based on current search string\n (let ([query (line-state-search-string state)])\n (when (> (string-length query) 0)\n (let ([result (history-search-reverse query)])\n (set! (line-state-search-result state) result)))))\n\n(def (search-accept state)\n ;; Accept search result and exit search mode\n (let ([result (line-state-search-result state)])\n (set! (line-state-search-mode state) #f)\n (when result\n (set! (line-state-buffer state) (string-copy result))\n (set! (line-state-cursor state) (string-length result)))))\n\n(def (search-cancel state)\n ;; Cancel search and restore previous line\n (set! (line-state-search-mode state) #f)\n (set! (line-state-search-string state) \"\")\n (set! (line-state-search-result state) #f))\n\n;;; --- Emacs mode key handling ---\n\n(def (handle-emacs-key state key out-port)\n (cond\n ;; Search mode handling\n ((line-state-search-mode state)\n (handle-search-key state key out-port))\n ;; Character input (exclude DEL/backspace = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (buf-insert state key)\n (refresh-line state out-port))\n ;; Ctrl keys\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ((and (char? key) (= (char->integer key) CTRL-A))\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-E))\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-B))\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((and (char? key) (= (char->integer key) CTRL-F))\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((and (char? key) (= (char->integer key) CTRL-D))\n (if (= (string-length (line-state-buffer state)) 0)\n ;; EOF on empty line\n (begin\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof))\n ;; Delete char at cursor\n (begin\n (buf-delete-char state)\n (refresh-line state out-port))))\n ((and (char? key) (= (char->integer key) BACKSPACE))\n (buf-backspace state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-H))\n (buf-backspace state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-K))\n (buf-kill-to-end state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-U))\n (buf-kill-to-start state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-W))\n (buf-kill-word-back state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-Y))\n ;; Yank from kill ring\n (let ([text (kill-ring-top state)])\n (when text\n (buf-insert-string state text)\n (refresh-line state out-port))))\n ((and (char? key) (= (char->integer key) CTRL-T))\n ;; Fuzzy file finder via fzf (if available), else transpose chars\n (let ([fn (*fzf-files-fn*)])\n (if fn\n (begin\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn)))])\n (term-raw! (current-input-port))\n (when result\n (buf-insert-string state result))))\n (buf-transpose-chars state)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-L))\n ;; Clear screen\n (term-clear-screen out-port)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-P))\n (history-prev state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-N))\n (history-next state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-R))\n ;; Fuzzy history search via fzf (if available), else fallback to substring search\n (let ([fn (*fzf-history-fn*)])\n (if fn\n (let ([commands (history-unique-commands)])\n (when (pair? commands)\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn commands)))])\n (term-raw! (current-input-port))\n (when result\n (save-undo! state)\n (set! (line-state-buffer state) (string-copy result))\n (set! (line-state-cursor state) (string-length result))))))\n ;; Fallback: legacy substring search\n (search-start state 'reverse)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-S))\n (search-start state 'forward)\n (refresh-search state out-port))\n ((and (char? key) (= (char->integer key) CTRL-G))\n ;; Cancel\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-UNDERSCORE))\n ;; Undo\n (undo! state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-C))\n ;; Abort line\n (display \"^C\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) \"\"))\n ((and (char? key) (= (char->integer key) TAB-KEY))\n ;; Tab completion\n (handle-tab-completion state out-port))\n ;; Arrow keys\n ((eq? key 'up)\n (history-prev state)\n (refresh-line state out-port))\n ((eq? key 'down)\n (history-next state)\n (refresh-line state out-port))\n ((eq? key 'left)\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((eq? key 'right)\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((eq? key 'home)\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((eq? key 'end)\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (refresh-line state out-port))\n ((eq? key 'delete)\n (buf-delete-char state)\n (refresh-line state out-port))\n ;; Alt-key combinations\n ((and (list? key) (eq? (car key) 'alt))\n (handle-alt-key state (cadr key) out-port))\n (else #!void)))\n\n;;; --- Alt-key handling ---\n\n(def (handle-alt-key state ch out-port)\n (cond\n ;; Alt-B: backward word\n ((or (char=? ch #\\b) (char=? ch #\\B))\n (set! (line-state-cursor state)\n (word-backward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ;; Alt-F: forward word\n ((or (char=? ch #\\f) (char=? ch #\\F))\n (set! (line-state-cursor state)\n (word-forward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ;; Alt-D: kill word forward\n ((or (char=? ch #\\d) (char=? ch #\\D))\n (buf-kill-word-forward state)\n (refresh-line state out-port))\n ;; Alt-U: uppercase word\n ((or (char=? ch #\\u) (char=? ch #\\U))\n (word-transform! state char-upcase)\n (refresh-line state out-port))\n ;; Alt-L: lowercase word\n ((or (char=? ch #\\l) (char=? ch #\\L))\n (word-transform! state char-downcase)\n (refresh-line state out-port))\n ;; Alt-C: fuzzy directory jump via fzf (if available), else capitalize word\n ((or (char=? ch #\\c) (char=? ch #\\C))\n (let ([fn (*fzf-dirs-fn*)])\n (if fn\n (begin\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn)))])\n (term-raw! (current-input-port))\n (when result\n (save-undo! state)\n (set! (line-state-buffer state) (string-append \"cd \" result))\n (set! (line-state-cursor state) (+ 3 (string-length result))))))\n (word-capitalize! state)))\n (refresh-line state out-port))\n ;; Alt-<: beginning of history\n ((char=? ch #\\<)\n ;; Navigate to oldest history entry\n (let ([count (history-count)])\n (when (> count 0)\n (unless (line-state-history-index state)\n (set! (line-state-saved-line state)\n (string-copy (line-state-buffer state))))\n (let ([entry (history-get 1)])\n (when entry\n (set! (line-state-history-index state) count)\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry))\n (refresh-line state out-port))))))\n ;; Alt->: end of history (current line)\n ((char=? ch #\\>)\n (when (line-state-history-index state)\n (set! (line-state-history-index state) #f)\n (set! (line-state-buffer state)\n (string-copy (or (line-state-saved-line state) \"\")))\n (set! (line-state-cursor state)\n (string-length (line-state-buffer state)))\n (refresh-line state out-port)))\n ;; Alt-.: insert last argument of previous command\n ((char=? ch #\\.)\n (let ([prev (history-get-relative 0)])\n (when prev\n (let ([words (simple-split prev)])\n (when (pair? words)\n (let ([last-word (car (last-pair words))])\n (buf-insert-string state last-word)\n (refresh-line state out-port)))))))\n (else #!void)))\n\n;;; --- Word transformations ---\n\n(def (word-transform! state transform-fn)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [end (word-forward-pos buf pos)]\n [new-buf (string-copy buf)])\n (save-undo! state)\n (let loop ([i pos])\n (when (< i end)\n (string-set! new-buf i (transform-fn (string-ref new-buf i)))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state) end)))\n\n(def (word-capitalize! state)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [end (word-forward-pos buf pos)]\n [new-buf (string-copy buf)])\n (save-undo! state)\n ;; Skip non-alpha\n (let loop ([i pos] [first? #t])\n (when (< i end)\n (let ([ch (string-ref new-buf i)])\n (cond\n ((char-alphabetic? ch)\n (string-set! new-buf i\n (if first? (char-upcase ch) (char-downcase ch)))\n (loop (+ i 1) #f))\n (else\n (loop (+ i 1) first?))))))\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state) end)))\n\n;;; --- Search mode key handling ---\n\n(def (handle-search-key state key out-port)\n (cond\n ;; Ctrl-R / Ctrl-S: keep searching\n ((and (char? key) (= (char->integer key) CTRL-R))\n ;; TODO: search backwards more\n (refresh-search state out-port))\n ((and (char? key) (= (char->integer key) CTRL-S))\n ;; TODO: search forwards\n (refresh-search state out-port))\n ;; Ctrl-G: cancel search\n ((and (char? key) (= (char->integer key) CTRL-G))\n (search-cancel state)\n (refresh-line state out-port))\n ;; Enter: accept search\n ((enter-key? key)\n (search-accept state)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ;; Backspace: remove last search char\n ((and (char? key)\n (or (= (char->integer key) BACKSPACE) (= (char->integer key) CTRL-H)))\n (let ([s (line-state-search-string state)])\n (when (> (string-length s) 0)\n (set! (line-state-search-string state)\n (substring s 0 (- (string-length s) 1)))\n (search-update state)))\n (refresh-search state out-port))\n ;; Escape or any arrow/special: accept and handle as normal\n ((or (eq? key 'escape) (symbol? key))\n (search-accept state)\n (refresh-line state out-port))\n ;; Printable char: add to search string (exclude DEL = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (set! (line-state-search-string state)\n (string-append (line-state-search-string state) (string key)))\n (search-update state)\n (refresh-search state out-port))\n ;; Anything else: accept search and re-handle key\n (else\n (search-accept state)\n (handle-emacs-key state key out-port))))\n\n;;; --- Tab completion ---\n\n(def (handle-tab-completion state out-port)\n (let ([fn (line-state-complete-fn state)])\n (when fn\n (let ([completions (fn (line-state-buffer state)\n (line-state-cursor state))])\n (cond\n ((null? completions) #!void) ;; No completions — beep?\n ((= (length completions) 1)\n ;; Single completion: insert it\n ;; Don't append space after directory completions (ending with /)\n ;; so the user can keep tabbing into subdirectories\n (let* ([completion (car completions)]\n [is-dir? (and (> (string-length completion) 0)\n (char=? (string-ref completion\n (- (string-length completion) 1))\n #\\/))]\n [suffix (if is-dir? \"\" \" \")]\n [word-start (find-word-start-for-completion\n (line-state-buffer state)\n (line-state-cursor state))])\n (save-undo! state)\n (set! (line-state-buffer state)\n (string-append\n (substring (line-state-buffer state) 0 word-start)\n completion\n suffix\n (substring (line-state-buffer state)\n (line-state-cursor state)\n (string-length (line-state-buffer state)))))\n (set! (line-state-cursor state)\n (+ word-start (string-length completion) (string-length suffix)))\n (refresh-line state out-port)))\n (else\n ;; Multiple completions: insert common prefix, display list\n (let* ([prefix (common-prefix completions)]\n [word-start (find-word-start-for-completion\n (line-state-buffer state)\n (line-state-cursor state))])\n (when (> (string-length prefix) (- (line-state-cursor state) word-start))\n (save-undo! state)\n (set! (line-state-buffer state)\n (string-append\n (substring (line-state-buffer state) 0 word-start)\n prefix\n (substring (line-state-buffer state)\n (line-state-cursor state)\n (string-length (line-state-buffer state)))))\n (set! (line-state-cursor state) (+ word-start (string-length prefix))))\n ;; Display completions\n (display \"\\r\\n\" out-port)\n (display-completions completions out-port (line-state-columns state))\n (refresh-line state out-port))))))))\n\n(def (find-word-start-for-completion buf cursor)\n ;; Find start of the word being completed.\n ;; Do NOT treat / as a boundary — it's part of file paths.\n ;; The completion functions handle path splitting internally.\n (let loop ([i (- cursor 1)])\n (if (or (< i 0)\n (char-whitespace? (string-ref buf i))\n (char=? (string-ref buf i) #\\=))\n (+ i 1)\n (loop (- i 1)))))\n\n(def (common-prefix strings)\n ;; Find longest common prefix of a list of strings\n (if (null? strings) \"\"\n (let ([first (car strings)])\n (let loop ([len (string-length first)])\n (if (<= len 0) \"\"\n (let ([prefix (substring first 0 len)])\n (if (every? (lambda (s)\n (and (>= (string-length s) len)\n (string=? (substring s 0 len) prefix)))\n strings)\n prefix\n (loop (- len 1)))))))))\n\n(def (every? pred lst)\n (cond\n ((null? lst) #t)\n ((pred (car lst)) (every? pred (cdr lst)))\n (else #f)))\n\n(def (display-completions completions port columns)\n ;; Display completions in columns\n ;; Use \\r\\n because terminal is in raw output mode (no LF→CRLF conversion)\n (let* ([max-len (apply max (map string-length completions))]\n [col-width (+ max-len 2)]\n [ncols (max 1 (quotient columns col-width))])\n (let loop ([items completions] [col 0])\n (unless (null? items)\n (let ([item (car items)])\n (display item port)\n (if (= (+ col 1) ncols)\n (begin (display \"\\r\\n\" port) (loop (cdr items) 0))\n (begin\n (display (make-string (- col-width (string-length item)) #\\space) port)\n (loop (cdr items) (+ col 1)))))))\n (when (and (pair? completions)\n (not (= 0 (modulo (length completions) ncols))))\n (display \"\\r\\n\" port))\n (force-output port)))\n\n;;; --- Vi mode (basic) ---\n\n(def (handle-vi-key state key out-port)\n (if (eq? (line-state-vi-mode state) 'insert)\n (handle-vi-insert state key out-port)\n (handle-vi-command state key out-port)))\n\n(def (handle-vi-insert state key out-port)\n (cond\n ;; Escape -> command mode\n ((eq? key 'escape)\n (set! (line-state-vi-mode state) 'command)\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1)))\n (refresh-line state out-port))\n ;; Enter\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ;; Backspace\n ((and (char? key) (or (= (char->integer key) BACKSPACE)\n (= (char->integer key) CTRL-H)))\n (buf-backspace state)\n (refresh-line state out-port))\n ;; Ctrl-C\n ((and (char? key) (= (char->integer key) CTRL-C))\n (display \"^C\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) \"\"))\n ;; Tab\n ((and (char? key) (= (char->integer key) TAB-KEY))\n (handle-tab-completion state out-port))\n ;; Ctrl-D\n ((and (char? key) (= (char->integer key) CTRL-D))\n (if (= (string-length (line-state-buffer state)) 0)\n (begin\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof))\n (begin\n (buf-delete-char state)\n (refresh-line state out-port))))\n ;; Regular printable character (exclude DEL = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (buf-insert state key)\n (refresh-line state out-port))\n (else #!void)))\n\n(def (handle-vi-command state key out-port)\n (cond\n ;; Movement\n ((and (char? key) (char=? key #\\h))\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((and (char? key) (char=? key #\\l))\n (when (< (line-state-cursor state)\n (- (string-length (line-state-buffer state)) 1))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((and (char? key) (char=? key #\\w))\n (set! (line-state-cursor state)\n (word-forward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\b))\n (set! (line-state-cursor state)\n (word-backward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\0))\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\$))\n (let ([len (string-length (line-state-buffer state))])\n (set! (line-state-cursor state) (max 0 (- len 1)))\n (refresh-line state out-port)))\n ;; Insert modes\n ((and (char? key) (char=? key #\\i))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\a))\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1)))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\A))\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\I))\n (set! (line-state-cursor state) 0)\n (set! (line-state-vi-mode state) 'insert))\n ;; Delete char\n ((and (char? key) (char=? key #\\x))\n (buf-delete-char state)\n (refresh-line state out-port))\n ;; Delete to end\n ((and (char? key) (char=? key #\\D))\n (buf-kill-to-end state)\n (refresh-line state out-port))\n ;; Change to end\n ((and (char? key) (char=? key #\\C))\n (buf-kill-to-end state)\n (set! (line-state-vi-mode state) 'insert)\n (refresh-line state out-port))\n ;; History\n ((and (char? key) (char=? key #\\k))\n (history-prev state)\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\j))\n (history-next state)\n (refresh-line state out-port))\n ((eq? key 'up)\n (history-prev state)\n (refresh-line state out-port))\n ((eq? key 'down)\n (history-next state)\n (refresh-line state out-port))\n ;; Enter\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n (else #!void)))\n\n;;; --- Helpers ---\n\n(def (simple-split str)\n ;; Split string on whitespace\n (string-split-chars str #\\space))\n\n;;; --- Public interface ---\n\n;; Read a line of input with editing.\n;; prompt: string to display\n;; complete-fn: (lambda (line cursor) -> list-of-strings) or #f\n;; mode: 'emacs or 'vi\n;; Returns: string (the line), or 'eof\n(def (line-edit prompt\n (complete-fn #f)\n (mode 'emacs))\n (let ([in-port (current-input-port)]\n [out-port (current-error-port)])\n ;; If not a tty, just read a line\n (if (not (with-catch (lambda (e) #f)\n (lambda () (tty? in-port))))\n ;; Non-interactive: just read a line\n (begin\n (display prompt out-port)\n (force-output out-port)\n (let ([line (read-line in-port)])\n (if (eof-object? line) 'eof line)))\n ;; Interactive: use line editor\n (let* ([cols (detect-terminal-columns)]\n [pw (visible-width-last-line prompt)])\n (set-terminal-columns! cols)\n (let ([state (make-line-state\n \"\" ;; buffer\n 0 ;; cursor\n prompt ;; prompt\n pw ;; prompt-width\n (count-newlines prompt) ;; prompt-lines\n #f ;; history-index\n \"\" ;; saved-line\n (list) ;; kill-ring\n (list) ;; undo-stack\n #f ;; search-mode\n \"\" ;; search-string\n #f ;; search-result\n cols ;; columns\n #f ;; multiline?\n mode ;; mode\n 'insert ;; vi-mode\n complete-fn ;; complete-fn\n #f ;; done?\n #f)]) ;; result\n (dynamic-wind\n (lambda () (term-raw! in-port))\n (lambda ()\n ;; Ensure we're on a fresh line before showing prompt\n ;; If previous command didn't end with newline, this prevents bleed-over\n (display \"\\n\" out-port)\n (force-output out-port)\n ;; Show initial prompt\n (refresh-line state out-port)\n ;; Main editing loop\n (let loop ()\n (let ([key (read-key in-port)])\n (if (eq? key 'eof)\n (begin\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof)\n 'eof)\n (begin\n (if (eq? mode 'vi)\n (handle-vi-key state key out-port)\n (handle-emacs-key state key out-port))\n (if (line-state-done? state)\n (line-state-result state)\n (loop)))))))\n (lambda () (term-cooked! in-port))))))))\n\n;; Check if a port is a terminal\n(def (tty? port)\n (with-catch (lambda (e) #f)\n (lambda () (tty-mode-set! port #t #t #f #f 0) #t)))\n\n;; Calculate visible width (ignoring ANSI escapes)\n(def (visible-width str)\n (let ([len (string-length str)])\n (let loop ([i 0] [width 0] [in-escape? #f])\n (cond\n ((>= i len) width)\n ((and (not in-escape?)\n (char=? (string-ref str i) #\\escape))\n (loop (+ i 1) width #t))\n (in-escape?\n (if (char-alphabetic? (string-ref str i))\n (loop (+ i 1) width #f)\n (loop (+ i 1) width #t)))\n (else\n (loop (+ i 1) (+ width 1) #f))))))\n\n(def (visible-width-last-line str)\n ;; For multi-line prompts, return width of only the last line\n ;; Find the last newline and measure from there\n (let* ([len (string-length str)]\n [last-newline (let loop ([i (- len 1)])\n (cond\n ((< i 0) -1)\n ((char=? (string-ref str i) #\\newline) i)\n (else (loop (- i 1)))))]\n [start (+ last-newline 1)])\n ;; Calculate visible width from start to end\n (let loop ([i start] [width 0] [in-escape? #f])\n (cond\n ((>= i len) width)\n ((and (not in-escape?)\n (char=? (string-ref str i) #\\escape))\n (loop (+ i 1) width #t))\n (in-escape?\n (if (char-alphabetic? (string-ref str i))\n (loop (+ i 1) width #f)\n (loop (+ i 1) width #t)))\n (else\n (loop (+ i 1) (+ width 1) #f))))))\n\n(def (count-newlines str)\n ;; Count number of newline characters in string\n (let ([len (string-length str)])\n (let loop ([i 0] [count 0])\n (cond\n ((>= i len) count)\n ((char=? (string-ref str i) #\\newline)\n (loop (+ i 1) (+ count 1)))\n (else\n (loop (+ i 1) count))))))\n"} {"text":";; FILE: jerboa-shell/bench-smp.ss\n(import (jerboa prelude) (std misc thread))\n\n;; --- Timing ---\n\n(def (now-seconds)\n (/ (real-time) 1000.0))\n\n(def (fmt-secs s)\n (let ([ms (inexact->exact (round (* s 1000)))])\n (string-append (number->string ms) \"ms\")))\n\n(def (log! msg)\n (display msg (current-error-port))\n (force-output (current-error-port)))\n\n;; --- Benchmarks ---\n;; Pure-CPU benchmarks that parallelize well on SMP.\n;; Allocation-heavy benchmarks (hash, list, string) don't scale due to\n;; Gambit's stop-the-world GC, so we focus on compute-bound workloads.\n\n;; 1. Fibonacci — pure function calls\n(def (fib n)\n (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))\n\n;; 2. Ackermann — deep recursion + stack pressure\n(def (ack m n)\n (cond ((= m 0) (+ n 1))\n ((= n 0) (ack (- m 1) 1))\n (else (ack (- m 1) (ack m (- n 1))))))\n\n;; 3. Tak — Takeuchi function, another classic CPU benchmark\n(def (tak x y z)\n (if (<= x y) z\n (tak (tak (- x 1) y z)\n (tak (- y 1) z x)\n (tak (- z 1) x y))))\n\n;; 4. Sum of collatz sequence lengths — compute + branching\n(def (collatz-len n)\n (let loop ([n n] [len 0])\n (if (<= n 1) len\n (loop (if (even? n) (quotient n 2) (+ (* 3 n) 1))\n (+ len 1)))))\n\n(def (collatz-sum limit)\n (let loop ([i 1] [sum 0])\n (if (> i limit) sum\n (loop (+ i 1) (+ sum (collatz-len i))))))\n\n;; 5. Matrix multiply (vectors) — nested loops, arithmetic\n(def (matmul-bench size)\n (let ([a (make-vector (* size size) 1.0)]\n [b (make-vector (* size size) 2.0)]\n [c (make-vector (* size size) 0.0)])\n (let loopi ([i 0])\n (when (< i size)\n (let loopj ([j 0])\n (when (< j size)\n (let loopk ([k 0] [sum 0.0])\n (if (< k size)\n (loopk (+ k 1)\n (+ sum (* (vector-ref a (+ (* i size) k))\n (vector-ref b (+ (* k size) j)))))\n (vector-set! c (+ (* i size) j) sum)))\n (loopj (+ j 1))))\n (loopi (+ i 1))))\n (vector-ref c 0)))\n\n;; --- Runner ---\n\n(def num-cores 8)\n\n(def (run-benchmarks-smp)\n ;; Chez threads are real OS threads — no SMP bootstrap needed.\n (thread-sleep! 0.1)\n\n (log! (format \"\\n=== bench-smp (~a cores, ~a processors) ===\\n\"\n num-cores (cpu-count)))\n\n (let ([benchmarks\n (list\n (cons \"fib(38) \" (lambda () (fib 38)))\n (cons \"ack(3,10) \" (lambda () (ack 3 10)))\n (cons \"tak(30,20,10)\" (lambda () (tak 30 20 10)))\n (cons \"collatz 500k \" (lambda () (collatz-sum 500000)))\n (cons \"matmul 150 \" (lambda () (matmul-bench 150))))])\n\n ;; Sequential baseline: run each benchmark num-cores times\n (log! \"\\n--- sequential (8x each) ---\\n\")\n (let ([seq-times\n (map (lambda (b)\n (let ([start (now-seconds)])\n (let loop ([i 0])\n (when (< i num-cores)\n ((cdr b))\n (loop (+ i 1))))\n (let* ([end (now-seconds)]\n [wall (- end start)])\n (log! (format \" ~a ~a wall\\n\" (car b) (fmt-secs wall)))\n (cons (car b) wall))))\n benchmarks)])\n\n ;; Parallel: 8 threads simultaneously\n (log! \"\\n--- parallel (8 threads) ---\\n\")\n (let ([par-times\n (map (lambda (b)\n (let* ([start (now-seconds)]\n [threads (map (lambda (i)\n (thread-start!\n (make-thread (cdr b))))\n (iota num-cores))]\n [_ (for-each thread-join! threads)]\n [end (now-seconds)]\n [wall (- end start)])\n (log! (format \" ~a ~a wall\\n\" (car b) (fmt-secs wall)))\n (cons (car b) wall)))\n benchmarks)])\n\n ;; Summary\n (log! \"\\n--- speedup ---\\n\")\n (for-each\n (lambda (seq par)\n (let* ([s (cdr seq)]\n [p (cdr par)]\n [speedup (if (> p 0) (/ s p) 0.0)])\n (log! (format \" ~a ~ax\\n\" (car seq)\n (/ (round (* speedup 10)) 10.0)))))\n seq-times par-times))))\n\n (log! \"=== done ===\\n\"))\n\n;; Auto-run on load\n(run-benchmarks-smp)\n"} {"text":";; FILE: jerboa-shell/fzf.ss\n;;; fzf.ss — Interactive fuzzy finder TUI for gsh\n;;;\n;;; Full-screen terminal UI with live filtering, match highlighting,\n;;; and scrollable candidate list. Bottom-up layout like fzf.\n;;;\n;;; Usage:\n;;; (fzf-select candidates prompt: \"> \" multi?: #f)\n;;; Returns selected string, or #f on cancel.\n\n(export fzf-select\n fzf-history-search\n fzf-find-files\n fzf-find-directories\n fzf-init!\n collect-files\n collect-files-git\n collect-directories)\n(import :std/sugar\n :std/format\n :std/sort\n :std/srfi/1\n :jsh/util\n :jsh/fuzzy\n :jsh/lineedit ;; for read-key, term-raw!, term-cooked!, *fzf-*-fn* callbacks\n :jsh/ffi)\n\n;;;============================================================================\n;;; State\n;;;============================================================================\n\n(defstruct fzf-state\n (candidates ;; vector of all candidate strings\n filtered ;; list of (score . string) — current filtered results\n query ;; string: current search query\n cursor ;; integer: cursor position in query\n selected ;; integer: selected index in filtered list (0 = top visible)\n scroll-offset ;; integer: how many items scrolled past\n total ;; integer: total number of candidates\n match-count ;; integer: number of matching candidates\n height ;; integer: terminal rows available for candidates\n columns ;; integer: terminal width\n prompt ;; string: prompt string\n multi? ;; boolean: multi-select mode\n marked ;; list of strings: marked candidates (multi-select)\n done? ;; boolean: selection complete\n result) ;; string, list, or #f: final result\n transparent: #t)\n\n;;;============================================================================\n;;; ANSI escape helpers\n;;;============================================================================\n\n;; ESC-STR is imported from (jsh lineedit)\n\n(def (ansi-clear-screen port)\n (fprintf port \"~a[2J~a[H\" ESC-STR ESC-STR))\n\n(def (ansi-move-to row col port)\n (fprintf port \"~a[~a;~aH\" ESC-STR row col))\n\n(def (ansi-clear-line port)\n (fprintf port \"~a[2K\" ESC-STR))\n\n(def (ansi-bold port)\n (fprintf port \"~a[1m\" ESC-STR))\n\n(def (ansi-underline port)\n (fprintf port \"~a[4m\" ESC-STR))\n\n(def (ansi-fg-green port)\n (fprintf port \"~a[32m\" ESC-STR))\n\n(def (ansi-fg-yellow port)\n (fprintf port \"~a[33m\" ESC-STR))\n\n(def (ansi-fg-cyan port)\n (fprintf port \"~a[36m\" ESC-STR))\n\n(def (ansi-reset port)\n (fprintf port \"~a[0m\" ESC-STR))\n\n(def (ansi-hide-cursor port)\n (fprintf port \"~a[?25l\" ESC-STR))\n\n(def (ansi-show-cursor port)\n (fprintf port \"~a[?25h\" ESC-STR))\n\n(def (ansi-save-cursor port)\n (fprintf port \"~a7\" ESC-STR))\n\n(def (ansi-restore-cursor port)\n (fprintf port \"~a8\" ESC-STR))\n\n;; Enable alternate screen buffer (preserves main screen)\n(def (ansi-alt-screen-on port)\n (fprintf port \"~a[?1049h\" ESC-STR))\n\n(def (ansi-alt-screen-off port)\n (fprintf port \"~a[?1049l\" ESC-STR))\n\n;;;============================================================================\n;;; Terminal size\n;;;============================================================================\n\n(def (get-terminal-size)\n \"Returns (values rows cols).\"\n (let ((cols (ffi-terminal-columns 0)))\n (let ((rows (ffi-terminal-rows 0)))\n (values (if (or (not rows) (<= rows 0)) 24 rows)\n (if (or (not cols) (<= cols 0)) 80 cols)))))\n\n;;;============================================================================\n;;; Rendering\n;;;============================================================================\n\n(def (render-fzf state port)\n \"Render the full fzf interface.\"\n (let* ((height (fzf-state-height state))\n (cols (fzf-state-columns state))\n (filtered (fzf-state-filtered state))\n (query (fzf-state-query state))\n (selected (fzf-state-selected state))\n (scroll (fzf-state-scroll-offset state))\n (match-count (fzf-state-match-count state))\n (total (fzf-state-total state))\n (prompt-str (fzf-state-prompt state))\n (marked (fzf-state-marked state))\n ;; Reserve: 1 line for prompt, 1 line for status\n (avail-lines (- height 2))\n ;; Candidate window\n (visible (fzf-take (fzf-drop filtered scroll) avail-lines)))\n\n ;; Clear screen and draw from top\n (ansi-move-to 1 1 port)\n\n ;; Status line at top\n (ansi-clear-line port)\n (ansi-fg-cyan port)\n (fprintf port \" ~a/~a\" match-count total)\n (when (pair? marked)\n (fprintf port \" [~a selected]\" (length marked)))\n (ansi-reset port)\n (display \"\\r\\n\" port)\n\n ;; Candidate lines (top-down: best match at top)\n (let loop ((items visible) (idx 0))\n (when (< idx avail-lines)\n (ansi-clear-line port)\n (if (pair? items)\n (let* ((item (car items))\n (score (car item))\n (text (cdr item))\n (is-selected? (= idx selected))\n (is-marked? (member text marked)))\n ;; Indicator\n (if is-selected?\n (begin (ansi-fg-green port) (display \"> \" port) (ansi-reset port))\n (display \" \" port))\n ;; Mark indicator\n (when is-marked?\n (ansi-fg-yellow port)\n (display \"* \" port)\n (ansi-reset port))\n ;; Candidate text with match highlighting\n (render-highlighted-candidate text query is-selected? cols port)\n (display \"\\r\\n\" port))\n ;; Empty line\n (display \"\\r\\n\" port))\n (loop (if (pair? items) (cdr items) []) (+ idx 1))))\n\n ;; Prompt line at bottom\n (ansi-clear-line port)\n (ansi-fg-green port)\n (display prompt-str port)\n (ansi-reset port)\n (display query port)\n (force-output port)))\n\n(def (render-highlighted-candidate text query is-selected? cols port)\n \"Render a candidate with fuzzy-matched characters highlighted.\"\n (let* ((positions (if (> (string-length query) 0)\n (fuzzy-match-positions query text)\n []))\n (pos-set (list->hash-set positions))\n (max-width (- cols 4)) ;; account for prefix \" \" or \"> \"\n (display-len (min (string-length text) max-width)))\n (when is-selected?\n (ansi-bold port))\n (let loop ((i 0))\n (when (< i display-len)\n (let ((ch (string-ref text i)))\n (if (hash-get pos-set i)\n (begin\n (ansi-fg-green port)\n (ansi-underline port)\n (display ch port)\n (ansi-reset port)\n (when is-selected? (ansi-bold port)))\n (display ch port)))\n (loop (+ i 1))))\n (ansi-reset port)))\n\n(def (list->hash-set lst)\n \"Convert a list to a hash set for O(1) membership testing.\"\n (let ((ht (make-hash-table)))\n (for-each (lambda (x) (hash-put! ht x #t)) lst)\n ht))\n\n;;;============================================================================\n;;; Filtering\n;;;============================================================================\n\n(def (update-filter! state)\n \"Re-filter candidates based on current query.\"\n (let* ((query (fzf-state-query state))\n (candidates (fzf-state-candidates state))\n (len (vector-length candidates))\n (filtered (if (string=? query \"\")\n ;; No query: show all candidates in order\n (let loop ((i 0) (acc []))\n (if (>= i len) (reverse acc)\n (loop (+ i 1) (cons (cons 1 (vector-ref candidates i)) acc))))\n ;; Score and filter\n (let loop ((i 0) (acc []))\n (if (>= i len)\n (begin (sort! acc (lambda (a b) (> (car a) (car b)))) acc)\n (let* ((cand (vector-ref candidates i))\n (score (fzf-score query cand)))\n (loop (+ i 1)\n (if (> score 0)\n (cons (cons score cand) acc)\n acc))))))))\n (set! (fzf-state-filtered state) filtered)\n (set! (fzf-state-match-count state) (length filtered))\n ;; Always reset selection to top when query changes\n (set! (fzf-state-selected state) 0)\n (set! (fzf-state-scroll-offset state) 0)))\n\n;;;============================================================================\n;;; Input handling\n;;;============================================================================\n\n(def (handle-fzf-key state key)\n \"Handle a keypress in fzf mode. Returns #t if state changed.\"\n (let ((filtered (fzf-state-filtered state))\n (selected (fzf-state-selected state))\n (avail (- (fzf-state-height state) 2)))\n (cond\n ;; Enter / Ctrl-J: accept selection\n ((or (and (char? key) (or (= (char->integer key) 13)\n (= (char->integer key) 10)))\n (and (char? key) (= (char->integer key) 10))) ;; Ctrl-J\n (if (pair? filtered)\n (let ((item (fzf-list-ref filtered selected)))\n (if item\n (begin\n (set! (fzf-state-result state)\n (if (fzf-state-multi? state)\n (let ((marked (fzf-state-marked state)))\n (if (null? marked)\n (list (cdr item))\n marked))\n (cdr item)))\n (set! (fzf-state-done? state) #t))\n (set! (fzf-state-done? state) #t)))\n (begin\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t)))\n #t)\n\n ;; Ctrl-C / Escape: cancel\n ((or (and (char? key) (= (char->integer key) 3)) ;; Ctrl-C\n (eq? key 'escape))\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t)\n #t)\n\n ;; Up / Ctrl-P: move selection up (toward top of list)\n ((or (eq? key 'up)\n (and (char? key) (= (char->integer key) 16))) ;; Ctrl-P\n (when (> selected 0)\n (set! (fzf-state-selected state) (- selected 1))\n ;; Scroll if needed\n (when (< (fzf-state-selected state) (fzf-state-scroll-offset state))\n (set! (fzf-state-scroll-offset state) (fzf-state-selected state))))\n #t)\n\n ;; Down / Ctrl-N: move selection down\n ((or (eq? key 'down)\n (and (char? key) (= (char->integer key) 14))) ;; Ctrl-N\n (when (< selected (- (length filtered) 1))\n (set! (fzf-state-selected state) (+ selected 1))\n ;; Scroll if needed\n (when (>= (- (fzf-state-selected state) (fzf-state-scroll-offset state)) avail)\n (set! (fzf-state-scroll-offset state)\n (- (fzf-state-selected state) avail -1))))\n #t)\n\n ;; Tab: toggle mark (multi-select mode)\n ((and (char? key) (= (char->integer key) 9) (fzf-state-multi? state))\n (when (pair? filtered)\n (let* ((item (fzf-list-ref filtered selected))\n (text (and item (cdr item)))\n (marked (fzf-state-marked state)))\n (when text\n (if (member text marked)\n (set! (fzf-state-marked state)\n (filter (lambda (m) (not (string=? m text))) marked))\n (set! (fzf-state-marked state)\n (cons text marked))))))\n ;; Move down after marking\n (when (< selected (- (length filtered) 1))\n (set! (fzf-state-selected state) (+ selected 1)))\n #t)\n\n ;; Ctrl-U: clear query\n ((and (char? key) (= (char->integer key) 21))\n (set! (fzf-state-query state) \"\")\n (set! (fzf-state-cursor state) 0)\n (update-filter! state)\n #t)\n\n ;; Ctrl-W: delete word backward\n ((and (char? key) (= (char->integer key) 23))\n (let* ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (when (> pos 0)\n ;; Skip trailing spaces\n (let skip-sp ((i (- pos 1)))\n (let ((start (if (and (>= i 0) (char=? (string-ref query i) #\\space))\n (skip-sp (- i 1))\n (+ i 1))))\n ;; Skip word chars\n (let skip-word ((i (- start 1)))\n (let ((word-start (if (and (>= i 0)\n (not (char=? (string-ref query i) #\\space)))\n (skip-word (- i 1))\n (+ i 1))))\n (set! (fzf-state-query state)\n (string-append (substring query 0 word-start)\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) word-start)))))))\n (update-filter! state)\n #t)\n\n ;; Backspace: delete char before cursor\n ((and (char? key) (or (= (char->integer key) 127) (= (char->integer key) 8)))\n (let ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (when (> pos 0)\n (set! (fzf-state-query state)\n (string-append (substring query 0 (- pos 1))\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) (- pos 1))\n (update-filter! state)))\n #t)\n\n ;; Ctrl-A: beginning of query\n ((and (char? key) (= (char->integer key) 1))\n (set! (fzf-state-cursor state) 0)\n #t)\n\n ;; Ctrl-E: end of query\n ((and (char? key) (= (char->integer key) 5))\n (set! (fzf-state-cursor state) (string-length (fzf-state-query state)))\n #t)\n\n ;; Page-Up\n ((eq? key 'page-up)\n (set! (fzf-state-selected state) (max 0 (- selected avail)))\n (set! (fzf-state-scroll-offset state)\n (max 0 (- (fzf-state-scroll-offset state) avail)))\n #t)\n\n ;; Page-Down\n ((eq? key 'page-down)\n (let ((max-sel (- (length filtered) 1)))\n (set! (fzf-state-selected state) (min max-sel (+ selected avail)))\n (set! (fzf-state-scroll-offset state)\n (max 0 (- (fzf-state-selected state) avail -1))))\n #t)\n\n ;; Printable character: insert into query\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (let ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (set! (fzf-state-query state)\n (string-append (substring query 0 pos)\n (string key)\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) (+ pos 1))\n (update-filter! state))\n #t)\n\n (else #f))))\n\n;;;============================================================================\n;;; Helpers\n;;;============================================================================\n\n(def (fzf-take lst n)\n (if (or (null? lst) (<= n 0)) []\n (cons (car lst) (fzf-take (cdr lst) (- n 1)))))\n\n(def (fzf-drop lst n)\n (if (or (null? lst) (<= n 0)) lst\n (fzf-drop (cdr lst) (- n 1))))\n\n(def (fzf-list-ref lst idx)\n (if (or (null? lst) (< idx 0)) #f\n (if (= idx 0) (car lst)\n (fzf-list-ref (cdr lst) (- idx 1)))))\n\n;;;============================================================================\n;;; Public interface\n;;;============================================================================\n\n(def (fzf-select candidates\n prompt: (prompt \"> \")\n multi?: (multi? #f)\n initial-query: (initial-query \"\"))\n \"Run interactive fuzzy finder on a list of strings.\n Returns: selected string (single mode), list of strings (multi mode), or #f on cancel.\"\n (let ((in-port (current-input-port))\n (out-port (current-error-port)))\n (let-values (((rows cols) (get-terminal-size)))\n (let* ((cand-vec (list->vector candidates))\n (state (make-fzf-state\n cand-vec ;; candidates\n [] ;; filtered\n initial-query ;; query\n (string-length initial-query) ;; cursor\n 0 ;; selected\n 0 ;; scroll-offset\n (vector-length cand-vec) ;; total\n 0 ;; match-count\n rows ;; height\n cols ;; columns\n prompt ;; prompt\n multi? ;; multi?\n [] ;; marked\n #f ;; done?\n #f))) ;; result\n ;; Initial filter\n (update-filter! state)\n ;; Run TUI\n (dynamic-wind\n (lambda ()\n (term-raw! in-port)\n (ansi-alt-screen-on out-port)\n (ansi-hide-cursor out-port)\n (force-output out-port))\n (lambda ()\n (render-fzf state out-port)\n (let loop ()\n (let ((key (read-key in-port)))\n (cond\n ((eq? key 'eof)\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t))\n (else\n (handle-fzf-key state key)))\n (unless (fzf-state-done? state)\n (render-fzf state out-port)\n (loop))))\n (fzf-state-result state))\n (lambda ()\n (ansi-show-cursor out-port)\n (ansi-alt-screen-off out-port)\n (force-output out-port)\n (term-cooked! in-port)))))))\n\n;;;============================================================================\n;;; Convenience: history search via fzf\n;;;============================================================================\n\n(def (fzf-history-search history-commands)\n \"Run fzf on history commands (newest first). Returns selected command or #f.\"\n (fzf-select history-commands prompt: \"(history)> \"))\n\n;;;============================================================================\n;;; Convenience: file finder via fzf\n;;;============================================================================\n\n(def (fzf-find-files (dir \".\") (max-files 50000))\n \"Recursively list files under dir for fzf selection.\n Uses git ls-files in git repos, falls back to filesystem walk.\n Returns selected file path or #f.\"\n (let ((files (collect-files-git dir max-files)))\n (fzf-select files prompt: \"(files)> \")))\n\n(def (collect-files-git dir max-files)\n \"Collect files using git ls-files if in a git repo, else fall back to collect-files.\"\n (with-catch\n (lambda (e) (collect-files dir max-files))\n (lambda ()\n (let* ((proc (open-process (list path: \"git\"\n arguments: (list \"ls-files\" \"--cached\" \"--others\"\n \"--exclude-standard\")\n directory: dir\n stdin-redirection: #f\n stderr-redirection: #f)))\n (files (let loop ((acc []))\n (let ((line (read-line proc)))\n (if (or (eof-object? line) (>= (length acc) max-files))\n (reverse acc)\n (loop (cons line acc))))))\n (status (process-status proc)))\n (if (= status 0)\n files\n (collect-files dir max-files))))))\n\n(def *skip-dirs* '(\".git\" \"node_modules\" \"__pycache__\" \".jerboa\" \".cache\"\n \"venv\" \".venv\" \"target\" \"dist\" \".hg\" \".svn\"))\n\n(def (collect-files dir max-files)\n \"Recursively collect file paths under dir, up to max-files.\"\n (let ((result [])\n (count 0))\n (let walk ((d dir) (prefix \"\"))\n (when (< count max-files)\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let ((entries (directory-files d)))\n (for-each\n (lambda (name)\n (when (and (< count max-files)\n (not (string=? name \".\"))\n (not (string=? name \"..\"))\n ;; Skip hidden files/dirs at all levels\n (not (and (> (string-length name) 0)\n (char=? (string-ref name 0) #\\.)))\n ;; Skip known large directories\n (not (member name *skip-dirs*)))\n (let* ((rel (if (string=? prefix \"\")\n name\n (string-append prefix \"/\" name)))\n (full (string-append d \"/\" name)))\n (if (file-directory? full)\n (walk full rel)\n (begin\n (set! result (cons rel result))\n (set! count (+ count 1)))))))\n entries))))))\n (reverse result)))\n\n;;;============================================================================\n;;; Convenience: directory jump via fzf\n;;;============================================================================\n\n(def (fzf-find-directories (dir \".\") (max-dirs 10000))\n \"Recursively list directories under dir for fzf selection.\n Returns selected directory path or #f.\"\n (let ((dirs (collect-directories dir max-dirs)))\n (fzf-select dirs prompt: \"(dirs)> \")))\n\n(def (collect-directories dir max-dirs)\n \"Recursively collect directory paths under dir.\"\n (let ((result [])\n (count 0))\n (let walk ((d dir) (prefix \"\"))\n (when (< count max-dirs)\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let ((entries (directory-files d)))\n (for-each\n (lambda (name)\n (when (and (< count max-dirs)\n (not (string=? name \".\"))\n (not (string=? name \"..\"))\n ;; Skip hidden dirs at all levels\n (not (and (> (string-length name) 0)\n (char=? (string-ref name 0) #\\.)))\n ;; Skip known large directories\n (not (member name *skip-dirs*)))\n (let* ((rel (if (string=? prefix \"\")\n name\n (string-append prefix \"/\" name)))\n (full (string-append d \"/\" name)))\n (when (file-directory? full)\n (set! result (cons rel result))\n (set! count (+ count 1))\n (walk full rel)))))\n entries))))))\n (reverse result)))\n\n;;;============================================================================\n;;; Register fzf callbacks in lineedit\n;;;============================================================================\n\n(def (fzf-init!)\n \"Register fzf handlers as lineedit callbacks.\"\n (*fzf-history-fn* fzf-history-search)\n (*fzf-files-fn* fzf-find-files)\n (*fzf-dirs-fn* fzf-find-directories))\n"} -{"text":";; FILE: jerboa-shell/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It has legacy shell ancestry but is its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — colon-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from other Scheme implementations, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — non-Jerboa. No direct Chez equivalent\n\n#### Non-Jerboa Scheme-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — non-Jerboa. Use `(std misc process)` API in Jerboa\n- `user-info-home` — non-Jerboa. Use `(getenv \"HOME\")`\n- `the-environment` — non-Jerboa. Use `(interaction-environment)` in Chez\n- `condition/report-string` — non-Jerboa. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — non-Jerboa. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — non-Jerboa. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)`\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)`; use `path-join` for 2-arg\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)`\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/jerboa-orig` — Read-only legacy upstream reference. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port legacy Scheme code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port legacy Scheme**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-shell/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It has legacy shell ancestry but is its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — colon-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from other Scheme implementations, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — non-Jerboa. No direct Chez equivalent\n\n#### Non-Jerboa Scheme-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — non-Jerboa. Use `(std misc process)` API in Jerboa\n- `user-info-home` — non-Jerboa. Use `(getenv \"HOME\")`\n- `the-environment` — non-Jerboa. Use `(interaction-environment)` in Chez\n- `condition/report-string` — non-Jerboa. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — non-Jerboa. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — non-Jerboa. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)`\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)`; use `path-join` for 2-arg\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)`\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/jerboa-orig` — Read-only legacy upstream reference. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port legacy Scheme code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port legacy Scheme**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-shell/redirect.ss\n;;; redirect.ss — File descriptor redirection for gsh\n;;;\n;;; Key insight: external commands launched via open-process with\n;;; stdin/stdout/stderr-redirection: #f inherit REAL file descriptors (0,1,2),\n;;; not Gambit port parameters. So we must manipulate both:\n;;; 1. Real fds via ffi-dup/ffi-dup2/ffi-open-raw\n;;; 2. Gambit port parameters for builtins\n\n(export #t)\n(import :std/sugar\n :std/format\n :jsh/ast\n :jsh/ffi\n :jsh/environment\n :jsh/expander\n :jsh/util)\n\n;;; --- O_* flags for ffi-open-raw ---\n;;; Imported from :jsh/ffi — values are read from libc at runtime, not\n;;; hardcoded, since they differ between Linux/macOS/FreeBSD.\n\n;;; --- Saved state structure ---\n;;; Each entry: (fd saved-real-fd saved-port)\n;;; fd — which fd we redirected (0, 1, 2)\n;;; saved-real-fd — dup'd copy of the original real fd (for restore)\n;;; saved-port — original Gambit port parameter value (for restore)\n\n;;; --- Public interface ---\n\n;; M-4: cap file-creation mode at rw-r--r--. Bash passes #o666 to\n;; open(2) and lets umask do the rest; with a typical umask of 0022\n;; the result is #o644 in either case. Capping at #o644 means a\n;; loose umask (0000, 0002) cannot make a redirect target\n;; world-writable. POSIX/bash behaviour is preserved for every\n;; sane umask value.\n(def redir-default-mode #o644)\n\n;; M-6: when `set -o nofollow` is on, OR O_NOFOLLOW into the open\n;; flags so opening a symlink target fails with ELOOP. Protects\n;; against an attacker pre-placing a symlink at the redirect\n;; target (e.g. ln -s /etc/passwd /tmp/log before the victim runs\n;; \"echo data > /tmp/log\").\n(def (apply-redir-flags env base-flags)\n (if (env-option? env \"nofollow\")\n (bitwise-ior base-flags O_NOFOLLOW)\n base-flags))\n\n;; Apply a list of redirections, return saved state for restoration\n;; Saved state is a flat list of (fd saved-real-fd saved-port) entries\n(def (apply-redirections redirs env)\n (let loop ((redirs redirs) (saved []))\n (if (null? redirs)\n (let ((result (reverse saved)))\n ;; Track which fds are active redirects so ffi-fork-exec can preserve them\n (*active-redirect-fds*\n (append (map car result) (*active-redirect-fds*)))\n result)\n (let* ((redir (car redirs))\n (result (with-catch\n (lambda (e)\n ;; Redirect failed — restore already-applied redirections\n (restore-redirections (reverse saved))\n (raise e))\n (lambda ()\n (apply-single-redirect! redir env)))))\n (cond\n ((not result) (loop (cdr redirs) saved))\n ;; Multi-save: &> and &>> return a list of save entries\n ;; A save entry starts with an integer fd, a list-of-saves\n ;; starts with a list. Distinguish by checking (car result).\n ((integer? (car result))\n ;; Single save entry: (fd saved-real-fd saved-port)\n (loop (cdr redirs) (cons result saved)))\n (else\n ;; List of save entries: ((fd1 ...) (fd2 ...))\n (loop (cdr redirs) (append (reverse result) saved))))))))\n\n;; Restore redirections from saved state\n;; Each entry: (fd saved-real-fd saved-port) or (fd saved-real-fd saved-port new-port)\n(def (restore-redirections saved)\n ;; Remove these fds from the active-redirect tracking\n (let ((restored-fds (map car saved)))\n (*active-redirect-fds*\n (filter (lambda (fd) (not (member fd restored-fds)))\n (*active-redirect-fds*))))\n (for-each\n (lambda (entry)\n (let ((fd (car entry))\n (saved-real-fd (cadr entry))\n (saved-port (caddr entry))\n (new-port (and (> (length entry) 3) (cadddr entry))))\n ;; Flush and close any new port we created (before restoring fd)\n (when new-port\n (with-catch (lambda (e) #!void) (lambda () (force-output new-port)))\n (with-catch (lambda (e) #!void) (lambda () (close-port new-port))))\n ;; Restore the real fd\n (if (>= saved-real-fd 0)\n (begin\n (ffi-dup2 saved-real-fd fd)\n (ffi-close-fd saved-real-fd))\n ;; saved-real-fd is -1: fd wasn't open before, close it to restore\n ;; Only close non-standard fds (never close 0/1/2)\n (when (> fd 2)\n (ffi-close-fd fd)))\n ;; Restore the Gambit port parameter\n (when saved-port\n (case fd\n ((0) (current-input-port saved-port))\n ((1) (current-output-port saved-port))\n ((2) (current-error-port saved-port))))))\n (reverse saved)))\n\n;; Apply redirections permanently (for exec without command)\n;; Does not save original fds — changes are permanent\n(def (apply-redirections-permanent! redirs env)\n (for-each\n (lambda (redir) (apply-single-redirect-permanent! redir env))\n redirs))\n\n;;; --- Single redirection ---\n\n(def (expand-redir-target-nosplit target env)\n (if (word-process-sub? target)\n (expand-process-sub target env)\n (expand-word-nosplit target env)))\n\n(def (expand-redir-target target env)\n (if (word-process-sub? target)\n (list (expand-process-sub target env))\n (expand-word target env)))\n\n(def (apply-process-sub-input-redirect! fd psub env)\n (let ((exec-fn (*execute-input*)))\n (unless exec-fn\n (error #f \"process substitution unavailable during redirect\"))\n (let ((save (save-fd fd)))\n (let-values (((read-fd write-fd) (ffi-pipe-raw)))\n (let* ((thread-write-fd (ffi-dup write-fd))\n (cmd-text (word-process-sub-command psub))\n (th\n (spawn\n (lambda ()\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let* ((port-fd (ffi-dup thread-write-fd))\n (port (open-fd-output-port port-fd\n (buffer-mode block)\n (native-transcoder)))\n (sub-env (env-clone env)))\n (unwind-protect\n (parameterize ((*in-subshell* #t)\n (*pipeline-stdin-fd* #f)\n (*pipeline-stdout-fd* thread-write-fd))\n (parameterize ((current-output-port port))\n (exec-fn cmd-text sub-env)\n (force-output port)))\n (begin\n (with-catch (lambda (e) #!void)\n (lambda () (force-output port)))\n (with-catch (lambda (e) #!void)\n (lambda () (close-port port)))\n (with-catch (lambda (e) #!void)\n (lambda () (ffi-close-fd thread-write-fd))))))))))))\n (ffi-close-fd write-fd)\n (unless (= read-fd fd)\n (ffi-dup2 read-fd fd)\n (ffi-close-fd read-fd))\n (when (= fd 0)\n (current-input-port\n (transcoded-port\n (open-fd-input-port (ffi-dup fd) (buffer-mode block) #f)\n (make-transcoder (utf-8-codec)))))\n (*procsub-cleanups*\n (cons (lambda ()\n (with-catch (lambda (e) #!void)\n (lambda () (thread-join! th))))\n (*procsub-cleanups*)))\n save)))))\n\n(def (apply-single-redirect! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir)))\n ;; Named fd {varname}> handled separately (except {varname}>&- which is close)\n (if (and fd-var\n (not (and (memq op '(>& <&))\n (string=? (redir-target redir) \"-\"))))\n (apply-named-fd-redirect! redir env)\n ;; Normal redirect (or named fd close)\n (let* ((fd (cond\n ;; Named fd close: {varname}>&- — resolve variable\n (fd-var\n (let ((val (env-get env fd-var)))\n (or (and val (string->number val))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: Bad file descriptor~n\" fd-var)\n (error #f (string-append fd-var \": Bad file descriptor\"))))))\n ;; Explicit numeric fd\n ((redir-fd redir) => values)\n ;; Default fd for the operator\n (else (default-fd-for-op op)))))\n (if (and (eq? op '<)\n (word-process-sub? (redir-target redir))\n (eq? (word-process-sub-direction (redir-target redir)) 'in))\n (apply-process-sub-input-redirect! fd (redir-target redir) env)\n (let ((target-str (cond\n ((memq op '(<< <<- <<< <<q <<-q))\n ;; Heredocs/herestrings: expand but no word splitting validation\n (cond\n ((memq op '(<<q <<-q)) (redir-target redir))\n ((eq? op '<<<)\n (expand-redir-target-nosplit (redir-target redir) env))\n (else (expand-heredoc-body (redir-target redir) env))))\n ;; Fd dup targets (&> / <&): don't validate as file\n ((memq op '(>& <&))\n (expand-redir-target-nosplit (redir-target redir) env))\n (else\n ;; File redirect: validate target\n (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w))))))))\n (case op\n ;; < file — input from file\n ((<)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str O_RDONLY 0)\n ;; Create Gambit port for builtins\n (when (= fd 0)\n (current-input-port (open-input-file target-str)))\n save))\n ;; > file — output to file (truncate)\n ;;\n ;; noclobber semantics: refuse to overwrite an existing regular\n ;; file. The pre-2026 implementation did a separate file-regular?\n ;; check then opened with O_TRUNC, so a concurrent process could\n ;; create the file between the check and the open and we'd\n ;; obliterate it anyway. With O_CREAT|O_EXCL|O_WRONLY the kernel\n ;; atomically fails the open with EEXIST and there is no race.\n ;; Without noclobber we use the classic O_TRUNC which clobbers.\n ((>)\n (let* ((save (save-fd fd))\n (noclobber? (env-option? env \"noclobber\"))\n (flags (apply-redir-flags env\n (if noclobber?\n (bitwise-ior O_WRONLY O_CREAT O_EXCL)\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n (let ((raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n ;; POSIX noclobber applies only to regular files: > /dev/null and\n ;; other non-regular paths must succeed. If O_EXCL refused the open\n ;; and the path is a non-regular file, retry without O_EXCL.\n (when (and (< raw-fd 0) noclobber?)\n (let ((ftype (ffi-file-type target-str 1)))\n (when (and (> ftype 0) (not (= ftype 2)))\n (let ((retry-flags (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))))\n (set! raw-fd (ffi-open-raw target-str retry-flags redir-default-mode))))))\n (when (< raw-fd 0)\n (restore-single! save)\n (if noclobber?\n (fprintf (current-error-port)\n \"jsh: ~a: cannot overwrite existing file~n\" target-str)\n (fprintf (current-error-port)\n \"jsh: ~a: cannot open file~n\" target-str))\n (error #f\n (if noclobber? \"cannot overwrite existing file\" \"cannot open file\")\n target-str))\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd)))\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'truncate)))\n (append save (list new-port)))\n save)))\n ;; >> file — output to file (append)\n ((>>)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'append)))\n (append save (list new-port)))\n save)))\n ;; clobber (>|) — output to file ignoring noclobber\n ((clobber)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'truncate)))\n (append save (list new-port)))\n save)))\n ;; &> file — stdout+stderr to file\n ((&>)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n ;; stderr → same as stdout\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port))\n ;; Return both saves\n (list save1 save2)))\n ;; &>> file — stdout+stderr append\n ((&>>)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'append)))\n (current-output-port port)\n (current-error-port port))\n (list save1 save2)))\n ;; << heredoc — here-document\n ;;\n ;; We back the heredoc body with memfd_create (anonymous in-memory\n ;; file) rather than a pipe. The original pipe-based design wrote\n ;; the entire body to the pipe's write end before letting the\n ;; reader consume it — fine for short bodies, but the kernel pipe\n ;; buffer is 64 KiB on Linux and the writer is the same process\n ;; that's supposed to read it, so any body that fills the buffer\n ;; deadlocks. memfd has no such ceiling and ffi_memfd_create\n ;; already lseeks back to 0, so the consumer reads cleanly.\n ;; macOS / FreeBSD fall back to an anonymized mkstemp inside\n ;; ffi_memfd_create, so the same code path works everywhere.\n ((<< <<- <<q <<-q)\n (let ((save (save-fd fd)))\n (let ((mfd (ffi-memfd-create \"jsh-heredoc\" (string->utf8 target-str))))\n (when (< mfd 0)\n (error #f \"heredoc: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd)))\n (when (= fd 0)\n (current-input-port (open-input-string target-str)))\n save))\n ;; <<< word — here-string\n ((<<<)\n (let ((save (save-fd fd)))\n (let ((mfd (ffi-memfd-create \"jsh-herestring\"\n (string->utf8 (string-append target-str \"\\n\")))))\n (when (< mfd 0)\n (error #f \"here-string: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd)))\n (current-input-port (open-input-string (string-append target-str \"\\n\")))\n save))\n ;; >& n — dup fd (or close with >& -)\n ;; >& word — when word is not a number or -, redirect both stdout+stderr to file\n ((>&)\n (cond\n ((string=? target-str \"-\")\n ;; Close fd\n (let ((save (save-fd fd)))\n (ffi-close-fd fd)\n save))\n (else\n ;; Check for fd move: N- means dup N then close N\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (cond\n (target-fd\n (let ((save (save-fd fd)))\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (restore-single! save)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n ;; Close source fd if this is a move operation (N-)\n (when close-source?\n (ffi-close-fd target-fd))\n ;; Update Gambit port: if the source fd is not a standard\n ;; Gambit port (0/1/2), create a fresh port via /dev/fd/N\n ;; to avoid sendto-on-non-socket errors when Gambit cached\n ;; the fd type at startup. Track the new port in save for cleanup.\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; High fd → standard fd: try to create fresh Gambit port\n ;; If /dev/fd/N fails (e.g., socket), keep existing port\n (let ((new-port (make-port-for-fd fd)))\n (if new-port\n (begin\n (set-current-port-for-fd! fd new-port)\n (append save (list new-port)))\n save))\n ;; Standard fd → standard fd: copy existing Gambit port\n (begin (dup-gambit-port! target-fd fd)\n save)))))\n ;; Only treat as &> if fd was NOT explicitly specified\n ;; 1>&file → error (bad file descriptor)\n ;; >&file → equivalent to &>file\n ((redir-fd redir)\n (error #f (string-append target-str \": Bad file descriptor\")))\n (else\n ;; Not a number, no explicit fd → treat as &> (redirect stdout+stderr to file)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port))\n (list save1 save2)))))))))\n ;; <& n — dup fd for input\n ((<&)\n (cond\n ((string=? target-str \"-\")\n (let ((save (save-fd fd)))\n (ffi-close-fd fd)\n save))\n (else\n ;; Check for fd move: N- means dup N then close N\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (if target-fd\n (let ((save (save-fd fd)))\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (restore-single! save)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (if new-port\n (begin\n (set-current-port-for-fd! fd new-port)\n (append save (list new-port)))\n save))\n (begin (dup-gambit-port! target-fd fd)\n save))))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: bad file descriptor~n\" target-str)\n #f)))))))\n ;; <> file — open read-write on fd\n ;; For FIFOs, use O_NONBLOCK to avoid blocking, then clear it\n ((<>)\n (let ((save (save-fd fd)))\n ;; Open with O_NONBLOCK to prevent blocking on FIFO\n (let ((raw-fd (ffi-open-raw target-str (bitwise-ior O_RDWR O_NONBLOCK) redir-default-mode)))\n (when (< raw-fd 0)\n (restore-single! save)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Clear O_NONBLOCK flag after successful open\n (let ((flags (ffi-fcntl-getfl raw-fd)))\n (when (>= flags 0)\n (ffi-fcntl-setfl raw-fd (bitwise-and flags (bitwise-not O_NONBLOCK)))))\n ;; dup2 onto target fd and close original\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd)))\n save))\n (else\n (fprintf (current-error-port) \"jsh: unsupported redirect operator ~a~n\" op)\n #f))))))))\n\n;; Apply named fd redirect: {varname}>file — auto-allocate fd >= 10\n(def (apply-named-fd-redirect! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir))\n (target-str (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w)))))\n ;; Determine open flags based on operator\n (flags (apply-redir-flags env\n (case op\n ((<) O_RDONLY)\n ((>) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((>>) (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n ((clobber) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((<>) O_RDWR)\n (else (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n ;; Open the file to get a raw fd\n (raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Allocate fd >= 10, skipping any Gambit-internal fds\n ;; ffi-dup-above calls fcntl(F_DUPFD, min) which skips occupied fds\n (let ((high-fd (ffi-dup-above raw-fd 10)))\n (ffi-close-fd raw-fd)\n ;; Store the fd number in the variable\n (env-set! env fd-var (number->string high-fd))\n ;; Named fds stay open after the command (bash behavior).\n ;; They are only closed explicitly with {varname}>&-\n ;; Return #f so apply-redirections doesn't track this for restore.\n #f)))\n\n;; Apply a single redirect permanently (for exec)\n;; Same logic but no save/restore\n(def (apply-single-redirect-permanent! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir)))\n ;; Named fd {varname}> handled separately (except close)\n (if (and fd-var\n (not (and (memq op '(>& <&))\n (string=? (redir-target redir) \"-\"))))\n (apply-named-fd-redirect-permanent! redir env)\n (let* ((fd (cond\n (fd-var\n (let ((val (env-get env fd-var)))\n (or (and val (string->number val))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: Bad file descriptor~n\" fd-var)\n (error #f (string-append fd-var \": Bad file descriptor\"))))))\n ((redir-fd redir) => values)\n (else (default-fd-for-op op))))\n (target-str (cond\n ((memq op '(<< <<- <<< <<q <<-q))\n (cond\n ((memq op '(<<q <<-q)) (redir-target redir))\n ((eq? op '<<<)\n (expand-redir-target-nosplit (redir-target redir) env))\n (else (expand-heredoc-body (redir-target redir) env))))\n ((memq op '(>& <&))\n (expand-redir-target-nosplit (redir-target redir) env))\n (else\n (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w))))))))\n (case op\n ((<) (redirect-fd-to-file! fd target-str O_RDONLY 0)\n (when (= fd 0)\n (current-input-port (open-input-file target-str))))\n ((>) (let* ((noclobber? (env-option? env \"noclobber\"))\n (flags (apply-redir-flags env\n (if noclobber?\n (bitwise-ior O_WRONLY O_CREAT O_EXCL)\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n ;; noclobber: O_EXCL atomically refuses if the file exists.\n ;; Retry without O_EXCL if target is a non-regular file (POSIX:\n ;; noclobber applies only to regular files, so > /dev/null etc.\n ;; must succeed).\n (if (and noclobber?\n (let ((ftype (ffi-file-type target-str 1)))\n (and (> ftype 0) (not (= ftype 2)))))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (redirect-fd-to-file! fd target-str flags redir-default-mode)))\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'truncate)))\n ((>>) (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'append)))\n ((clobber) (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'truncate)))\n ((&>) (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port)))\n ((&>>) (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'append)))\n (current-output-port port)\n (current-error-port port)))\n ((>&)\n (cond\n ((string=? target-str \"-\")\n (ffi-close-fd fd))\n (else\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (cond\n (target-fd\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (when new-port\n (set-current-port-for-fd! fd new-port)))\n (dup-gambit-port! target-fd fd))))\n ((redir-fd redir)\n (error #f (string-append target-str \": Bad file descriptor\")))\n (else\n ;; >&word → redirect both stdout+stderr to file\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port)))))))))\n ((<&)\n (cond\n ((string=? target-str \"-\")\n (ffi-close-fd fd))\n (else\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (if target-fd\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (when new-port\n (set-current-port-for-fd! fd new-port)))\n (dup-gambit-port! target-fd fd)))\n (fprintf (current-error-port) \"jsh: ~a: bad file descriptor~n\" target-str)))))))\n ;; <> file — open read-write (permanent)\n ;; For FIFOs, use O_NONBLOCK to avoid blocking, then clear it\n ((<>)\n ;; Open with O_NONBLOCK to prevent blocking on FIFO\n (let ((raw-fd (ffi-open-raw target-str (bitwise-ior O_RDWR O_NONBLOCK) redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Clear O_NONBLOCK flag after successful open\n (let ((flags (ffi-fcntl-getfl raw-fd)))\n (when (>= flags 0)\n (ffi-fcntl-setfl raw-fd (bitwise-and flags (bitwise-not O_NONBLOCK)))))\n ;; dup2 onto target fd and close original\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd))))\n ;; << heredoc (permanent) — same memfd approach as the saved-fd\n ;; version above; avoids pipe-buffer deadlock on bodies >64 KiB.\n ((<< <<- <<q <<-q)\n (let ((mfd (ffi-memfd-create \"jsh-heredoc\" (string->utf8 target-str))))\n (when (< mfd 0)\n (error #f \"heredoc: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd))\n (when (= fd 0)\n (current-input-port (open-input-string target-str)))))\n ;; <<< here-string (permanent)\n ((<<<)\n (let ((mfd (ffi-memfd-create \"jsh-herestring\"\n (string->utf8 (string-append target-str \"\\n\")))))\n (when (< mfd 0)\n (error #f \"here-string: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd))\n (current-input-port (open-input-string (string-append target-str \"\\n\")))))\n (else (fprintf (current-error-port) \"jsh: unsupported redirect operator ~a~n\" op)))))))\n\n;; Apply named fd redirect permanently: {varname}>file\n(def (apply-named-fd-redirect-permanent! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir))\n (target-str (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w)))))\n (flags (apply-redir-flags env\n (case op\n ((<) O_RDONLY)\n ((>) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((>>) (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n ((clobber) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((<>) O_RDWR)\n (else (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n (raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n (let ((high-fd (ffi-dup-above raw-fd 10)))\n (ffi-close-fd raw-fd)\n (env-set! env fd-var (number->string high-fd)))))\n\n;;; --- Helpers ---\n\n(def (default-fd-for-op op)\n (case op\n ((< << <<- <<q <<-q <<< <& <>) 0)\n ((> >> clobber >& &> &>>) 1)\n (else 0)))\n\n;; Minimum fd for save-fd — must be above any user-visible fd range\n;; Named fds start at 10, bash tests use up to ~100, Gambit internal ~255\n(def SAVE-FD-MIN 200)\n\n;; Save the real fd + Gambit port for later restoration\n;; Returns (fd saved-real-fd saved-port)\n;; Uses ffi-dup-above to save to fd >= SAVE-FD-MIN\n(def (save-fd fd)\n (let ((saved-real-fd (ffi-dup-above fd SAVE-FD-MIN))\n (saved-port (case fd\n ((0) (current-input-port))\n ((1) (current-output-port))\n ((2) (current-error-port))\n (else #f))))\n (list fd saved-real-fd saved-port)))\n\n;; Restore a single save entry\n(def (restore-single! save)\n (let ((fd (car save))\n (saved-real-fd (cadr save))\n (saved-port (caddr save)))\n (when (>= saved-real-fd 0)\n (ffi-dup2 saved-real-fd fd)\n (ffi-close-fd saved-real-fd))\n (when saved-port\n (case fd\n ((0) (current-input-port saved-port))\n ((1) (current-output-port saved-port))\n ((2) (current-error-port saved-port))))))\n\n;; Open a file and dup2 onto target fd\n(def (redirect-fd-to-file! fd filename flags mode)\n (let ((raw-fd (ffi-open-raw filename flags mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" filename)\n (error #f \"cannot open file\" filename))\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd))))\n\n;; Set Gambit port parameter for an output fd. Returns the new port.\n;; Opens the file directly to create a character port for builtins.\n;; Note: this creates an independent file description with its own offset.\n;; External commands writing to fd 1 may have a different offset — the caller\n;; must sync offsets before forking (see execute-external's ffi-lseek-end).\n(def (set-port-for-fd! fd filename mode)\n (let ((port (case mode\n ((truncate) (open-output-file filename 'truncate))\n ((append) (open-output-file filename 'append)))))\n (case fd\n ((1) (current-output-port port))\n ((2) (current-error-port port)))\n port))\n\n;; Create a fresh Gambit port for a standard fd (0/1/2) after dup2\n;; Uses /dev/fd/N so Gambit creates a proper port with write() not sendto()\n;; Returns #f if /dev/fd/N cannot be opened (e.g., fd points to a socket)\n(def (make-port-for-fd fd)\n (with-catch\n (lambda (e) #f) ;; Return #f if open fails (e.g., socket, ENXIO)\n (lambda ()\n (case fd\n ((0) (open-input-file (string-append \"/dev/fd/\" (number->string fd))))\n ((1 2) (open-output-file (string-append \"/dev/fd/\" (number->string fd))\n 'append))))))\n\n;; Set current-input/output/error-port for a standard fd\n(def (set-current-port-for-fd! fd port)\n (case fd\n ((0) (current-input-port port))\n ((1) (current-output-port port))\n ((2) (current-error-port port))))\n\n;; Duplicate Gambit port from source-fd to dest-fd\n(def (dup-gambit-port! source-fd dest-fd)\n (let ((source-port (case source-fd\n ((0) (current-input-port))\n ((1) (current-output-port))\n ((2) (current-error-port))\n (else #f))))\n (when source-port\n (case dest-fd\n ((0) (current-input-port source-port))\n ((1) (current-output-port source-port))\n ((2) (current-error-port source-port))))))\n\n;; Convert redirections to open-process settings (kept for compatibility)\n(def (redirections->process-settings redirs env)\n ;; With real fd redirection, we always use #f for stdin/stdout/stderr-redirection\n ;; to let the child inherit real fds. This function is kept for cases\n ;; where we need to know if redirections exist.\n [])\n"} {"text":";; FILE: jerboa-shell/registry.ss\n;;; registry.ss — Built-in command registry for jsh\n;;;\n;;; Separated from builtins.ss to avoid circular dependency with macros.ss\n\n(export #t)\n(import :std/sort)\n\n;;; --- Build tier ---\n;; Set by stage.ss at module init time. Controls feature availability.\n;; Values: \"tiny\" (shell only), \"small\" (+eval), \"medium\" (+compiler), \"large\" (+coreutils)\n(def *jsh-tier* (make-parameter \"tiny\"))\n\n;;; --- Built-in registry ---\n\n(def *builtins* (make-hash-table))\n\n;; Register a built-in command\n(def (builtin-register! name handler)\n (hash-put! *builtins* name handler))\n\n;; Look up a built-in by name\n(def (builtin-lookup name)\n (hash-get *builtins* name))\n\n;; List all built-in names\n(def (builtin-list)\n (sort! (hash-keys *builtins*) string<?))\n\n;; Check if a name is a built-in\n(def (builtin? name)\n (and (builtin-lookup name) #t))\n\n;;; --- Programmable completion registry ---\n\n(def *complete-specs* (make-hash-table))\n\n(def (complete-register! command spec)\n (hash-put! *complete-specs* command spec))\n\n(def (complete-unregister! command)\n (hash-remove! *complete-specs* command))\n\n(def (complete-get-spec command)\n (hash-get *complete-specs* command))\n\n(def (complete-list-specs)\n (sort! (hash-keys *complete-specs*) string<?))\n\n;;; --- Meta-command registry (,commands) ---\n;;; Packages register handlers here at module load time.\n;;; Handler signature: (lambda (args-string) => (cons output-string exit-code))\n;;; Completion handler signature:\n;;; (lambda (current-word words word-index line cursor env) => list-of-strings)\n\n(def *meta-commands* (make-hash-table))\n(def *meta-complete-handlers* (make-hash-table))\n\n(def (meta-register! name handler description)\n (hash-put! *meta-commands* name (cons handler description)))\n\n(def (meta-complete-register! name handler)\n (hash-put! *meta-complete-handlers* name handler))\n\n(def (meta-lookup name)\n (let ([entry (hash-get *meta-commands* name)])\n (and entry (car entry))))\n\n(def (meta-complete-lookup name)\n (hash-get *meta-complete-handlers* name))\n\n(def (meta-list)\n (sort! (hash-keys *meta-commands*) string<?))\n\n(def (meta-description name)\n (let ([entry (hash-get *meta-commands* name)])\n (if entry (cdr entry) \"\")))\n"} {"text":";; FILE: jerboa-shell/util.ss\n;;; util.ss — Shared utilities for gsh\n\n(export #t file-regular? file-directory?)\n(import (except-in :std/misc/string string-join string-index string-contains)\n (prefix (std misc string) std-string:)\n (except-in :std/misc/path path-normalize)\n ./pregexp-compat\n :std/format\n :std/sugar\n :std/iter\n (except-in :std/error error-message error-irritants error-trace)\n :jsh/ffi)\n\n;;; --- open-process string encoding ---\n\n;; Encode a Scheme string to C-safe Latin-1 for Gambit's open-process.\n;; Gambit can't convert chars > 127 to C char-strings.\n;; Converts unicode chars to their UTF-8 byte representation as Latin-1 chars.\n(def (string->c-safe s)\n (let ((len (string-length s)))\n (let check ((i 0))\n (cond ((>= i len) s)\n ((< (char->integer (string-ref s i)) 128) (check (+ i 1)))\n (else\n (let* ((u8 (string->bytes s))\n (u8len (u8vector-length u8))\n (out (make-string u8len)))\n (let loop ((j 0))\n (if (>= j u8len) out\n (begin (string-set! out j (integer->char (u8vector-ref u8 j)))\n (loop (+ j 1)))))))))))\n\n;;; --- waitpid status decoders (shell-level) ---\n\n;; Decode raw waitpid status to a shell exit code (0-255)\n(def (status->exit-code raw-status)\n (cond\n ((WIFEXITED raw-status)\n (WEXITSTATUS raw-status))\n ((WIFSIGNALED raw-status)\n (+ 128 (WTERMSIG raw-status)))\n ((WIFSTOPPED raw-status)\n (+ 128 (WSTOPSIG raw-status)))\n (else 255)))\n\n;;; --- Process launching ---\n\n;; Launch an external command via open-process, ensuring SIGPIPE is\n;; unblocked for the child. Gambit blocks SIGPIPE (sigprocmask),\n;; which children inherit through fork+exec, causing commands like\n;; cat to get EPIPE (exit 1) instead of being killed by SIGPIPE (exit 141).\n(def (open-process-with-sigpipe settings)\n (ffi-sigpipe-unblock)\n (let ((proc (open-process settings)))\n (ffi-sigpipe-block)\n proc))\n\n;;; --- SOH packing for ffi-execve / ffi-fork-exec ---\n\n;; Pack a list of strings with SOH (char 1) delimiter\n(def *soh* (make-string 1 (integer->char 1)))\n(def (pack-with-soh strs)\n (if (null? strs) \"\"\n (call-with-output-string\n (lambda (port)\n (display (car strs) port)\n (for-each (lambda (s)\n (display *soh* port)\n (display s port))\n (cdr strs))))))\n\n;; Pack a list of integers as SOH-delimited string of their decimal representations\n(def (pack-fds-with-soh fds)\n (pack-with-soh (map number->string fds)))\n\n;;; --- String utilities ---\n\n(def (string-trim-whitespace str)\n (let* ((len (string-length str))\n (start (let loop ((i 0))\n (if (and (< i len) (char-whitespace? (string-ref str i)))\n (loop (+ i 1)) i)))\n (end (let loop ((i (- len 1)))\n (if (and (>= i start) (char-whitespace? (string-ref str i)))\n (loop (- i 1)) (+ i 1)))))\n (substring str start end)))\n\n;; Split string by any character in charset (a string of delimiters)\n(def (string-split-chars str charset)\n (let loop ((i 0) (start 0) (result []))\n (cond\n ((>= i (string-length str))\n (reverse (if (> i start)\n (cons (substring str start i) result)\n result)))\n ((string-index charset (string-ref str i))\n (loop (+ i 1) (+ i 1)\n (if (> i start)\n (cons (substring str start i) result)\n result)))\n (else\n (loop (+ i 1) start result)))))\n\n;; Check if char is in string\n(def (string-index str ch)\n (let loop ((i 0))\n (cond\n ((>= i (string-length str)) #f)\n ((char=? (string-ref str i) ch) i)\n (else (loop (+ i 1))))))\n\n;; Substring test\n(def (string-contains? haystack needle)\n (and (std-string:string-contains haystack needle) #t))\n\n;; Join strings with separator.\n(def (string-join lst sep)\n (std-string:string-join lst sep))\n\n;; Find last occurrence of character in string\n(def (string-last-index-of str ch)\n (let loop ((i (- (string-length str) 1)))\n (cond\n ((< i 0) #f)\n ((char=? (string-ref str i) ch) i)\n (else (loop (- i 1))))))\n\n;;; --- Path / filesystem utilities ---\n\n;; Search PATH for an executable, return full path or #f\n(def (which name)\n (if (string-contains? name \"/\")\n ;; Absolute or relative path — resolve to absolute for the executability\n ;; check (ffi-access needs absolute path since Gambit's current-directory\n ;; doesn't match OS cwd), but return original name for display\n (let ((resolved (path-expand name)))\n (and (file-exists? resolved) (executable? resolved) name))\n ;; Search PATH\n (let ((path-dirs (string-split-chars (or (getenv \"PATH\" #f) \"/usr/bin:/bin\") \":\")))\n (let loop ((dirs path-dirs))\n (if (null? dirs) #f\n (let ((full (string-append (car dirs) \"/\" name)))\n (if (and (file-exists? full) (executable? full))\n full\n (loop (cdr dirs)))))))))\n\n;; Search PATH for a regular file (not directory), no execute requirement\n;; Used by source/. to find files to source\n;; Optional path-str parameter overrides getenv lookup (for temp env assignments)\n(def (find-file-in-path name (path-str #f))\n (let ((path-dirs (string-split-chars (or path-str (getenv \"PATH\" #f) \"/usr/bin:/bin\") \":\")))\n (let loop ((dirs path-dirs))\n (if (null? dirs) #f\n (let ((full (string-append (car dirs) \"/\" name)))\n (if (and (file-exists? full)\n (not (file-directory? full)))\n full\n (loop (cdr dirs))))))))\n\n;; Check if file is executable (by current user)\n(def (executable? path)\n (and (not (file-directory? path))\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 1) 0))))) ;; X_OK = 1\n\n;; Return home directory\n(def (home-directory)\n (or (getenv \"HOME\" #f)\n (with-catch\n (lambda (e) \"/\")\n (lambda () (user-info-home (user-info (user-name)))))))\n\n;; Expand ~ and ~user at the start of a path\n(def (expand-tilde path)\n (cond\n ((string=? path \"~\") (home-directory))\n ((and (> (string-length path) 1)\n (char=? (string-ref path 0) #\\~)\n (char=? (string-ref path 1) #\\/))\n (string-append (home-directory) (substring path 1 (string-length path))))\n ((and (> (string-length path) 1)\n (char=? (string-ref path 0) #\\~))\n ;; ~user form\n (let* ((slash-pos (string-index path #\\/))\n (username (if slash-pos\n (substring path 1 slash-pos)\n (substring path 1 (string-length path)))))\n (with-catch\n (lambda (e) path) ;; return as-is if user not found\n (lambda ()\n (let ((home (user-info-home (user-info username))))\n (if slash-pos\n (string-append home (substring path slash-pos (string-length path)))\n home))))))\n (else path)))\n\n;; Read all lines from a file\n(def (read-file-lines path)\n (if (file-exists? path)\n (call-with-input-file path\n (lambda (port)\n (let loop ((lines []))\n (let ((line (read-line port)))\n (if (eof-object? line)\n (reverse lines)\n (loop (cons line lines)))))))\n []))\n\n;;; --- Exception utilities ---\n\n;; Extract a message string from any exception.\n;; Chez-native: uses condition predicates instead of Gambit's error-exception?.\n(def (exception-message e)\n (define (format-condition c)\n (let ([msg (call-with-string-output-port\n (lambda (p) (display-condition c p)))])\n ;; display-condition prefixes with \"Exception: \" or \"Exception in WHO: \" —\n ;; strip those so callers get just the message text.\n (cond\n [(and (> (string-length msg) 11)\n (string=? (substring msg 0 11) \"Exception: \"))\n (substring msg 11 (string-length msg))]\n [(and (> (string-length msg) 13)\n (string=? (substring msg 0 13) \"Exception in \"))\n (let loop ([i 13])\n (cond\n [(>= (+ i 1) (string-length msg)) msg]\n [(and (char=? (string-ref msg i) #\\:)\n (char=? (string-ref msg (+ i 1)) #\\space))\n (substring msg (+ i 2) (string-length msg))]\n [else (loop (+ i 1))]))]\n [else msg])))\n (cond\n [(string? e) e]\n [(condition? e) (format-condition e)]\n [else (call-with-string-output-port\n (lambda (p) (display e p)))]))\n\n;; Run thunk, return result or #f on exception\n(def (try-or-false thunk)\n (with-catch (lambda (e) #f) thunk))\n\n;;; --- Misc ---\n\n;; Safe substring that doesn't error on out-of-bounds\n(def (safe-substring str start end)\n (let ((len (string-length str)))\n (substring str (min start len) (min end len))))\n\n;; Repeat a character n times\n(def (make-string-repeated ch n)\n (make-string n ch))\n\n;; Check if a string is a valid shell name (variable name)\n(def (valid-name? str)\n (and (> (string-length str) 0)\n (let ((ch (string-ref str 0)))\n (or (char-alphabetic? ch) (char=? ch #\\_)))\n (let loop ((i 1))\n (or (>= i (string-length str))\n (let ((ch (string-ref str i)))\n (and (or (char-alphabetic? ch) (char-numeric? ch) (char=? ch #\\_))\n (loop (+ i 1))))))))\n\n;; Check if string is a valid integer\n(def (string->integer str)\n (with-catch\n (lambda (e) #f)\n (lambda ()\n (let ((n (string->number str)))\n (and (integer? n) (exact? n) n)))))\n\n(def (string-upcase str)\n (list->string (map char-upcase (string->list str))))\n\n(def (string-downcase str)\n (list->string (map char-downcase (string->list str))))\n\n;; Check if a string contains control characters (chars < 0x20 or 0x7f)\n(def (string-has-control-chars? s)\n (let ((len (string-length s)))\n (let loop ((i 0))\n (if (>= i len) #f\n (let ((c (char->integer (string-ref s i))))\n (if (or (< c #x20) (= c #x7f))\n #t\n (loop (+ i 1))))))))\n\n(def (hex-char? ch)\n (or (and (char>=? ch #\\0) (char<=? ch #\\9))\n (and (char>=? ch #\\a) (char<=? ch #\\f))\n (and (char>=? ch #\\A) (char<=? ch #\\F))))\n\n;; Count UTF-8 code points in a string.\n;; If the string contains actual unicode chars (char-integer > 127),\n;; string-length is already correct. But if it contains raw bytes\n;; from command substitution (Latin-1 encoding), we need to count\n;; UTF-8 sequences by examining lead bytes.\n(def (utf8-string-length str)\n (let ((len (string-length str)))\n ;; Check if string has any chars > 127 (raw bytes from ffi-read-all)\n (let check ((i 0))\n (if (>= i len)\n ;; All chars <= 127 — pure ASCII, string-length is correct\n len\n (let ((c (char->integer (string-ref str i))))\n (if (> c 127)\n ;; Contains high bytes — count UTF-8 sequences\n (utf8-count-codepoints str len)\n (check (+ i 1))))))))\n\n;; Count UTF-8 code points by examining lead bytes\n(def (utf8-count-codepoints str len)\n (let loop ((i 0) (count 0))\n (if (>= i len)\n count\n (let ((b (char->integer (string-ref str i))))\n (cond\n ((< b #x80) (loop (+ i 1) (+ count 1))) ;; ASCII\n ((< b #xC0) (loop (+ i 1) count)) ;; continuation byte\n ((< b #xE0) (loop (+ i 1) (+ count 1))) ;; 2-byte lead\n ((< b #xF0) (loop (+ i 1) (+ count 1))) ;; 3-byte lead\n (else (loop (+ i 1) (+ count 1))))))))\n\n;; Count UTF-8 byte length of a Gambit Unicode string\n(def (utf8-byte-count str)\n (let ((len (string-length str)))\n (let loop ((i 0) (bytes 0))\n (if (>= i len) bytes\n (let ((cp (char->integer (string-ref str i))))\n (loop (+ i 1) (+ bytes (cond ((< cp #x80) 1)\n ((< cp #x800) 2)\n ((< cp #x10000) 3)\n (else 4)))))))))\n\n;;; --- File test helpers (for refactored builtins) ---\n\n;; Test if path is a symbolic link (don't follow symlinks)\n(def (file-symlink? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (eq? (file-info-type (file-info path #f)) 'symbolic-link))))\n\n;; Test if path exists and is non-empty\n(def (file-nonempty? path)\n (and (file-exists? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (> (file-info-size (file-info path)) 0)))))\n\n;; Test if path is readable\n(def (file-readable? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 4) 0)))) ;; R_OK = 4\n\n;; Test if path is writable\n(def (file-writable? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 2) 0)))) ;; W_OK = 2\n\n;; Note: file-executable? is already defined above as executable?\n\n;;; --- Raw byte encoding for $'...' byte escapes ---\n;;\n;; Jerboa strings are Unicode. Byte values 128-255 from $'\\NNN' and $'\\xNN'\n;; would be UTF-8 encoded on output (2 bytes instead of 1). We use Unicode\n;; Private Use Area (U+E000-U+E0FF) to mark these as raw bytes. Output\n;; functions detect PUA chars and write single bytes via write-u8.\n\n(def raw-byte-base #xE000)\n\n;; Encode a byte value (0-255) as a PUA character for raw byte output.\n;; Values < 128 are returned as-is since UTF-8 encoding matches raw byte.\n(def (byte->raw-char val)\n (if (>= val #x80)\n (integer->char (+ raw-byte-base val))\n (integer->char val)))\n\n;; Check if a character is a PUA raw byte marker\n(def (raw-byte-char? ch)\n (let ((code (char->integer ch)))\n (and (>= code raw-byte-base) (<= code (+ raw-byte-base #xFF)))))\n\n;; Display a shell string, converting PUA raw byte markers to actual bytes.\n;; Fast path: if no PUA chars, use regular display.\n(def (shell-display str)\n (let ((len (string-length str)))\n (let scan ((i 0))\n (cond\n ((>= i len) (display str)) ;; no PUA chars found, fast path\n ((raw-byte-char? (string-ref str i))\n ;; Found PUA char, use slow path for whole string\n (shell-display-raw str))\n (else (scan (+ i 1)))))))\n\n;; Slow path: display string with PUA chars converted to raw bytes\n(def (shell-display-raw str)\n (let ((len (string-length str)))\n (let loop ((i 0))\n (when (< i len)\n (let* ((ch (string-ref str i))\n (code (char->integer ch)))\n (if (and (>= code raw-byte-base) (<= code (+ raw-byte-base #xFF)))\n (begin\n (force-output)\n (write-u8 (- code raw-byte-base))\n (force-output))\n (display ch)))\n (loop (+ i 1))))))\n"} @@ -2324,7 +2324,7 @@ {"text":";; FILE: jerboa-shell/.jerboa/security.json\n{\n \"version\": 1,\n \"repo\": \"jerboa-shell\",\n \"extends\": [\"jerboa:cli\", \"jerboa:ffi\", \"jerboa:parser\", \"jerboa:generated-heavy\"],\n \"paths\": {\n \"production\": [\"*.ss\", \"*.sls\", \"lib/**/*.ss\", \"lib/**/*.sls\", \"src/**/*.{ss,sls,c,h,rs}\", \"support/**\", \"ffi-shim.c\", \"Makefile\"],\n \"tests\": [\"test/**\", \"tests/**\", \"**/*-test.ss\", \"fixtures/**\"],\n \"generated\": [\"build/**\", \"dist/**\", \"target/**\", \"_tmp/**\", \"jsh-generated.ss\", \"jsh-macos\", \"*.sha256\", \"*.so\", \"*.dylib\", \"*.wpo\"],\n \"vendor\": [\"vendor/**\", \"third_party/**\", \"oils/**\"],\n \"docs\": [\"README.md\", \"docs/**\", \"*.md\", \"AGENTS.md\"]\n },\n \"policy\": {\n \"failOn\": [\"critical\", \"high\"],\n \"imports\": { \"directChezscheme\": \"allow-in-ffi-boundaries\" },\n \"ffi\": { \"allowed\": true, \"requireCloseOnExec\": true, \"requireDynamicWindCleanup\": true },\n \"process\": { \"shellInterpolation\": \"deny\", \"restrictedModeExpected\": true },\n \"network\": { \"requireTimeouts\": true },\n \"eval\": { \"stringEval\": \"deny\", \"bareRead\": \"deny\", \"allowReadEval\": false },\n \"shell\": { \"treatScriptsAsCodeExecution\": true, \"requireFdHygiene\": true }\n },\n \"suppressions\": []\n}\n"} {"text":";; FILE: jerboa-qt/README.md\n# jerboa-qt\n\nQt6 Widgets bindings for Jerboa Scheme.\n\nBuild desktop GUI applications with native Qt6 widgets from Jerboa, using a thin C++ shim and Chez's FFI underneath. API-compatible with [qt-vendor](https://github.com/ober/qt-vendor) at the high-level `qt-*` API layer.\n\n## Requirements\n\n- Jerboa with `jerbuild` on `PATH`\n- Qt6 development libraries\n- C compiler\n- A Qt shim provider. The Makefile first looks for `$HOME/mine/qt-vendor/vendor`, then falls back to `$HOME/mine/jerboa-emacs`.\n\n### Linux (Ubuntu/Debian)\n\n```sh\nsudo apt install qt6-base-dev libgl1-mesa-dev chezscheme\n```\n\n### Linux (Fedora)\n\n```sh\nsudo dnf install qt6-qtbase-devel chez-scheme\n```\n\n### macOS (Homebrew)\n\n```sh\nbrew install qt@6 chezscheme\nexport PKG_CONFIG_PATH=\"$(brew --prefix qt@6)/lib/pkgconfig:$PKG_CONFIG_PATH\"\n```\n\n## Build\n\nFirst, clone and build [qt-vendor](https://github.com/ober/qt-vendor) to get the C++ shim:\n\n```sh\ngit clone https://github.com/ober/qt-vendor.git\ncd qt-vendor\nmake build\ncd ..\n```\n\nThen build jerboa-qt:\n\n```sh\ncd jerboa-qt\nmake\n```\n\nBy default, the Makefile uses `$HOME/mine/qt-vendor/vendor` when present and otherwise falls back to `$HOME/mine/jerboa-emacs`. Override with:\n\n```sh\nmake QT_SHIM_INCLUDE_DIR=/path/to/include QT_SHIM_LIB_DIR=/path/to/lib\n```\n\nThis transpiles the Jerboa modules under `lib/` and builds the callback bridge (`jerboa_qt_shim.dylib` on macOS, `jerboa_qt_shim.so` elsewhere).\n\n## Test\n\n```sh\nmake test\n```\n\nTests run headless using Qt's offscreen platform plugin (`QT_QPA_PLATFORM=offscreen`).\n\n## Usage\n\n```scheme\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n (label (qt-label-create \"Count: 0\"))\n (button (qt-push-button-create \"Click me!\"))\n (count 0))\n (qt-layout-add-widget! layout label)\n (qt-layout-add-widget! layout button)\n (qt-on-clicked! button\n (lambda ()\n (set! count (+ count 1))\n (qt-label-set-text! label\n (string-append \"Count: \" (number->string count)))))\n (qt-main-window-set-central-widget! win central)\n (qt-main-window-set-title! win \"Counter\")\n (qt-widget-resize! win 300 200)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n```\n\n### Running Examples\n\nAll examples are self-contained executables with shebangs. Just run them directly from anywhere:\n\n```sh\n./examples/hello.ss\n./examples/counter.ss\n./examples/form.ss\n./examples/editor.ss\n./examples/dashboard.ss\n```\n\nThe shebang automatically resolves library paths relative to the script location, so examples work from any working directory:\n\n```sh\ncd /tmp\n/path/to/jerboa-qt/examples/hello.ss\n```\n\nRun headless (no display required):\n\n```sh\nQT_QPA_PLATFORM=offscreen ./examples/hello.ss\n```\n\nOr invoke manually without the shebang:\n\n```sh\nJH=\"$(jerbuild --jerboa-home)\"\nJERBOA_QT_LIB=\"$PWD\" \\\nJERBOA_QT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\" \\\nDYLD_LIBRARY_PATH=\"$PWD:${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}:${DYLD_LIBRARY_PATH:-}\" \\\nQT_QPA_PLATFORM=offscreen \\\njerbuild exec --libdirs \"lib:$JH/lib\" examples/hello.ss\n```\n\n### Using from the REPL\n\nFrom the jerboa-qt directory:\n\n```scheme\n> (import (jerboa-qt qt))\n> (define app (qt-app-create))\n> (define win (qt-main-window-create))\n> (qt-main-window-set-title! win \"REPL Window\")\n> (qt-widget-resize! win 400 300)\n> (qt-widget-show! win)\n> (qt-app-exec! app)\n```\n\n## Differences from qt-vendor\n\n| Aspect | qt-vendor | jerboa-qt |\n|--------|-----------|---------|\n| Import | `(import :qt-vendor/qt)` | `(import (jerboa-qt qt))` |\n| Define | `(def (name args) ...)` | `(define (name args) ...)` |\n| Main | `(def (main) ...)` in build target | `(define (main) ...) (main)` at end of script |\n| Keyword args | `parent: #f` | Not supported; positional or omitted |\n| Build | `other-Scheme build` | `make` |\n| Run examples | `make demo-hello` | `./examples/hello.ss` |\n| FFI mechanism | Gambit `c-define` (compile-time) | Chez `foreign-callable` (runtime) |\n\nThe high-level API (`qt-*` functions) is identical between both projects. Code that uses only the `(jerboa-qt qt)` / `:qt-vendor/qt` API can be ported by changing the import line and using `define` instead of `def`.\n\n## API Reference\n\n### Application Lifecycle\n\n| Function | Description |\n|----------|-------------|\n| `(qt-app-create)` | Create QApplication |\n| `(qt-app-exec! app)` | Run the event loop |\n| `(qt-app-quit! app)` | Quit the event loop |\n| `(qt-app-process-events! app)` | Process pending events (cooperative polling) |\n| `(qt-app-destroy! app)` | Destroy application |\n| `(with-qt-app app body ...)` | Macro: create app, run body, destroy on exit |\n\n### Widget Base\n\nAll widget types support these operations:\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-create)` | Create a generic widget |\n| `(qt-widget-show! w)` | Show widget |\n| `(qt-widget-hide! w)` | Hide widget |\n| `(qt-widget-close! w)` | Close widget |\n| `(qt-widget-set-enabled! w bool)` | Enable/disable |\n| `(qt-widget-enabled? w)` | Check if enabled |\n| `(qt-widget-set-visible! w bool)` | Set visibility |\n| `(qt-widget-visible? w)` | Check if visible |\n| `(qt-widget-resize! w width height)` | Resize |\n| `(qt-widget-set-fixed-size! w width height)` | Set fixed size |\n| `(qt-widget-set-minimum-size! w width height)` | Set minimum size |\n| `(qt-widget-set-maximum-size! w width height)` | Set maximum size |\n| `(qt-widget-set-minimum-width! w pixels)` | Set minimum width |\n| `(qt-widget-set-minimum-height! w pixels)` | Set minimum height |\n| `(qt-widget-set-maximum-width! w pixels)` | Set maximum width |\n| `(qt-widget-set-maximum-height! w pixels)` | Set maximum height |\n| `(qt-widget-set-cursor! w cursor)` | Set cursor shape (use `QT_CURSOR_*` constants) |\n| `(qt-widget-unset-cursor! w)` | Reset cursor to default |\n| `(qt-widget-set-style-sheet! w css)` | Apply CSS stylesheet |\n| `(qt-widget-set-tooltip! w text)` | Set tooltip text |\n| `(qt-widget-set-font-size! w size)` | Set font point size |\n| `(qt-widget-destroy! w)` | Destroy widget |\n\n### Main Window\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-create)` | Create main window |\n| `(qt-main-window-set-title! w title)` | Set window title |\n| `(qt-main-window-set-central-widget! w child)` | Set central widget |\n\n### Layouts\n\n| Function | Description |\n|----------|-------------|\n| `(qt-vbox-layout-create parent)` | Vertical box layout |\n| `(qt-hbox-layout-create parent)` | Horizontal box layout |\n| `(qt-layout-add-widget! layout widget)` | Add widget to layout |\n| `(qt-layout-add-stretch! layout)` | Add stretch spacer |\n| `(qt-layout-set-spacing! layout spacing)` | Set item spacing |\n| `(qt-layout-set-margins! layout l t r b)` | Set content margins |\n| `(qt-layout-add-spacing! layout pixels)` | Add fixed pixel spacing |\n| `(qt-layout-set-stretch-factor! layout widget stretch)` | Set relative stretch factor |\n\n### Labels\n\n| Function | Description |\n|----------|-------------|\n| `(qt-label-create text)` | Create label |\n| `(qt-label-text l)` | Get text |\n| `(qt-label-set-text! l text)` | Set text |\n| `(qt-label-set-alignment! l alignment)` | Set alignment (use `QT_ALIGN_*` constants) |\n| `(qt-label-set-word-wrap! l bool)` | Enable/disable word wrap |\n\n### Push Button\n\n| Function | Description |\n|----------|-------------|\n| `(qt-push-button-create text)` | Create button |\n| `(qt-push-button-text b)` | Get button text |\n| `(qt-push-button-set-text! b text)` | Set button text |\n| `(qt-on-clicked! button handler)` | Connect clicked signal: `(lambda () ...)` |\n\n### Line Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-line-edit-create)` | Create single-line text input |\n| `(qt-line-edit-text e)` | Get text |\n| `(qt-line-edit-set-text! e text)` | Set text |\n| `(qt-line-edit-set-placeholder! e text)` | Set placeholder text |\n| `(qt-line-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-line-edit-set-echo-mode! e mode)` | Set echo mode (use `QT_ECHO_*` constants) |\n| `(qt-on-text-changed! e handler)` | Connect textChanged: `(lambda (text) ...)` |\n| `(qt-on-return-pressed! e handler)` | Connect returnPressed: `(lambda () ...)` |\n\n### Check Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-check-box-create text)` | Create checkbox |\n| `(qt-check-box-checked? c)` | Is checked? |\n| `(qt-check-box-set-checked! c bool)` | Set checked state |\n| `(qt-check-box-set-text! c text)` | Set label text |\n| `(qt-on-toggled! c handler)` | Connect toggled: `(lambda (checked?) ...)` |\n\n### Combo Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-combo-box-create)` | Create dropdown |\n| `(qt-combo-box-add-item! c text)` | Add item |\n| `(qt-combo-box-set-current-index! c index)` | Set selection |\n| `(qt-combo-box-current-index c)` | Get selected index |\n| `(qt-combo-box-current-text c)` | Get selected text |\n| `(qt-combo-box-count c)` | Get item count |\n| `(qt-combo-box-clear! c)` | Remove all items |\n| `(qt-on-index-changed! c handler)` | Connect indexChanged: `(lambda (index) ...)` |\n\n### Text Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-edit-create)` | Create multi-line text editor |\n| `(qt-text-edit-text e)` | Get plain text |\n| `(qt-text-edit-set-text! e text)` | Set text |\n| `(qt-text-edit-set-placeholder! e text)` | Set placeholder |\n| `(qt-text-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-text-edit-append! e text)` | Append text |\n| `(qt-text-edit-clear! e)` | Clear all text |\n| `(qt-text-edit-scroll-to-bottom! e)` | Scroll to bottom |\n| `(qt-text-edit-html e)` | Get HTML content |\n| `(qt-on-text-edit-changed! e handler)` | Connect textChanged: `(lambda () ...)` |\n\n### Spin Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-spin-box-create)` | Create integer spinner |\n| `(qt-spin-box-value s)` | Get value |\n| `(qt-spin-box-set-value! s value)` | Set value |\n| `(qt-spin-box-set-range! s min max)` | Set min/max range |\n| `(qt-spin-box-set-single-step! s step)` | Set step increment |\n| `(qt-spin-box-set-prefix! s prefix)` | Set display prefix |\n| `(qt-spin-box-set-suffix! s suffix)` | Set display suffix |\n| `(qt-on-value-changed! s handler)` | Connect valueChanged: `(lambda (value) ...)` |\n\n### Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dialog-create)` | Create dialog window |\n| `(qt-dialog-exec! d)` | Run modal dialog |\n| `(qt-dialog-accept! d)` | Accept and close |\n| `(qt-dialog-reject! d)` | Reject and close |\n| `(qt-dialog-set-title! d title)` | Set dialog title |\n\n### Message Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-message-box-information parent title text)` | Show info dialog |\n| `(qt-message-box-warning parent title text)` | Show warning dialog |\n| `(qt-message-box-question parent title text)` | Show yes/no dialog, returns boolean |\n| `(qt-message-box-critical parent title text)` | Show error dialog |\n\nPass `0` for `parent` if none.\n\n### File Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-file-dialog-open-file parent caption dir filter)` | Open file picker, returns path or `\"\"` |\n| `(qt-file-dialog-save-file parent caption dir filter)` | Save file picker, returns path or `\"\"` |\n| `(qt-file-dialog-open-directory parent caption dir)` | Directory picker, returns path or `\"\"` |\n\n### Menu Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-menu-bar win)` | Get menu bar from main window |\n\n### Menu\n\n| Function | Description |\n|----------|-------------|\n| `(qt-menu-bar-add-menu bar title)` | Add menu to menu bar |\n| `(qt-menu-add-menu menu title)` | Add submenu |\n| `(qt-menu-add-action! menu action)` | Add action to menu |\n| `(qt-menu-add-separator! menu)` | Add separator |\n\n### Action\n\n| Function | Description |\n|----------|-------------|\n| `(qt-action-create text)` | Create action |\n| `(qt-action-text a)` | Get text |\n| `(qt-action-set-text! a text)` | Set text |\n| `(qt-action-set-shortcut! a key-sequence)` | Set keyboard shortcut (e.g. `\"Ctrl+S\"`) |\n| `(qt-action-set-enabled! a bool)` | Enable/disable |\n| `(qt-action-enabled? a)` | Is enabled? |\n| `(qt-action-set-checkable! a bool)` | Make checkable |\n| `(qt-action-checkable? a)` | Is checkable? |\n| `(qt-action-set-checked! a bool)` | Set checked state |\n| `(qt-action-checked? a)` | Is checked? |\n| `(qt-action-set-tooltip! a text)` | Set tooltip |\n| `(qt-action-set-status-tip! a text)` | Set status bar tip |\n| `(qt-on-triggered! a handler)` | Connect triggered: `(lambda () ...)` |\n| `(qt-on-action-toggled! a handler)` | Connect toggled: `(lambda (checked?) ...)` |\n\n### Toolbar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-toolbar-create title)` | Create toolbar |\n| `(qt-main-window-add-toolbar! win toolbar)` | Add toolbar to main window |\n| `(qt-toolbar-add-action! toolbar action)` | Add action to toolbar |\n| `(qt-toolbar-add-separator! toolbar)` | Add separator |\n| `(qt-toolbar-add-widget! toolbar widget)` | Add widget to toolbar |\n| `(qt-toolbar-set-movable! toolbar bool)` | Set movable |\n| `(qt-toolbar-set-icon-size! toolbar w h)` | Set icon size |\n\n### Status Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-set-status-bar-text! win text)` | Set status bar message |\n\n### Grid Layout\n\n| Function | Description |\n|----------|-------------|\n| `(qt-grid-layout-create parent)` | Create grid layout |\n| `(qt-grid-layout-add-widget! grid widget row col)` | Add widget at position |\n| `(qt-grid-layout-set-row-stretch! grid row stretch)` | Set row stretch factor |\n| `(qt-grid-layout-set-column-stretch! grid col stretch)` | Set column stretch factor |\n| `(qt-grid-layout-set-row-minimum-height! grid row height)` | Set row minimum height |\n| `(qt-grid-layout-set-column-minimum-width! grid col width)` | Set column minimum width |\n\n### Timer\n\n| Function | Description |\n|----------|-------------|\n| `(qt-timer-create)` | Create timer |\n| `(qt-timer-start! t msec)` | Start with interval |\n| `(qt-timer-stop! t)` | Stop timer |\n| `(qt-timer-set-single-shot! t bool)` | Set single-shot mode |\n| `(qt-timer-active? t)` | Is running? |\n| `(qt-timer-interval t)` | Get interval |\n| `(qt-timer-set-interval! t msec)` | Set interval |\n| `(qt-on-timeout! t handler)` | Connect timeout: `(lambda () ...)` |\n| `(qt-timer-single-shot! msec handler)` | One-shot timer (static convenience) |\n| `(qt-timer-destroy! t)` | Destroy timer |\n\n### Clipboard\n\n| Function | Description |\n|----------|-------------|\n| `(qt-clipboard-text app)` | Get clipboard text |\n| `(qt-clipboard-set-text! app text)` | Set clipboard text |\n| `(qt-on-clipboard-changed! app handler)` | Connect dataChanged: `(lambda () ...)` |\n\nThe clipboard is a singleton owned by QApplication -- never destroy it.\n\n### Tree Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tree-widget-create)` | Create tree widget |\n| `(qt-tree-widget-set-column-count! t count)` | Set number of columns |\n| `(qt-tree-widget-column-count t)` | Get column count |\n| `(qt-tree-widget-set-header-label! t label)` | Set single header label |\n| `(qt-tree-widget-set-header-item-text! t col text)` | Set individual header text |\n| `(qt-tree-widget-add-top-level-item! t item)` | Add top-level item |\n| `(qt-tree-widget-top-level-item-count t)` | Count top-level items |\n| `(qt-tree-widget-top-level-item t index)` | Get top-level item by index |\n| `(qt-tree-widget-current-item t)` | Get selected item (or `#f`) |\n| `(qt-tree-widget-set-current-item! t item)` | Set selected item |\n| `(qt-tree-widget-expand-item! t item)` | Expand item |\n| `(qt-tree-widget-collapse-item! t item)` | Collapse item |\n| `(qt-tree-widget-expand-all! t)` | Expand all |\n| `(qt-tree-widget-collapse-all! t)` | Collapse all |\n| `(qt-tree-widget-clear! t)` | Remove all items |\n| `(qt-on-current-item-changed! t handler)` | `(lambda () ...)` |\n| `(qt-on-tree-item-double-clicked! t handler)` | `(lambda () ...)` |\n| `(qt-on-item-expanded! t handler)` | `(lambda () ...)` |\n| `(qt-on-item-collapsed! t handler)` | `(lambda () ...)` |\n\n### Tree Widget Item\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tree-item-create text)` | Create tree item |\n| `(qt-tree-item-set-text! item col text)` | Set text at column |\n| `(qt-tree-item-text item col)` | Get text at column |\n| `(qt-tree-item-add-child! parent child)` | Add child item |\n| `(qt-tree-item-child-count item)` | Get child count |\n| `(qt-tree-item-child item index)` | Get child by index |\n| `(qt-tree-item-parent item)` | Get parent item |\n| `(qt-tree-item-set-expanded! item bool)` | Set expanded state |\n| `(qt-tree-item-expanded? item)` | Is expanded? |\n\n### List Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-list-widget-create)` | Create list widget |\n| `(qt-list-widget-add-item! l text)` | Add item |\n| `(qt-list-widget-insert-item! l row text)` | Insert at position |\n| `(qt-list-widget-remove-item! l row)` | Remove by position |\n| `(qt-list-widget-current-row l)` | Get selected row |\n| `(qt-list-widget-set-current-row! l row)` | Set selected row |\n| `(qt-list-widget-item-text l row)` | Get item text |\n| `(qt-list-widget-count l)` | Get item count |\n| `(qt-list-widget-clear! l)` | Remove all items |\n| `(qt-list-widget-set-item-data! l row data)` | Set hidden data string |\n| `(qt-list-widget-item-data l row)` | Get hidden data string |\n| `(qt-on-current-row-changed! l handler)` | `(lambda (row) ...)` |\n| `(qt-on-item-double-clicked! l handler)` | `(lambda (row) ...)` |\n\n### Table Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-table-widget-create rows cols)` | Create table widget |\n| `(qt-table-widget-set-item! t row col text)` | Set cell text |\n| `(qt-table-widget-item-text t row col)` | Get cell text |\n| `(qt-table-widget-set-horizontal-header! t col text)` | Set column header |\n| `(qt-table-widget-set-vertical-header! t row text)` | Set row header |\n| `(qt-table-widget-set-row-count! t count)` | Set row count |\n| `(qt-table-widget-set-column-count! t count)` | Set column count |\n| `(qt-table-widget-row-count t)` | Get row count |\n| `(qt-table-widget-column-count t)` | Get column count |\n| `(qt-table-widget-current-row t)` | Get current row |\n| `(qt-table-widget-current-column t)` | Get current column |\n| `(qt-table-widget-clear! t)` | Clear all cells |\n| `(qt-on-cell-clicked! t handler)` | `(lambda () ...)` |\n\n### Tab Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tab-widget-create)` | Create tab widget |\n| `(qt-tab-widget-add-tab! tw page title)` | Add tab page |\n| `(qt-tab-widget-set-current-index! tw index)` | Set active tab |\n| `(qt-tab-widget-current-index tw)` | Get active tab index |\n| `(qt-tab-widget-count tw)` | Get tab count |\n| `(qt-tab-widget-set-tab-text! tw index text)` | Change tab label |\n| `(qt-on-tab-changed! tw handler)` | `(lambda (index) ...)` |\n\n### Progress Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-progress-bar-create)` | Create progress bar |\n| `(qt-progress-bar-set-value! p value)` | Set current value |\n| `(qt-progress-bar-value p)` | Get current value |\n| `(qt-progress-bar-set-range! p min max)` | Set value range |\n| `(qt-progress-bar-set-format! p fmt)` | Set display format (e.g. `\"%p%\"`) |\n\n### Slider\n\n| Function | Description |\n|----------|-------------|\n| `(qt-slider-create orientation)` | Create slider (`QT_HORIZONTAL` / `QT_VERTICAL`) |\n| `(qt-slider-set-value! s value)` | Set value |\n| `(qt-slider-value s)` | Get value |\n| `(qt-slider-set-range! s min max)` | Set range |\n| `(qt-slider-set-single-step! s step)` | Set step |\n| `(qt-slider-set-tick-interval! s interval)` | Set tick spacing |\n| `(qt-slider-set-tick-position! s position)` | Set tick position (use `QT_TICKS_*` constants) |\n| `(qt-on-slider-value-changed! s handler)` | `(lambda (value) ...)` |\n\n### Window State\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-show-minimized! w)` | Minimize |\n| `(qt-widget-show-maximized! w)` | Maximize |\n| `(qt-widget-show-fullscreen! w)` | Fullscreen |\n| `(qt-widget-show-normal! w)` | Normal |\n| `(qt-widget-window-state w)` | Get state constant |\n| `(qt-widget-move! w x y)` | Move window |\n| `(qt-widget-x w)` | Get X position |\n| `(qt-widget-y w)` | Get Y position |\n| `(qt-widget-width w)` | Get width |\n| `(qt-widget-height w)` | Get height |\n| `(qt-widget-set-focus! w)` | Set keyboard focus |\n\n### App-wide Style Sheet\n\n| Function | Description |\n|----------|-------------|\n| `(qt-app-set-style-sheet! app css)` | Apply CSS to entire application |\n\n### Scroll Area\n\n| Function | Description |\n|----------|-------------|\n| `(qt-scroll-area-create)` | Create scroll area |\n| `(qt-scroll-area-set-widget! sa widget)` | Set scrollable content |\n| `(qt-scroll-area-set-widget-resizable! sa bool)` | Allow content to resize |\n| `(qt-scroll-area-set-horizontal-scrollbar-policy! sa policy)` | Set horizontal scrollbar |\n| `(qt-scroll-area-set-vertical-scrollbar-policy! sa policy)` | Set vertical scrollbar |\n\n### Splitter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-splitter-create orientation)` | Create splitter (`QT_HORIZONTAL` / `QT_VERTICAL`) |\n| `(qt-splitter-add-widget! sp widget)` | Add widget |\n| `(qt-splitter-insert-widget! sp index widget)` | Insert at position |\n| `(qt-splitter-count sp)` | Get widget count |\n| `(qt-splitter-set-handle-width! sp pixels)` | Set handle width |\n| `(qt-splitter-set-collapsible! sp index bool)` | Set collapsible |\n| `(qt-splitter-collapsible? sp index)` | Is collapsible? |\n| `(qt-splitter-set-orientation! sp orientation)` | Change orientation |\n\n### Keyboard Events\n\n| Function | Description |\n|----------|-------------|\n| `(qt-on-key-press! w handler)` | Key press: `(lambda () ...)`, then query key info |\n| `(qt-on-key-press-consuming! w handler)` | Same but consumes the event |\n| `(qt-last-key-code)` | Get last key code (use `QT_KEY_*` constants) |\n| `(qt-last-key-modifiers)` | Get modifier flags (use `QT_MOD_*` constants) |\n| `(qt-last-key-text)` | Get key text |\n\n### Pixmap\n\n| Function | Description |\n|----------|-------------|\n| `(qt-pixmap-load path)` | Load image from file |\n| `(qt-pixmap-create-blank w h)` | Create blank pixmap |\n| `(qt-pixmap-width pm)` | Get width |\n| `(qt-pixmap-height pm)` | Get height |\n| `(qt-pixmap-null? pm)` | Is empty? |\n| `(qt-pixmap-scaled pm w h)` | Scale pixmap, returns new pixmap |\n| `(qt-pixmap-fill! pm r g b a)` | Fill with color |\n| `(qt-pixmap-destroy! pm)` | Destroy pixmap |\n| `(qt-label-set-pixmap! label pm)` | Display pixmap in label |\n\n### Icon\n\n| Function | Description |\n|----------|-------------|\n| `(qt-icon-create path)` | Create icon from file |\n| `(qt-icon-create-from-pixmap pm)` | Create icon from pixmap |\n| `(qt-icon-null? icon)` | Is empty? |\n| `(qt-icon-destroy! icon)` | Destroy icon |\n| `(qt-push-button-set-icon! button icon)` | Set button icon |\n| `(qt-action-set-icon! action icon)` | Set action icon |\n| `(qt-widget-set-window-icon! w icon)` | Set window icon |\n\n### Radio Button\n\n| Function | Description |\n|----------|-------------|\n| `(qt-radio-button-create text)` | Create radio button |\n| `(qt-radio-button-text r)` | Get text |\n| `(qt-radio-button-set-text! r text)` | Set text |\n| `(qt-radio-button-checked? r)` | Is checked? |\n| `(qt-radio-button-set-checked! r bool)` | Set checked state |\n| `(qt-on-radio-toggled! r handler)` | `(lambda (checked?) ...)` |\n\n### Button Group\n\n| Function | Description |\n|----------|-------------|\n| `(qt-button-group-create)` | Create button group |\n| `(qt-button-group-add-button! bg button id)` | Add button with ID |\n| `(qt-button-group-remove-button! bg button)` | Remove button |\n| `(qt-button-group-checked-id bg)` | Get checked button ID |\n| `(qt-button-group-set-exclusive! bg bool)` | Set exclusive mode |\n| `(qt-button-group-exclusive? bg)` | Is exclusive? |\n| `(qt-on-button-group-clicked! bg handler)` | `(lambda (id) ...)` |\n| `(qt-button-group-destroy! bg)` | Destroy group |\n\n### Group Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-group-box-create title)` | Create group box |\n| `(qt-group-box-title gb)` | Get title |\n| `(qt-group-box-set-title! gb title)` | Set title |\n| `(qt-group-box-set-checkable! gb bool)` | Make checkable |\n| `(qt-group-box-checkable? gb)` | Is checkable? |\n| `(qt-group-box-set-checked! gb bool)` | Set checked state |\n| `(qt-group-box-checked? gb)` | Is checked? |\n| `(qt-on-group-box-toggled! gb handler)` | `(lambda (checked?) ...)` |\n\n### QFont\n\n| Function | Description |\n|----------|-------------|\n| `(qt-font-create family point-size)` | Create font |\n| `(qt-font-family f)` | Get font family name |\n| `(qt-font-point-size f)` | Get point size |\n| `(qt-font-bold? f)` | Check if bold |\n| `(qt-font-set-bold! f bool)` | Set bold |\n| `(qt-font-italic? f)` | Check if italic |\n| `(qt-font-set-italic! f bool)` | Set italic |\n| `(qt-font-destroy! f)` | Destroy font |\n| `(qt-widget-set-font! w f)` | Set font on any widget |\n| `(qt-widget-font w)` | Get widget's font (new copy -- caller must destroy) |\n\n### QColor\n\n| Function | Description |\n|----------|-------------|\n| `(qt-color-create r g b a)` | Create from RGBA (0-255) |\n| `(qt-color-create-name name)` | Create from `\"#rrggbb\"` or named color |\n| `(qt-color-red c)` | Red channel |\n| `(qt-color-green c)` | Green channel |\n| `(qt-color-blue c)` | Blue channel |\n| `(qt-color-alpha c)` | Alpha channel |\n| `(qt-color-name c)` | Hex string `\"#rrggbb\"` |\n| `(qt-color-valid? c)` | Is color valid? |\n| `(qt-color-destroy! c)` | Destroy color |\n\n### QFontDialog / QColorDialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-font-dialog-get-font)` | Show font picker, returns QFont or `#f` |\n| `(qt-color-dialog-get-color)` | Show color picker, returns QColor or `#f` |\n\n### Stacked Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-stacked-widget-create)` | Create stacked widget |\n| `(qt-stacked-widget-add-widget! sw widget)` | Add page |\n| `(qt-stacked-widget-set-current-index! sw index)` | Set visible page |\n| `(qt-stacked-widget-current-index sw)` | Get visible page index |\n| `(qt-stacked-widget-count sw)` | Get page count |\n| `(qt-on-stacked-current-changed! sw handler)` | `(lambda (index) ...)` |\n\n### Dock Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dock-widget-create title)` | Create dock widget |\n| `(qt-dock-widget-set-widget! dock widget)` | Set dock content |\n| `(qt-dock-widget-widget dock)` | Get dock content |\n| `(qt-dock-widget-set-title! dock title)` | Set dock title |\n| `(qt-dock-widget-title dock)` | Get dock title |\n| `(qt-dock-widget-set-floating! dock bool)` | Set floating state |\n| `(qt-dock-widget-floating? dock)` | Is floating? |\n| `(qt-main-window-add-dock-widget! win area dock)` | Add to main window (use `QT_DOCK_*` constants) |\n\n### System Tray Icon\n\n| Function | Description |\n|----------|-------------|\n| `(qt-system-tray-icon-create)` | Create tray icon |\n| `(qt-system-tray-icon-set-tooltip! tray text)` | Set tooltip |\n| `(qt-system-tray-icon-set-icon! tray icon)` | Set tray icon |\n| `(qt-system-tray-icon-show! tray)` | Show in tray |\n| `(qt-system-tray-icon-hide! tray)` | Hide from tray |\n| `(qt-system-tray-icon-show-message! tray title msg icon-type msec)` | Show notification |\n| `(qt-system-tray-icon-set-context-menu! tray menu)` | Set right-click menu |\n| `(qt-on-tray-activated! tray handler)` | `(lambda (reason) ...)` |\n| `(qt-system-tray-icon-available?)` | Is system tray available? |\n| `(qt-system-tray-icon-destroy! tray)` | Destroy tray icon |\n\n### QPainter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-painter-create target)` | Create painter on pixmap or paint widget |\n| `(qt-painter-end! p)` | End painting |\n| `(qt-painter-destroy! p)` | Destroy painter |\n| `(qt-painter-set-pen-color! p r g b)` | Set pen color |\n| `(qt-painter-set-pen-width! p width)` | Set pen width |\n| `(qt-painter-set-brush-color! p r g b)` | Set fill color |\n| `(qt-painter-set-font! p font)` | Set text font |\n| `(qt-painter-set-antialiasing! p bool)` | Enable antialiasing |\n| `(qt-painter-draw-line! p x1 y1 x2 y2)` | Draw line |\n| `(qt-painter-draw-rect! p x y w h)` | Draw rectangle |\n| `(qt-painter-fill-rect! p x y w h)` | Fill rectangle |\n| `(qt-painter-draw-ellipse! p x y w h)` | Draw ellipse |\n| `(qt-painter-draw-text! p x y text)` | Draw text at point |\n| `(qt-painter-draw-text-rect! p x y w h flags text)` | Draw text in rectangle |\n| `(qt-painter-draw-pixmap! p x y pixmap)` | Draw pixmap |\n| `(qt-painter-draw-point! p x y)` | Draw point |\n| `(qt-painter-draw-arc! p x y w h start-angle span-angle)` | Draw arc |\n| `(qt-painter-save! p)` | Save painter state |\n| `(qt-painter-restore! p)` | Restore painter state |\n| `(qt-painter-translate! p dx dy)` | Translate origin |\n| `(qt-painter-rotate! p angle)` | Rotate (degrees) |\n| `(qt-painter-scale! p sx sy)` | Scale |\n| `(with-painter (p target) body ...)` | Macro: create, paint, auto end+destroy |\n\n### Drag and Drop\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-set-accept-drops! w bool)` | Enable drop target |\n| `(qt-drop-filter-install! w)` | Install drop event filter |\n| `(qt-drop-filter-last-text)` | Get last dropped text |\n| `(qt-drop-filter-destroy! filter)` | Destroy drop filter |\n| `(qt-drag-text! source text)` | Initiate text drag |\n\n### Double Spin Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-double-spin-box-create)` | Create decimal spinner |\n| `(qt-double-spin-box-set-value! s value)` | Set value |\n| `(qt-double-spin-box-value s)` | Get value |\n| `(qt-double-spin-box-set-range! s min max)` | Set range |\n| `(qt-double-spin-box-set-single-step! s step)` | Set step |\n| `(qt-double-spin-box-set-decimals! s n)` | Set decimal places |\n| `(qt-double-spin-box-decimals s)` | Get decimal places |\n| `(qt-double-spin-box-set-prefix! s prefix)` | Set prefix |\n| `(qt-double-spin-box-set-suffix! s suffix)` | Set suffix |\n| `(qt-on-double-spin-value-changed! s handler)` | `(lambda (value) ...)` |\n\n### Date Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-date-edit-create)` | Create date picker |\n| `(qt-date-edit-set-date! d year month day)` | Set date |\n| `(qt-date-edit-year d)` | Get year |\n| `(qt-date-edit-month d)` | Get month |\n| `(qt-date-edit-day d)` | Get day |\n| `(qt-date-edit-date-string d)` | Get ISO date string |\n| `(qt-date-edit-set-minimum-date! d year month day)` | Set minimum |\n| `(qt-date-edit-set-maximum-date! d year month day)` | Set maximum |\n| `(qt-date-edit-set-calendar-popup! d bool)` | Enable calendar popup |\n| `(qt-date-edit-set-display-format! d format)` | Set display format |\n| `(qt-on-date-changed! d handler)` | `(lambda () ...)` |\n\n### Time Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-time-edit-create)` | Create time picker |\n| `(qt-time-edit-set-time! t hour minute second)` | Set time |\n| `(qt-time-edit-hour t)` | Get hour |\n| `(qt-time-edit-minute t)` | Get minute |\n| `(qt-time-edit-second t)` | Get second |\n| `(qt-time-edit-time-string t)` | Get time string |\n| `(qt-time-edit-set-display-format! t format)` | Set display format |\n| `(qt-on-time-changed! t handler)` | `(lambda () ...)` |\n\n### Frame\n\n| Function | Description |\n|----------|-------------|\n| `(qt-frame-create)` | Create frame |\n| `(qt-frame-set-frame-shape! f shape)` | Set shape (use `QT_FRAME_*` constants) |\n| `(qt-frame-frame-shape f)` | Get shape |\n| `(qt-frame-set-frame-shadow! f shadow)` | Set shadow |\n| `(qt-frame-frame-shadow f)` | Get shadow |\n| `(qt-frame-set-line-width! f width)` | Set line width |\n| `(qt-frame-line-width f)` | Get line width |\n| `(qt-frame-set-mid-line-width! f width)` | Set mid-line width |\n\n### Progress Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-progress-dialog-create title cancel-text min max)` | Create progress dialog |\n| `(qt-progress-dialog-set-value! d value)` | Set progress |\n| `(qt-progress-dialog-value d)` | Get progress |\n| `(qt-progress-dialog-set-range! d min max)` | Set range |\n| `(qt-progress-dialog-set-label-text! d text)` | Set label |\n| `(qt-progress-dialog-was-canceled? d)` | Was cancelled? |\n| `(qt-progress-dialog-set-minimum-duration! d msec)` | Set delay before showing |\n| `(qt-progress-dialog-set-auto-close! d bool)` | Auto close on completion |\n| `(qt-progress-dialog-set-auto-reset! d bool)` | Auto reset on completion |\n| `(qt-progress-dialog-reset! d)` | Reset dialog |\n| `(qt-on-progress-canceled! d handler)` | `(lambda () ...)` |\n\n### Input Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-input-dialog-get-text title label default)` | Get text from user; returns string or `\"\"` |\n| `(qt-input-dialog-get-int title label value min max step)` | Get integer |\n| `(qt-input-dialog-get-double title label value min max decimals)` | Get double |\n| `(qt-input-dialog-get-item title label items current editable)` | Choose from list |\n| `(qt-input-dialog-was-accepted?)` | Was last dialog accepted? |\n\n### Form Layout\n\n| Function | Description |\n|----------|-------------|\n| `(qt-form-layout-create parent)` | Create form layout (label:field rows) |\n| `(qt-form-layout-add-row! form label widget)` | Add labeled row |\n| `(qt-form-layout-add-row-widget! form widget)` | Add spanning row |\n| `(qt-form-layout-add-spanning-widget! form widget)` | Add spanning widget |\n| `(qt-form-layout-row-count form)` | Get number of rows |\n\n### Shortcut\n\n| Function | Description |\n|----------|-------------|\n| `(qt-shortcut-create key-sequence parent)` | Create shortcut (e.g. `\"Ctrl+S\"`) |\n| `(qt-shortcut-set-key! sc key-sequence)` | Change key sequence |\n| `(qt-shortcut-set-enabled! sc bool)` | Enable/disable |\n| `(qt-shortcut-enabled? sc)` | Is enabled? |\n| `(qt-on-shortcut-activated! sc handler)` | `(lambda () ...)` |\n| `(qt-shortcut-destroy! sc)` | Destroy shortcut |\n\n### Calendar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-calendar-create)` | Create calendar widget |\n| `(qt-calendar-set-selected-date! cal year month day)` | Set selected date |\n| `(qt-calendar-selected-year cal)` | Get year |\n| `(qt-calendar-selected-month cal)` | Get month (1-12) |\n| `(qt-calendar-selected-day cal)` | Get day (1-31) |\n| `(qt-calendar-selected-date-string cal)` | Get ISO date string |\n| `(qt-calendar-set-minimum-date! cal year month day)` | Set minimum date |\n| `(qt-calendar-set-maximum-date! cal year month day)` | Set maximum date |\n| `(qt-calendar-set-first-day-of-week! cal day)` | Set first day (use `QT_MONDAY`..`QT_SUNDAY`) |\n| `(qt-calendar-set-grid-visible! cal bool)` | Show/hide grid |\n| `(qt-calendar-grid-visible? cal)` | Is grid visible? |\n| `(qt-calendar-set-navigation-bar-visible! cal bool)` | Show/hide navigation |\n| `(qt-on-calendar-selection-changed! cal handler)` | `(lambda () ...)` |\n| `(qt-on-calendar-clicked! cal handler)` | `(lambda (iso-date) ...)` |\n\n### Text Browser\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-browser-create)` | Create rich text/HTML viewer |\n| `(qt-text-browser-set-html! tb html)` | Set HTML content |\n| `(qt-text-browser-set-plain-text! tb text)` | Set plain text |\n| `(qt-text-browser-plain-text tb)` | Get plain text |\n| `(qt-text-browser-set-open-external-links! tb bool)` | Enable browser launch on click |\n| `(qt-text-browser-set-source! tb url)` | Load content from URL/file |\n| `(qt-text-browser-source tb)` | Get current source URL |\n| `(qt-text-browser-scroll-to-bottom! tb)` | Scroll to bottom |\n| `(qt-text-browser-append! tb text)` | Append text |\n| `(qt-text-browser-html tb)` | Get HTML content |\n| `(qt-on-anchor-clicked! tb handler)` | Link clicked: `(lambda (url) ...)` |\n\n### Dialog Button Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-button-box-create flags)` | Create with standard button flags (`bitwise-ior`) |\n| `(qt-button-box-button bb role)` | Get button by standard constant |\n| `(qt-button-box-add-button! bb text role)` | Add custom button |\n| `(qt-on-button-box-accepted! bb handler)` | `(lambda () ...)` |\n| `(qt-on-button-box-rejected! bb handler)` | `(lambda () ...)` |\n| `(qt-on-button-box-clicked! bb handler)` | `(lambda () ...)` |\n\n**Standard buttons:** `QT_BUTTON_OK`, `QT_BUTTON_CANCEL`, `QT_BUTTON_APPLY`, `QT_BUTTON_CLOSE`, `QT_BUTTON_YES`, `QT_BUTTON_NO`, `QT_BUTTON_RESET`, `QT_BUTTON_HELP`, `QT_BUTTON_SAVE`, `QT_BUTTON_DISCARD`\n\n### QSettings\n\n| Function | Description |\n|----------|-------------|\n| `(qt-settings-create org app)` | Create settings for org/app |\n| `(qt-settings-create-file path format)` | Create file-backed settings |\n| `(qt-settings-set-string! s key value)` | Store string |\n| `(qt-settings-value-string s key default)` | Read string |\n| `(qt-settings-set-int! s key value)` | Store integer |\n| `(qt-settings-value-int s key default)` | Read integer |\n| `(qt-settings-set-double! s key value)` | Store double |\n| `(qt-settings-value-double s key default)` | Read double |\n| `(qt-settings-set-bool! s key value)` | Store boolean |\n| `(qt-settings-value-bool s key default)` | Read boolean |\n| `(qt-settings-contains? s key)` | Check if key exists |\n| `(qt-settings-remove! s key)` | Remove key |\n| `(qt-settings-all-keys s)` | List all keys |\n| `(qt-settings-child-keys s)` | Keys in current group |\n| `(qt-settings-child-groups s)` | Subgroups in current group |\n| `(qt-settings-begin-group! s prefix)` | Enter group |\n| `(qt-settings-end-group! s)` | Leave group |\n| `(qt-settings-group s)` | Current group name |\n| `(qt-settings-sync! s)` | Flush to storage |\n| `(qt-settings-clear! s)` | Remove all keys |\n| `(qt-settings-file-name s)` | Path to storage file |\n| `(qt-settings-writable? s)` | Can write? |\n| `(qt-settings-destroy! s)` | Destroy settings |\n\n**Format constants:** `QT_SETTINGS_NATIVE`, `QT_SETTINGS_INI`\n\n### QCompleter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-completer-create items)` | Create from list of strings |\n| `(qt-completer-set-model-strings! c items)` | Update completion list |\n| `(qt-completer-set-case-sensitivity! c sensitive?)` | Case-sensitive matching |\n| `(qt-completer-set-completion-mode! c mode)` | Set popup/inline mode |\n| `(qt-completer-set-filter-mode! c mode)` | Set starts-with/contains/ends-with |\n| `(qt-completer-set-max-visible-items! c count)` | Max visible popup items |\n| `(qt-completer-completion-count c)` | Number of completions |\n| `(qt-completer-current-completion c)` | Current completion text |\n| `(qt-completer-set-completion-prefix! c prefix)` | Set prefix to match |\n| `(qt-on-completer-activated! c handler)` | `(lambda (text) ...)` |\n| `(qt-line-edit-set-completer! e c)` | Attach to line edit |\n| `(qt-completer-set-widget! c widget)` | Attach to arbitrary widget |\n| `(qt-completer-complete-rect! c x y w h)` | Show popup at rect |\n| `(qt-completer-destroy! c)` | Destroy (only if not attached) |\n\n**Mode constants:** `QT_COMPLETER_POPUP`, `QT_COMPLETER_INLINE`, `QT_COMPLETER_UNFILTERED_POPUP`\n\n**Case constants:** `QT_CASE_INSENSITIVE`, `QT_CASE_SENSITIVE`\n\n**Filter constants:** `QT_MATCH_STARTS_WITH`, `QT_MATCH_CONTAINS`, `QT_MATCH_ENDS_WITH`\n\n### Tooltip / WhatsThis\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tooltip-show-text! x y text)` | Show tooltip at screen position |\n| `(qt-tooltip-hide-text!)` | Hide current tooltip |\n| `(qt-tooltip-visible?)` | Is tooltip visible? |\n| `(qt-widget-tooltip w)` | Get widget's tooltip text |\n| `(qt-widget-set-whats-this! w text)` | Set \"What's This?\" text |\n| `(qt-widget-whats-this w)` | Get \"What's This?\" text |\n\n### QStandardItemModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-standard-model-create rows cols)` | Create model |\n| `(qt-standard-model-destroy! m)` | Destroy model |\n| `(qt-standard-model-row-count m)` | Row count |\n| `(qt-standard-model-column-count m)` | Column count |\n| `(qt-standard-model-set-row-count! m rows)` | Set rows |\n| `(qt-standard-model-set-column-count! m cols)` | Set columns |\n| `(qt-standard-model-set-item! m row col item)` | Set item (transfers ownership) |\n| `(qt-standard-model-item m row col)` | Get item |\n| `(qt-standard-model-insert-row! m row)` | Insert row |\n| `(qt-standard-model-insert-column! m col)` | Insert column |\n| `(qt-standard-model-remove-row! m row)` | Remove row |\n| `(qt-standard-model-remove-column! m col)` | Remove column |\n| `(qt-standard-model-clear! m)` | Clear all items |\n| `(qt-standard-model-set-horizontal-header! m col text)` | Set column header |\n| `(qt-standard-model-set-vertical-header! m row text)` | Set row header |\n\n### QStandardItem\n\n| Function | Description |\n|----------|-------------|\n| `(qt-standard-item-create text)` | Create item |\n| `(qt-standard-item-text item)` | Get text |\n| `(qt-standard-item-set-text! item text)` | Set text |\n| `(qt-standard-item-tooltip item)` | Get tooltip |\n| `(qt-standard-item-set-tooltip! item text)` | Set tooltip |\n| `(qt-standard-item-set-editable! item bool)` | Set editable |\n| `(qt-standard-item-editable? item)` | Is editable? |\n| `(qt-standard-item-set-enabled! item bool)` | Set enabled |\n| `(qt-standard-item-enabled? item)` | Is enabled? |\n| `(qt-standard-item-set-selectable! item bool)` | Set selectable |\n| `(qt-standard-item-selectable? item)` | Is selectable? |\n| `(qt-standard-item-set-checkable! item bool)` | Set checkable |\n| `(qt-standard-item-checkable? item)` | Is checkable? |\n| `(qt-standard-item-set-check-state! item state)` | Set check state |\n| `(qt-standard-item-check-state item)` | Get check state |\n| `(qt-standard-item-set-icon! item icon)` | Set icon |\n| `(qt-standard-item-append-row! parent child)` | Add child (tree hierarchy) |\n| `(qt-standard-item-row-count item)` | Child row count |\n| `(qt-standard-item-column-count item)` | Child column count |\n| `(qt-standard-item-child item row col)` | Get child item |\n\nItems transfer ownership to the model after `set-item!` or `append-row!`. Do not destroy manually.\n\n### QStringListModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-string-list-model-create items)` | Create from list of strings |\n| `(qt-string-list-model-destroy! m)` | Destroy model |\n| `(qt-string-list-model-set-strings! m items)` | Replace all strings |\n| `(qt-string-list-model-strings m)` | Get all strings as list |\n| `(qt-string-list-model-row-count m)` | Number of items |\n\n### Views (QListView, QTableView, QTreeView)\n\n| Function | Description |\n|----------|-------------|\n| `(qt-list-view-create)` | Create list view |\n| `(qt-table-view-create)` | Create table view |\n| `(qt-tree-view-create)` | Create tree view |\n| `(qt-view-set-model! view model)` | Set data model |\n| `(qt-view-set-selection-mode! view mode)` | Set selection mode |\n| `(qt-view-set-selection-behavior! view behavior)` | Set selection behavior |\n| `(qt-view-set-alternating-row-colors! view bool)` | Alternating colors |\n| `(qt-view-set-sorting-enabled! view bool)` | Enable sorting |\n| `(qt-view-set-edit-triggers! view triggers)` | Set edit triggers |\n| `(qt-list-view-set-flow! v flow)` | Set list flow direction |\n| `(qt-table-view-set-column-width! v col w)` | Set column width |\n| `(qt-table-view-set-row-height! v row h)` | Set row height |\n| `(qt-table-view-hide-column! v col)` | Hide column |\n| `(qt-table-view-show-column! v col)` | Show column |\n| `(qt-table-view-hide-row! v row)` | Hide row |\n| `(qt-table-view-show-row! v row)` | Show row |\n| `(qt-table-view-resize-columns-to-contents! v)` | Auto-fit columns |\n| `(qt-table-view-resize-rows-to-contents! v)` | Auto-fit rows |\n| `(qt-tree-view-expand-all! v)` | Expand all nodes |\n| `(qt-tree-view-collapse-all! v)` | Collapse all nodes |\n| `(qt-tree-view-set-indentation! v pixels)` | Set indentation |\n| `(qt-tree-view-indentation v)` | Get indentation |\n| `(qt-tree-view-set-root-is-decorated! v bool)` | Root decoration |\n| `(qt-tree-view-set-header-hidden! v bool)` | Hide header |\n| `(qt-tree-view-set-column-width! v col w)` | Set column width |\n\n### QHeaderView (via view)\n\n| Function | Description |\n|----------|-------------|\n| `(qt-view-header-set-stretch-last-section! view bool)` | Stretch last section |\n| `(qt-view-header-set-section-resize-mode! view mode)` | Set resize mode |\n| `(qt-view-header-hide! view)` | Hide header |\n| `(qt-view-header-show! view)` | Show header |\n| `(qt-view-header-set-default-section-size! view size)` | Set default section size |\n\n### QSortFilterProxyModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-sort-filter-proxy-create)` | Create proxy |\n| `(qt-sort-filter-proxy-destroy! p)` | Destroy proxy |\n| `(qt-sort-filter-proxy-set-source-model! p model)` | Set source model |\n| `(qt-sort-filter-proxy-set-filter-regex! p pattern)` | Set filter regex |\n| `(qt-sort-filter-proxy-set-filter-column! p col)` | Filter column |\n| `(qt-sort-filter-proxy-set-filter-case-sensitivity! p cs)` | Case sensitivity |\n| `(qt-sort-filter-proxy-set-filter-role! p role)` | Filter data role |\n| `(qt-sort-filter-proxy-sort! p col)` | Sort by column |\n| `(qt-sort-filter-proxy-set-sort-role! p role)` | Sort data role |\n| `(qt-sort-filter-proxy-set-dynamic-sort-filter! p bool)` | Auto re-sort |\n| `(qt-sort-filter-proxy-invalidate-filter! p)` | Force re-filter |\n| `(qt-sort-filter-proxy-row-count p)` | Visible row count |\n\n### View Signals + Selection\n\n| Function | Description |\n|----------|-------------|\n| `(qt-on-view-clicked! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-double-clicked! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-activated! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-selection-changed! view handler)` | `(lambda () ...)` |\n| `(qt-view-last-clicked-row)` | Row of last click |\n| `(qt-view-last-clicked-col)` | Column of last click |\n| `(qt-view-selected-rows view)` | List of selected row indices |\n| `(qt-view-current-row view)` | Current row (-1 if none) |\n\n### Validators\n\n| Function | Description |\n|----------|-------------|\n| `(qt-int-validator-create min max)` | Integer range validator |\n| `(qt-double-validator-create bottom top decimals)` | Decimal range validator |\n| `(qt-regex-validator-create pattern)` | Regex validator |\n| `(qt-validator-destroy! v)` | Destroy validator |\n| `(qt-validator-validate v input)` | Validate string, returns state constant |\n| `(qt-line-edit-set-validator! edit validator)` | Attach to line edit |\n| `(qt-line-edit-has-acceptable-input? edit)` | Current input passes? |\n\n**Validator state constants:** `QT_VALIDATOR_INVALID` (0), `QT_VALIDATOR_INTERMEDIATE` (1), `QT_VALIDATOR_ACCEPTABLE` (2)\n\n### QPlainTextEdit\n\nEfficient plain text editor for large documents.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-create)` | Create editor |\n| `(qt-plain-text-edit-set-text! e text)` | Set text |\n| `(qt-plain-text-edit-text e)` | Get text |\n| `(qt-plain-text-edit-append! e text)` | Append line |\n| `(qt-plain-text-edit-clear! e)` | Clear all |\n| `(qt-plain-text-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-plain-text-edit-read-only? e)` | Is read-only? |\n| `(qt-plain-text-edit-set-placeholder! e text)` | Set placeholder |\n| `(qt-plain-text-edit-line-count e)` | Line count |\n| `(qt-plain-text-edit-set-max-block-count! e n)` | Limit max lines |\n| `(qt-plain-text-edit-cursor-line e)` | Cursor line (0-based) |\n| `(qt-plain-text-edit-cursor-column e)` | Cursor column (0-based) |\n| `(qt-plain-text-edit-set-line-wrap! e mode)` | Set wrap mode |\n| `(qt-on-plain-text-changed! e handler)` | `(lambda () ...)` |\n\n**Editor extensions:**\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-cursor-position e)` | Get cursor position |\n| `(qt-plain-text-edit-set-cursor-position! e pos)` | Set cursor position |\n| `(qt-plain-text-edit-move-cursor! e operation anchor)` | Move cursor |\n| `(qt-plain-text-edit-select-all! e)` | Select all text |\n| `(qt-plain-text-edit-selected-text e)` | Get selection |\n| `(qt-plain-text-edit-selection-start e)` | Selection start |\n| `(qt-plain-text-edit-selection-end e)` | Selection end |\n| `(qt-plain-text-edit-set-selection! e start end)` | Set selection range |\n| `(qt-plain-text-edit-has-selection? e)` | Has selection? |\n| `(qt-plain-text-edit-insert-text! e text)` | Insert at cursor |\n| `(qt-plain-text-edit-remove-selected-text! e)` | Delete selection |\n| `(qt-plain-text-edit-undo! e)` | Undo |\n| `(qt-plain-text-edit-redo! e)` | Redo |\n| `(qt-plain-text-edit-can-undo? e)` | Can undo? |\n| `(qt-plain-text-edit-cut! e)` | Cut |\n| `(qt-plain-text-edit-copy! e)` | Copy |\n| `(qt-plain-text-edit-paste! e)` | Paste |\n| `(qt-plain-text-edit-text-length e)` | Total text length |\n| `(qt-plain-text-edit-text-range e start end)` | Get text range |\n| `(qt-plain-text-edit-line-from-position e pos)` | Line at position |\n| `(qt-plain-text-edit-line-end-position e line)` | End of line |\n| `(qt-plain-text-edit-find-text e text flags)` | Find text |\n| `(qt-plain-text-edit-ensure-cursor-visible! e)` | Scroll to cursor |\n| `(qt-plain-text-edit-center-cursor! e)` | Center cursor in view |\n\n**Line wrap constants:** `QT_PLAIN_NO_WRAP` (0), `QT_PLAIN_WIDGET_WRAP` (1)\n\n**Cursor movement constants:** `QT_CURSOR_NO_MOVE`, `QT_CURSOR_START`, `QT_CURSOR_UP`, `QT_CURSOR_START_OF_LINE`, `QT_CURSOR_END_OF_LINE`, `QT_CURSOR_NEXT_CHAR`, `QT_CURSOR_PREVIOUS_CHAR`, `QT_CURSOR_END`, `QT_CURSOR_DOWN`, etc.\n\n**Anchor constants:** `QT_MOVE_ANCHOR`, `QT_KEEP_ANCHOR`\n\n**Find flags:** `QT_FIND_BACKWARD`, `QT_FIND_CASE_SENSITIVE`, `QT_FIND_WHOLE_WORDS`\n\n### QTextDocument\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-document-create)` | Create document |\n| `(qt-plain-text-document-create)` | Create plain text document |\n| `(qt-text-document-destroy! doc)` | Destroy document |\n| `(qt-plain-text-edit-document e)` | Get editor's document |\n| `(qt-plain-text-edit-set-document! e doc)` | Set editor's document |\n| `(qt-text-document-modified? doc)` | Is modified? |\n| `(qt-text-document-set-modified! doc bool)` | Set modified flag |\n\n### QToolButton\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tool-button-create)` | Create tool button |\n| `(qt-tool-button-set-text! b text)` | Set text |\n| `(qt-tool-button-text b)` | Get text |\n| `(qt-tool-button-set-icon! b path)` | Set icon from file |\n| `(qt-tool-button-set-menu! b menu)` | Attach dropdown menu |\n| `(qt-tool-button-set-popup-mode! b mode)` | Set popup mode |\n| `(qt-tool-button-set-auto-raise! b bool)` | Auto-raise appearance |\n| `(qt-tool-button-set-arrow-type! b arrow)` | Set arrow indicator |\n| `(qt-tool-button-set-tool-button-style! b style)` | Set display style |\n| `(qt-on-tool-button-clicked! b handler)` | `(lambda () ...)` |\n\n**Popup mode:** `QT_DELAYED_POPUP` (0), `QT_MENU_BUTTON_POPUP` (1), `QT_INSTANT_POPUP` (2)\n\n**Arrow type:** `QT_NO_ARROW` (0), `QT_UP_ARROW` (1), `QT_DOWN_ARROW` (2), `QT_LEFT_ARROW` (3), `QT_RIGHT_ARROW` (4)\n\n**Style:** `QT_TOOL_BUTTON_ICON_ONLY` (0), `QT_TOOL_BUTTON_TEXT_ONLY` (1), `QT_TOOL_BUTTON_TEXT_BESIDE_ICON` (2), `QT_TOOL_BUTTON_TEXT_UNDER_ICON` (3)\n\n### QSizePolicy\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-set-size-policy! w h-policy v-policy)` | Set size policy |\n\n**Constants:** `QT_SIZE_FIXED` (0), `QT_SIZE_MINIMUM` (1), `QT_SIZE_MINIMUM_EXPANDING` (3), `QT_SIZE_MAXIMUM` (4), `QT_SIZE_PREFERRED` (5), `QT_SIZE_EXPANDING` (7), `QT_SIZE_IGNORED` (13)\n\n### QGraphicsScene\n\n2D scene graph for interactive diagrams.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-scene-create x y w h)` | Create scene with bounds |\n| `(qt-graphics-scene-add-rect! scene x y w h)` | Add rectangle |\n| `(qt-graphics-scene-add-ellipse! scene x y w h)` | Add ellipse |\n| `(qt-graphics-scene-add-line! scene x1 y1 x2 y2)` | Add line |\n| `(qt-graphics-scene-add-text! scene text)` | Add text item |\n| `(qt-graphics-scene-add-pixmap! scene pixmap)` | Add pixmap |\n| `(qt-graphics-scene-remove-item! scene item)` | Remove item |\n| `(qt-graphics-scene-clear! scene)` | Clear all items |\n| `(qt-graphics-scene-items-count scene)` | Item count |\n| `(qt-graphics-scene-set-background! scene r g b)` | Set background color |\n| `(qt-graphics-scene-destroy! scene)` | Destroy scene (and all items) |\n\n### QGraphicsView\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-view-create scene)` | Create view for scene |\n| `(qt-graphics-view-set-render-hint! view hint)` | Set render hint |\n| `(qt-graphics-view-set-drag-mode! view mode)` | Set drag mode |\n| `(qt-graphics-view-fit-in-view! view)` | Fit scene to view |\n| `(qt-graphics-view-scale! view sx sy)` | Zoom |\n| `(qt-graphics-view-center-on! view x y)` | Center on coordinates |\n\n### QGraphicsItem\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-item-set-pos! item x y)` | Set position |\n| `(qt-graphics-item-x item)` | Get X |\n| `(qt-graphics-item-y item)` | Get Y |\n| `(qt-graphics-item-set-pen! item r g b width)` | Set outline |\n| `(qt-graphics-item-set-brush! item r g b)` | Set fill |\n| `(qt-graphics-item-set-flags! item flags)` | Set interaction flags |\n| `(qt-graphics-item-set-tooltip! item text)` | Set tooltip |\n| `(qt-graphics-item-set-zvalue! item z)` | Set stacking order |\n| `(qt-graphics-item-zvalue item)` | Get stacking order |\n| `(qt-graphics-item-set-rotation! item angle)` | Set rotation |\n| `(qt-graphics-item-set-scale! item factor)` | Set scale |\n| `(qt-graphics-item-set-visible! item bool)` | Show/hide |\n\n**Item flags:** `QT_ITEM_MOVABLE` (0x1), `QT_ITEM_SELECTABLE` (0x2), `QT_ITEM_FOCUSABLE` (0x4). Combine with `bitwise-ior`.\n\n**Drag modes:** `QT_DRAG_NONE` (0), `QT_DRAG_SCROLL` (1), `QT_DRAG_RUBBER_BAND` (2)\n\n**Render hints:** `QT_RENDER_ANTIALIASING` (0x01), `QT_RENDER_SMOOTH_PIXMAP` (0x02), `QT_RENDER_TEXT_ANTIALIASING` (0x04)\n\n### PaintWidget (custom paintEvent)\n\nA QWidget subclass that fires a Scheme callback during `paintEvent()`.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-paint-widget-create)` | Create custom paint widget |\n| `(qt-on-paint! widget handler)` | Register paint callback |\n| `(qt-paint-widget-painter widget)` | Get active QPainter (only valid inside callback) |\n| `(qt-paint-widget-update! widget)` | Request repaint |\n| `(qt-paint-widget-width widget)` | Current width |\n| `(qt-paint-widget-height widget)` | Current height |\n\n### QProcess\n\n| Function | Description |\n|----------|-------------|\n| `(qt-process-create)` | Create process |\n| `(qt-process-start! proc program args)` | Start process |\n| `(qt-process-write! proc data)` | Write to stdin |\n| `(qt-process-close-write! proc)` | Close stdin |\n| `(qt-process-read-stdout proc)` | Read stdout |\n| `(qt-process-read-stderr proc)` | Read stderr |\n| `(qt-process-wait-for-finished! proc msecs)` | Wait for exit |\n| `(qt-process-exit-code proc)` | Get exit code |\n| `(qt-process-state proc)` | Get state |\n| `(qt-process-kill! proc)` | Kill (SIGKILL) |\n| `(qt-process-terminate! proc)` | Terminate (SIGTERM) |\n| `(qt-on-process-finished! proc handler)` | `(lambda (exit-code) ...)` |\n| `(qt-on-process-ready-read! proc handler)` | `(lambda () ...)` |\n| `(qt-process-destroy! proc)` | Destroy process |\n\n**Constants:** `QT_PROCESS_NOT_RUNNING` (0), `QT_PROCESS_STARTING` (1), `QT_PROCESS_RUNNING` (2)\n\n### QWizard / QWizardPage\n\n| Function | Description |\n|----------|-------------|\n| `(qt-wizard-create)` | Create wizard dialog |\n| `(qt-wizard-add-page! wizard page)` | Add page, returns ID |\n| `(qt-wizard-set-start-id! wizard id)` | Set starting page |\n| `(qt-wizard-current-id wizard)` | Current page ID |\n| `(qt-wizard-set-title! wizard title)` | Set title |\n| `(qt-wizard-exec! wizard)` | Run modal wizard |\n| `(qt-wizard-page-create)` | Create page |\n| `(qt-wizard-page-set-title! page title)` | Set page title |\n| `(qt-wizard-page-set-subtitle! page subtitle)` | Set subtitle |\n| `(qt-wizard-page-set-layout! page layout)` | Set page layout |\n| `(qt-on-wizard-current-changed! wizard handler)` | `(lambda (page-id) ...)` |\n\n### QMdiArea / QMdiSubWindow\n\n| Function | Description |\n|----------|-------------|\n| `(qt-mdi-area-create)` | Create MDI area |\n| `(qt-mdi-area-add-sub-window! area widget)` | Add sub-window |\n| `(qt-mdi-area-remove-sub-window! area sub)` | Remove sub-window |\n| `(qt-mdi-area-active-sub-window area)` | Get active (or `#f`) |\n| `(qt-mdi-area-sub-window-count area)` | Count sub-windows |\n| `(qt-mdi-area-cascade! area)` | Cascade layout |\n| `(qt-mdi-area-tile! area)` | Tile layout |\n| `(qt-mdi-area-set-view-mode! area mode)` | Set view mode |\n| `(qt-mdi-sub-window-set-title! sub title)` | Set title |\n| `(qt-on-mdi-sub-window-activated! area handler)` | `(lambda () ...)` |\n\n**Constants:** `QT_MDI_SUBWINDOW` (0), `QT_MDI_TABBED` (1)\n\n### QDial\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dial-create)` | Create dial (knob) |\n| `(qt-dial-set-value! dial value)` | Set value |\n| `(qt-dial-value dial)` | Get value |\n| `(qt-dial-set-range! dial min max)` | Set range |\n| `(qt-dial-set-notches-visible! dial bool)` | Show notches |\n| `(qt-dial-set-wrapping! dial bool)` | Enable wrap-around |\n| `(qt-on-dial-value-changed! dial handler)` | `(lambda (value) ...)` |\n\n### QLCDNumber\n\n| Function | Description |\n|----------|-------------|\n| `(qt-lcd-create digits)` | Create LCD display |\n| `(qt-lcd-display-int! lcd value)` | Display integer |\n| `(qt-lcd-display-double! lcd value)` | Display float |\n| `(qt-lcd-display-string! lcd text)` | Display string |\n| `(qt-lcd-set-mode! lcd mode)` | Set mode (dec/hex/oct/bin) |\n| `(qt-lcd-set-segment-style! lcd style)` | Set style |\n\n**Constants:** `QT_LCD_DEC` (0), `QT_LCD_HEX` (1), `QT_LCD_OCT` (2), `QT_LCD_BIN` (3); `QT_LCD_OUTLINE` (0), `QT_LCD_FILLED` (1), `QT_LCD_FLAT` (2)\n\n### QToolBox\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tool-box-create)` | Create accordion widget |\n| `(qt-tool-box-add-item! tb widget text)` | Add page |\n| `(qt-tool-box-set-current-index! tb index)` | Switch page |\n| `(qt-tool-box-current-index tb)` | Current page index |\n| `(qt-tool-box-count tb)` | Page count |\n| `(qt-tool-box-set-item-text! tb index text)` | Change label |\n| `(qt-on-tool-box-current-changed! tb handler)` | `(lambda (index) ...)` |\n\n### QUndoStack\n\n| Function | Description |\n|----------|-------------|\n| `(qt-undo-stack-create)` | Create undo stack |\n| `(qt-undo-stack-push! stack text undo-handler redo-handler)` | Push command |\n| `(qt-undo-stack-undo! stack)` | Undo |\n| `(qt-undo-stack-redo! stack)` | Redo |\n| `(qt-undo-stack-can-undo? stack)` | Can undo? |\n| `(qt-undo-stack-can-redo? stack)` | Can redo? |\n| `(qt-undo-stack-undo-text stack)` | Next undo text |\n| `(qt-undo-stack-redo-text stack)` | Next redo text |\n| `(qt-undo-stack-clear! stack)` | Clear history |\n| `(qt-undo-stack-create-undo-action stack)` | Create undo QAction |\n| `(qt-undo-stack-create-redo-action stack)` | Create redo QAction |\n| `(qt-undo-stack-destroy! stack)` | Destroy stack |\n\n```scheme\n;; Undo/redo example\n(qt-undo-stack-push! stack \"Increment\"\n (lambda () (set! counter (- counter 1))) ; undo\n (lambda () (set! counter (+ counter 1)))) ; redo (called immediately)\n(qt-undo-stack-undo! stack) ; counter goes back\n(qt-undo-stack-redo! stack) ; counter goes forward\n```\n\n### QFileSystemModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-file-system-model-create)` | Create filesystem model |\n| `(qt-file-system-model-set-root-path! model path)` | Set root directory |\n| `(qt-file-system-model-set-filter! model filters)` | Set filters (`bitwise-ior`) |\n| `(qt-file-system-model-set-name-filters! model patterns)` | Set glob patterns (list of strings) |\n| `(qt-file-system-model-file-path model row col)` | Get file path |\n| `(qt-tree-view-set-file-system-root! view model path)` | Set tree root |\n| `(qt-file-system-model-destroy! model)` | Destroy model |\n\n**Constants:** `QT_DIR_DIRS`, `QT_DIR_FILES`, `QT_DIR_HIDDEN`, `QT_DIR_NO_DOT_AND_DOT_DOT`\n\n### QSyntaxHighlighter\n\nRegex-based syntax highlighting for QPlainTextEdit.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-syntax-highlighter-create document)` | Create highlighter on a document |\n| `(qt-syntax-highlighter-destroy! h)` | Destroy highlighter |\n| `(qt-syntax-highlighter-add-rule! h pattern fg-color bold)` | Add regex rule |\n| `(qt-syntax-highlighter-add-keywords! h words fg-color bold)` | Add keyword list |\n| `(qt-syntax-highlighter-add-multiline-rule! h start end fg-color bold)` | Add multiline pattern |\n| `(qt-syntax-highlighter-clear-rules! h)` | Clear all rules |\n| `(qt-syntax-highlighter-rehighlight! h)` | Re-apply highlighting |\n\n### Line Number Area\n\n| Function | Description |\n|----------|-------------|\n| `(qt-line-number-area-create editor)` | Create line numbers for QPlainTextEdit |\n| `(qt-line-number-area-destroy! area)` | Destroy line number area |\n| `(qt-line-number-area-set-visible! area bool)` | Show/hide |\n| `(qt-line-number-area-set-bg-color! area color)` | Set background color |\n| `(qt-line-number-area-set-fg-color! area color)` | Set text color |\n\n### Extra Selections\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-clear-extra-selections! e)` | Clear highlights |\n| `(qt-plain-text-edit-add-extra-selection-line! e line bg-color)` | Highlight line |\n| `(qt-plain-text-edit-add-extra-selection-range! e start end fg bg)` | Highlight range |\n| `(qt-plain-text-edit-apply-extra-selections! e)` | Apply pending highlights |\n\n### QScintilla\n\nAdvanced code editor component (requires libqscintilla2).\n\n| Function | Description |\n|----------|-------------|\n| `(qt-scintilla-create)` | Create Scintilla editor |\n| `(qt-scintilla-destroy! s)` | Destroy editor |\n| `(qt-scintilla-send-message s msg wparam lparam)` | Send raw Scintilla message |\n| `(qt-scintilla-send-message-string s msg wparam str)` | Send message with string |\n| `(qt-scintilla-receive-string s msg wparam)` | Receive string from message |\n| `(qt-scintilla-set-text! s text)` | Set text |\n| `(qt-scintilla-get-text s)` | Get text |\n| `(qt-scintilla-get-text-length s)` | Get text length |\n| `(qt-scintilla-set-lexer-language! s language)` | Set lexer (e.g. `\"cpp\"`) |\n| `(qt-scintilla-get-lexer-language s)` | Get lexer language |\n| `(qt-scintilla-set-read-only! s bool)` | Set read-only |\n| `(qt-scintilla-read-only? s)` | Is read-only? |\n| `(qt-scintilla-set-margin-width! s margin pixels)` | Set margin width |\n| `(qt-scintilla-set-margin-type! s margin type)` | Set margin type |\n| `(qt-scintilla-set-focus! s)` | Set keyboard focus |\n| `(qt-on-scintilla-text-changed! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-char-added! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-save-point-reached! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-save-point-left! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-margin-clicked! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-modified! s handler)` | `(lambda () ...)` |\n\n### Signal Disconnect & Callback Management\n\n| Function | Description |\n|----------|-------------|\n| `(unregister-qt-handler! id)` | Remove callback by ID (returned from `qt-on-*!`) |\n| `(qt-disconnect-all! obj)` | Disconnect all signals from a QObject |\n\nAll `qt-on-*!` functions return a callback ID:\n\n```scheme\n(let ((id (qt-on-clicked! button (lambda () (display \"clicked!\\n\")))))\n ;; Later, remove the handler:\n (unregister-qt-handler! id))\n```\n\nCalling `qt-on-*!` multiple times accumulates connections. To replace a handler, unregister the old one first.\n\n### Resource Safety Macros\n\nRAII-style macros that guarantee cleanup even on exceptions.\n\n| Macro | Description |\n|-------|-------------|\n| `(with-painter (p target) body ...)` | Create QPainter, auto end+destroy |\n| `(with-qt-app app body ...)` | Create QApplication, auto destroy |\n\n## Constants Reference\n\n### Alignment\n`QT_ALIGN_LEFT`, `QT_ALIGN_RIGHT`, `QT_ALIGN_CENTER`, `QT_ALIGN_TOP`, `QT_ALIGN_BOTTOM`\n\n### Orientation\n`QT_HORIZONTAL`, `QT_VERTICAL`\n\n### Echo Mode\n`QT_ECHO_NORMAL`, `QT_ECHO_NO_ECHO`, `QT_ECHO_PASSWORD`, `QT_ECHO_PASSWORD_ON_EDIT`\n\n### Tick Position\n`QT_TICKS_NONE`, `QT_TICKS_ABOVE`, `QT_TICKS_BELOW`, `QT_TICKS_BOTH_SIDES`\n\n### Window State\n`QT_WINDOW_NO_STATE`, `QT_WINDOW_MINIMIZED`, `QT_WINDOW_MAXIMIZED`, `QT_WINDOW_FULL_SCREEN`\n\n### Scrollbar Policy\n`QT_SCROLLBAR_AS_NEEDED`, `QT_SCROLLBAR_ALWAYS_OFF`, `QT_SCROLLBAR_ALWAYS_ON`\n\n### Cursor Shape\n`QT_CURSOR_ARROW`, `QT_CURSOR_CROSS`, `QT_CURSOR_WAIT`, `QT_CURSOR_IBEAM`, `QT_CURSOR_POINTING_HAND`, `QT_CURSOR_FORBIDDEN`, `QT_CURSOR_BUSY`\n\n### Frame\n**Shape:** `QT_FRAME_NO_FRAME`, `QT_FRAME_BOX`, `QT_FRAME_PANEL`, `QT_FRAME_WIN_PANEL`, `QT_FRAME_HLINE`, `QT_FRAME_VLINE`, `QT_FRAME_STYLED_PANEL`\n\n**Shadow:** `QT_FRAME_PLAIN`, `QT_FRAME_RAISED`, `QT_FRAME_SUNKEN`\n\n### Dock Area\n`QT_DOCK_LEFT`, `QT_DOCK_RIGHT`, `QT_DOCK_TOP`, `QT_DOCK_BOTTOM`\n\n### Tray Icon\n`QT_TRAY_NO_ICON`, `QT_TRAY_INFORMATION`, `QT_TRAY_WARNING`, `QT_TRAY_CRITICAL`\n\n### Key Codes\n`QT_KEY_ESCAPE`, `QT_KEY_TAB`, `QT_KEY_BACKTAB`, `QT_KEY_BACKSPACE`, `QT_KEY_RETURN`, `QT_KEY_ENTER`, `QT_KEY_INSERT`, `QT_KEY_DELETE`, `QT_KEY_PAUSE`, `QT_KEY_HOME`, `QT_KEY_END`, `QT_KEY_LEFT`, `QT_KEY_UP`, `QT_KEY_RIGHT`, `QT_KEY_DOWN`, `QT_KEY_PAGE_UP`, `QT_KEY_PAGE_DOWN`, `QT_KEY_F1`..`QT_KEY_F12`, `QT_KEY_SPACE`\n\n### Key Modifiers\n`QT_MOD_NONE`, `QT_MOD_SHIFT`, `QT_MOD_CONTROL`, `QT_MOD_ALT`, `QT_MOD_META`\n\n### Selection\n**Mode:** `QT_SELECT_NO_SELECTION`, `QT_SELECT_SINGLE`, `QT_SELECT_MULTI`, `QT_SELECT_EXTENDED`, `QT_SELECT_CONTIGUOUS`\n\n**Behavior:** `QT_SELECT_ITEMS`, `QT_SELECT_ROWS`, `QT_SELECT_COLUMNS`\n\n### Sort Order\n`QT_SORT_ASCENDING`, `QT_SORT_DESCENDING`\n\n### Check State\n`QT_UNCHECKED`, `QT_PARTIALLY_CHECKED`, `QT_CHECKED`\n\n### Header Resize Mode\n`QT_HEADER_INTERACTIVE`, `QT_HEADER_STRETCH`, `QT_HEADER_FIXED`, `QT_HEADER_RESIZE_TO_CONTENTS`\n\n### Edit Triggers\n`QT_NO_EDIT_TRIGGERS`, `QT_EDIT_DOUBLE_CLICK`, `QT_EDIT_SELECTED_CLICK`, `QT_EDIT_ANY_KEY_PRESSED`, `QT_EDIT_ALL_TRIGGERS`\n\n### Flow Direction\n`QT_FLOW_TOP_TO_BOTTOM`, `QT_FLOW_LEFT_TO_RIGHT`\n\n### Day of Week\n`QT_MONDAY`, `QT_TUESDAY`, `QT_WEDNESDAY`, `QT_THURSDAY`, `QT_FRIDAY`, `QT_SATURDAY`, `QT_SUNDAY`\n\n## Architecture\n\nThe binding uses a three-layer architecture:\n\n1. **C++ shim** (`vendor/qt_shim.h`, `vendor/qt_shim.cpp` in qt-vendor) -- thin `extern \"C\"` wrappers around Qt6 C++ classes. All Qt objects are opaque `void*` handles. Compiled as `libqt_shim.so`.\n\n2. **Chez callback bridge** (`jerboa_qt_shim.c`) -- stores Chez-provided `foreign-callable` function pointers and provides C wrapper functions that pass them to the C++ shim's signal connection APIs. Unlike Gambit's compile-time `c-define` trampolines, Chez creates callback pointers at runtime.\n\n3. **FFI layer** (`jerboa-qt/ffi.ss`) -- Chez `foreign-procedure` bindings for each C function. Loads `libqt_shim.so` and `jerboa_qt_shim.so` at library import time. Registers the four callback trampolines (void/string/int/bool) that dispatch to Scheme closures via a callback table.\n\n4. **High-level API** (`jerboa-qt/qt.ss`) -- Idiomatic Chez Scheme wrappers with boolean conversions, the `with-qt-app` macro, and all the `qt-on-*!` signal registration functions.\n\n### Callback Pattern\n\nQt signals are connected to Scheme handlers through a callback trampoline system:\n\n```\nQt signal -> C++ lambda -> chez_qt_*() wrapper -> foreign-callable trampoline\n -> callback table lookup -> user's Scheme closure\n```\n\nFour callback types cover all signals: `void`, `string(text)`, `int(value)`, `bool(checked)`.\n\nAll `qt-on-*!` signal registration functions return a callback ID (integer). Use `unregister-qt-handler!` to remove a specific callback, or `qt-disconnect-all!` to disconnect all signals from a QObject.\n\n### Memory Management\n\nQt uses parent-child ownership: destroying a parent automatically destroys all children. No GC finalizers are used on parented widgets. The QApplication must be explicitly destroyed (or use `with-qt-app`).\n\n## Examples\n\n| Example | Description |\n|---------|-------------|\n| `hello.ss` | Minimal window with label |\n| `counter.ss` | Button click counter |\n| `form.ss` | Form with text inputs, checkboxes, combo box, spin box, message boxes |\n| `editor.ss` | Text editor with menus, toolbar, keyboard shortcuts, file I/O |\n| `dashboard.ss` | Tabbed dashboard with todo list, data table, slider + progress bar |\n| `filebrowser.ss` | File browser with tree view, grid layout, timer clock, clipboard |\n| `styled.ss` | Dark-themed split-pane app with scroll area, key events, fullscreen toggle |\n| `settings.ss` | Settings dialog with radio buttons, button groups, group boxes, dark theme |\n| `painter.ss` | QPainter demo with shapes, text, transforms, compositing |\n| `datainput.ss` | Double spin box, date/time pickers, frames, progress dialog, input dialogs |\n| `planner.ss` | Event planner with form layout, calendar, rich text preview, dialog buttons, shortcuts |\n| `autocomplete.ss` | Search with auto-complete, persistent history (QSettings), tooltips |\n| `modelviewer.ss` | Model/View with sortable table, live text filter, tree hierarchy |\n| `polished.ss` | Validated inputs, tool buttons, log area, size policies |\n| `diagram.ss` | Interactive diagram with QGraphicsScene/View and custom PaintWidget |\n| `terminal.ss` | Simple terminal with QProcess, command input, streaming output |\n| `widgets.ss` | QDial + QLCDNumber, QToolBox accordion, QUndoStack undo/redo |\n| `filemanager.ss` | File system browser with QFileSystemModel + QTreeView, filters |\n| `wizard.ss` | Multi-step wizard dialog with QWizard/QWizardPage |\n| `mdi.ss` | Multi-document interface with QMdiArea, undo/redo, tile/cascade |\n| `dockable.ss` | Dock widgets with QDockWidget |\n| `trayapp.ss` | System tray icon with context menu and notifications |\n| `dragdrop.ss` | Drag and drop text between widgets |\n| `keyboard.ss` | Keyboard event handling demo |\n| `dialogs.ss` | All dialog types (message, file, input, color, font) |\n| `richtext.ss` | Rich text editing with QTextBrowser |\n\n## License\n\nMIT\n"} {"text":";; FILE: jerboa-qt/compile-libs.ss\n;;; compile-libs.ss — Compile jerboa-qt libraries\n(import (jerboa-qt ffi) (jerboa-qt qt))\n"} -{"text":";; FILE: jerboa-qt/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-qt/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-qt/qt-test.ss\n;;; qt-test.ss — Test suite for jerboa-qt\n;;;\n;;; Run: make test\n\n(import (chezscheme)\n (jerboa-qt qt))\n\n(define *pass* 0)\n(define *fail* 0)\n(define *skip* 0)\n(define *test-name* \"\")\n(define *run-known-crash-tests*\n (equal? (getenv \"JERBOA_QT_RUN_KNOWN_CRASH_TESTS\") \"1\"))\n(define immediate-exit (foreign-procedure \"_exit\" (int) void))\n\n(define (finish-tests status)\n (flush-output-port (current-output-port))\n (flush-output-port (current-error-port))\n (immediate-exit status))\n\n(define-syntax test-group\n (syntax-rules ()\n [(_ name body ...)\n (begin\n (display (string-append \"\\n=== \" name \" ===\\n\"))\n body ...)]))\n\n(define-syntax test-case\n (syntax-rules ()\n [(_ name body ...)\n (begin\n (set! *test-name* name)\n (guard (e [#t (set! *fail* (+ *fail* 1))\n\t (display (string-append \" FAIL: \" name \"\\n\"))\n\t (display (string-append \" error: \"\n\t (if (message-condition? e)\n\t (condition-message e)\n\t (format \"~s\" e))\n\t \"\\n\"))])\n body ...\n (set! *pass* (+ *pass* 1))\n (display (string-append \" pass: \" name \"\\n\"))))]))\n\n(define (skip-case name reason)\n (set! *skip* (+ *skip* 1))\n (display (string-append \" skip: \" name \" (\" reason \")\\n\")))\n\n(define-syntax check\n (syntax-rules (=> ?)\n [(_ expr => expected)\n (let ([got expr] [exp expected])\n (unless (equal? got exp)\n (error 'check\n (format \"~a: expected ~s, got ~s\" *test-name* exp got))))]\n [(_ expr ? pred)\n (let ([got expr])\n (unless (pred got)\n (error 'check\n (format \"~a: predicate failed for ~s\" *test-name* got))))]))\n\n;; Create the QApplication (required for all Qt tests)\n(define test-app (qt-app-create))\n\n;; ==================== Phase 1: Core ====================\n\n(test-group \"core\"\n (test-case \"application create\"\n (check (not (eqv? test-app 0)) ? values))\n\n (test-case \"main window create\"\n (let ((win (qt-main-window-create)))\n (check (not (eqv? win 0)) ? values)\n (qt-main-window-set-title! win \"Test Window\")\n (qt-widget-destroy! win)))\n\n (test-case \"widget create\"\n (let ((w (qt-widget-create)))\n (check (not (eqv? w 0)) ? values)\n (qt-widget-destroy! w)))\n\n (test-case \"widget enabled round-trip\"\n (let ((w (qt-widget-create)))\n (check (qt-widget-enabled? w) => #t)\n (qt-widget-set-enabled! w #f)\n (check (qt-widget-enabled? w) => #f)\n (qt-widget-set-enabled! w #t)\n (check (qt-widget-enabled? w) => #t)\n (qt-widget-destroy! w)))\n\n (test-case \"widget visible round-trip\"\n (let ((w (qt-widget-create)))\n (check (qt-widget-visible? w) => #f)\n (qt-widget-set-visible! w #t)\n (check (qt-widget-visible? w) => #t)\n (qt-widget-set-visible! w #f)\n (check (qt-widget-visible? w) => #f)\n (qt-widget-destroy! w)))\n\n (test-case \"layout create\"\n (let* ((w (qt-widget-create))\n (vbox (qt-vbox-layout-create w))\n\t (w2 (qt-widget-create))\n\t (hbox (qt-hbox-layout-create w2)))\n\t (check (not (eqv? vbox 0)) ? values)\n\t (check (not (eqv? hbox 0)) ? values)))\n\n (test-case \"label text round-trip\"\n (let ((l (qt-label-create \"hello\")))\n (check (qt-label-text l) => \"hello\")\n (qt-label-set-text! l \"world\")\n (check (qt-label-text l) => \"world\")\n (qt-widget-destroy! l)))\n\n (test-case \"label word wrap\"\n (let ((l (qt-label-create \"long text\")))\n (qt-label-set-word-wrap! l #t)\n (qt-label-set-word-wrap! l #f)\n (qt-widget-destroy! l)))\n\n (test-case \"widget minimum/maximum width and height\"\n (let ((w (qt-widget-create)))\n (qt-widget-set-minimum-width! w 100)\n (qt-widget-set-minimum-height! w 50)\n (qt-widget-set-maximum-width! w 800)\n (qt-widget-set-maximum-height! w 600)\n (qt-widget-destroy! w)))\n\n (test-case \"widget set cursor\"\n (let ((w (qt-widget-create)))\n (qt-widget-set-cursor! w QT_CURSOR_POINTING_HAND)\n (qt-widget-set-cursor! w QT_CURSOR_WAIT)\n (qt-widget-unset-cursor! w)\n (qt-widget-destroy! w)))\n\n (test-case \"push button text round-trip\"\n (let ((b (qt-push-button-create \"Click\")))\n (check (qt-push-button-text b) => \"Click\")\n (qt-push-button-set-text! b \"Press\")\n (check (qt-push-button-text b) => \"Press\")\n (qt-widget-destroy! b)))\n\n (test-case \"button clicked signal registration\"\n (let ((b (qt-push-button-create \"Test\")))\n (qt-on-clicked! b (lambda () #t))\n (qt-widget-destroy! b))))\n\n;; ==================== Phase 2: Core Widgets ====================\n\n(test-group \"core widgets\"\n (test-case \"line edit text round-trip\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-text! e \"test input\")\n (check (qt-line-edit-text e) => \"test input\")\n (qt-line-edit-set-text! e \"\")\n (check (qt-line-edit-text e) => \"\")\n (qt-widget-destroy! e)))\n\n (test-case \"line edit placeholder and read-only\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-placeholder! e \"Enter text...\")\n (qt-line-edit-set-read-only! e #t)\n (qt-widget-destroy! e)))\n\n (test-case \"line edit echo mode\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-echo-mode! e QT_ECHO_PASSWORD)\n (qt-line-edit-set-echo-mode! e QT_ECHO_NORMAL)\n (qt-widget-destroy! e)))\n\n (test-case \"line edit signal registration\"\n (let ((e (qt-line-edit-create)))\n (qt-on-text-changed! e (lambda (text) #t))\n (qt-on-return-pressed! e (lambda () #t))\n (qt-widget-destroy! e)))\n\n (test-case \"check box checked round-trip\"\n (let ((c (qt-check-box-create \"Option\")))\n (check (qt-check-box-checked? c) => #f)\n (qt-check-box-set-checked! c #t)\n (check (qt-check-box-checked? c) => #t)\n (qt-check-box-set-checked! c #f)\n (check (qt-check-box-checked? c) => #f)\n (qt-widget-destroy! c)))\n\n (test-case \"check box set text\"\n (let ((c (qt-check-box-create \"Before\")))\n (qt-check-box-set-text! c \"After\")\n (qt-widget-destroy! c)))\n\n (test-case \"check box signal registration\"\n (let ((c (qt-check-box-create \"Test\")))\n (qt-on-toggled! c (lambda (checked) #t))\n (qt-widget-destroy! c)))\n\n (test-case \"combo box add items and round-trip\"\n (let ((c (qt-combo-box-create)))\n (check (qt-combo-box-count c) => 0)\n (qt-combo-box-add-item! c \"Apple\")\n (qt-combo-box-add-item! c \"Banana\")\n (qt-combo-box-add-item! c \"Cherry\")\n (check (qt-combo-box-count c) => 3)\n (check (qt-combo-box-current-index c) => 0)\n (check (qt-combo-box-current-text c) => \"Apple\")\n (qt-combo-box-set-current-index! c 2)\n (check (qt-combo-box-current-index c) => 2)\n (check (qt-combo-box-current-text c) => \"Cherry\")\n (qt-widget-destroy! c)))\n\n (test-case \"combo box clear\"\n (let ((c (qt-combo-box-create)))\n (qt-combo-box-add-item! c \"X\")\n (qt-combo-box-add-item! c \"Y\")\n (check (qt-combo-box-count c) => 2)\n (qt-combo-box-clear! c)\n (check (qt-combo-box-count c) => 0)\n (qt-widget-destroy! c)))\n\n (test-case \"combo box signal registration\"\n (let ((c (qt-combo-box-create)))\n (qt-on-index-changed! c (lambda (idx) #t))\n (qt-widget-destroy! c)))\n\n (test-case \"text edit text round-trip\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Hello World\")\n (check (qt-text-edit-text e) => \"Hello World\")\n (qt-widget-destroy! e)))\n\n (test-case \"text edit append and clear\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Line 1\")\n (qt-text-edit-append! e \"Line 2\")\n (qt-text-edit-clear! e)\n (check (qt-text-edit-text e) => \"\")\n (qt-widget-destroy! e)))\n\n (test-case \"text edit html\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Hello World\")\n (let ((html (qt-text-edit-html e)))\n (check (string? html) ? values))\n (qt-widget-destroy! e)))\n\n (test-case \"text edit signal registration\"\n (let ((e (qt-text-edit-create)))\n (qt-on-text-edit-changed! e (lambda () #t))\n (qt-widget-destroy! e)))\n\n (test-case \"spin box value round-trip\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-range! s 0 100)\n (qt-spin-box-set-value! s 42)\n (check (qt-spin-box-value s) => 42)\n (qt-spin-box-set-value! s 0)\n (check (qt-spin-box-value s) => 0)\n (qt-widget-destroy! s)))\n\n (test-case \"spin box range clamping\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-range! s 10 50)\n (qt-spin-box-set-value! s 100)\n (check (qt-spin-box-value s) => 50)\n (qt-spin-box-set-value! s -5)\n (check (qt-spin-box-value s) => 10)\n (qt-widget-destroy! s)))\n\n (test-case \"spin box prefix and suffix\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-prefix! s \"$\")\n (qt-spin-box-set-suffix! s \" USD\")\n (qt-widget-destroy! s)))\n\n (test-case \"spin box signal registration\"\n (let ((s (qt-spin-box-create)))\n (qt-on-value-changed! s (lambda (val) #t))\n (qt-widget-destroy! s)))\n\n (test-case \"dialog create\"\n (let ((d (qt-dialog-create)))\n (qt-dialog-set-title! d \"Test Dialog\")\n (qt-widget-destroy! d))))\n\n;; ==================== Constants ====================\n\n(test-group \"constants\"\n (test-case \"echo mode constants\"\n (check QT_ECHO_NORMAL => 0)\n (check QT_ECHO_NO_ECHO => 1)\n (check QT_ECHO_PASSWORD => 2)\n (check QT_ECHO_PASSWORD_ON_EDIT => 3))\n\n (test-case \"alignment constants\"\n (check QT_ALIGN_LEFT => #x0001)\n (check QT_ALIGN_RIGHT => #x0002)\n (check QT_ALIGN_CENTER => #x0084)\n (check QT_ALIGN_TOP => #x0020)\n (check QT_ALIGN_BOTTOM => #x0040))\n\n (test-case \"orientation constants\"\n (check QT_HORIZONTAL => #x1)\n (check QT_VERTICAL => #x2)))\n\n;; ==================== Phase 3: Menus, Actions, Toolbars ====================\n\n(test-group \"menus and actions\"\n (test-case \"menu bar from main window\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win)))\n (check (not (eqv? bar 0)) ? values)\n (qt-widget-destroy! win)))\n\n (test-case \"menu and submenu creation\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win))\n (file-menu (qt-menu-bar-add-menu bar \"File\"))\n (sub-menu (qt-menu-add-menu file-menu \"Recent\")))\n (check (not (eqv? file-menu 0)) ? values)\n (check (not (eqv? sub-menu 0)) ? values)\n (qt-widget-destroy! win)))\n\n (test-case \"action create and text round-trip\"\n (let ((a (qt-action-create \"Open\")))\n (check (qt-action-text a) => \"Open\")\n (qt-action-set-text! a \"Close\")\n (check (qt-action-text a) => \"Close\")))\n\n (test-case \"action enabled round-trip\"\n (let ((a (qt-action-create \"Test\")))\n (check (qt-action-enabled? a) => #t)\n (qt-action-set-enabled! a #f)\n (check (qt-action-enabled? a) => #f)\n (qt-action-set-enabled! a #t)\n (check (qt-action-enabled? a) => #t)))\n\n (test-case \"action checkable round-trip\"\n (let ((a (qt-action-create \"Toggle\")))\n (check (qt-action-checkable? a) => #f)\n (qt-action-set-checkable! a #t)\n (check (qt-action-checkable? a) => #t)\n (qt-action-set-checked! a #t)\n (check (qt-action-checked? a) => #t)\n (qt-action-set-checked! a #f)\n (check (qt-action-checked? a) => #f)))\n\n (test-case \"action shortcut and tips\"\n (let ((a (qt-action-create \"Save\")))\n (qt-action-set-shortcut! a \"Ctrl+S\")\n (qt-action-set-tooltip! a \"Save file\")\n (qt-action-set-status-tip! a \"Save current file\")))\n\n (test-case \"action signal registration\"\n (let ((a (qt-action-create \"Act\")))\n (qt-on-triggered! a (lambda () #t))\n (qt-action-set-checkable! a #t)\n (qt-on-action-toggled! a (lambda (checked) #t))))\n\n (test-case \"menu add action and separator\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win))\n (menu (qt-menu-bar-add-menu bar \"Edit\"))\n (act (qt-action-create \"Cut\")))\n (qt-menu-add-action! menu act)\n (qt-menu-add-separator! menu)\n (qt-widget-destroy! win)))\n\n (test-case \"toolbar create and add action\"\n (let* ((win (qt-main-window-create))\n (tb (qt-toolbar-create \"Main\")))\n (qt-main-window-add-toolbar! win tb)\n (let ((act (qt-action-create \"Toolbar Action\")))\n (qt-toolbar-add-action! tb act)\n (qt-toolbar-add-separator! tb))\n (qt-toolbar-set-movable! tb #f)\n (qt-toolbar-set-icon-size! tb 24 24)\n (qt-widget-destroy! win)))\n\n (test-case \"toolbar add widget\"\n (let* ((win (qt-main-window-create))\n (tb (qt-toolbar-create \"Tools\"))\n (btn (qt-push-button-create \"TB Button\")))\n (qt-main-window-add-toolbar! win tb)\n (qt-toolbar-add-widget! tb btn)\n (qt-widget-destroy! win)))\n\n (test-case \"status bar text\"\n (let ((win (qt-main-window-create)))\n (qt-main-window-set-status-bar-text! win \"Ready\")\n (qt-widget-destroy! win))))\n\n;; ==================== Phase 4: Advanced Widgets ====================\n\n(test-group \"list widget\"\n (test-case \"list widget add and count\"\n (let ((l (qt-list-widget-create)))\n (check (qt-list-widget-count l) => 0)\n (qt-list-widget-add-item! l \"Item 1\")\n (qt-list-widget-add-item! l \"Item 2\")\n (qt-list-widget-add-item! l \"Item 3\")\n (check (qt-list-widget-count l) => 3)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget item text\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"Alpha\")\n (qt-list-widget-add-item! l \"Beta\")\n (qt-list-widget-add-item! l \"Gamma\")\n (check (qt-list-widget-item-text l 0) => \"Alpha\")\n (check (qt-list-widget-item-text l 1) => \"Beta\")\n (check (qt-list-widget-item-text l 2) => \"Gamma\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget insert item\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"First\")\n (qt-list-widget-add-item! l \"Third\")\n (qt-list-widget-insert-item! l 1 \"Second\")\n (check (qt-list-widget-count l) => 3)\n (check (qt-list-widget-item-text l 0) => \"First\")\n (check (qt-list-widget-item-text l 1) => \"Second\")\n (check (qt-list-widget-item-text l 2) => \"Third\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget remove item\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"A\")\n (qt-list-widget-add-item! l \"B\")\n (qt-list-widget-add-item! l \"C\")\n (qt-list-widget-remove-item! l 1)\n (check (qt-list-widget-count l) => 2)\n (check (qt-list-widget-item-text l 0) => \"A\")\n (check (qt-list-widget-item-text l 1) => \"C\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget current row\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"X\")\n (qt-list-widget-add-item! l \"Y\")\n (qt-list-widget-set-current-row! l 1)\n (check (qt-list-widget-current-row l) => 1)\n (qt-list-widget-set-current-row! l 0)\n (check (qt-list-widget-current-row l) => 0)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget clear\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"A\")\n (qt-list-widget-add-item! l \"B\")\n (check (qt-list-widget-count l) => 2)\n (qt-list-widget-clear! l)\n (check (qt-list-widget-count l) => 0)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget signal registration\"\n (let ((l (qt-list-widget-create)))\n (qt-on-current-row-changed! l (lambda (row) #t))\n (qt-on-item-double-clicked! l (lambda (row) #t))\n (qt-widget-destroy! l)))\n\n (test-case \"list widget item data round-trip\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"Visible Text\")\n (qt-list-widget-set-item-data! l 0 \"hidden-id-123\")\n (check (qt-list-widget-item-data l 0) => \"hidden-id-123\")\n (check (qt-list-widget-item-text l 0) => \"Visible Text\")\n (qt-widget-destroy! l))))\n\n(test-group \"table widget\"\n (test-case \"table widget create with dimensions\"\n (let ((t (qt-table-widget-create 3 4)))\n (check (qt-table-widget-row-count t) => 3)\n (check (qt-table-widget-column-count t) => 4)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget set/get item text\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-item! t 0 0 \"A1\")\n (qt-table-widget-set-item! t 0 1 \"B1\")\n (qt-table-widget-set-item! t 1 0 \"A2\")\n (qt-table-widget-set-item! t 1 1 \"B2\")\n (check (qt-table-widget-item-text t 0 0) => \"A1\")\n (check (qt-table-widget-item-text t 0 1) => \"B1\")\n (check (qt-table-widget-item-text t 1 0) => \"A2\")\n (check (qt-table-widget-item-text t 1 1) => \"B2\")\n (qt-widget-destroy! t)))\n\n ;; Known external qt_shim limitation: empty cells currently return a null\n ;; const char*, which cannot cross Chez FFI as a string.\n\n (test-case \"table widget resize row/column counts\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-row-count! t 5)\n (qt-table-widget-set-column-count! t 3)\n (check (qt-table-widget-row-count t) => 5)\n (check (qt-table-widget-column-count t) => 3)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget header items\"\n (let ((t (qt-table-widget-create 2 3)))\n (qt-table-widget-set-horizontal-header! t 0 \"Name\")\n (qt-table-widget-set-horizontal-header! t 1 \"Age\")\n (qt-table-widget-set-horizontal-header! t 2 \"City\")\n (qt-table-widget-set-vertical-header! t 0 \"Row 1\")\n (qt-table-widget-set-vertical-header! t 1 \"Row 2\")\n (qt-widget-destroy! t)))\n\n (test-case \"table widget clear\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-item! t 0 0 \"data\")\n (qt-table-widget-clear! t)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget signal registration\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-on-cell-clicked! t (lambda () #t))\n (qt-widget-destroy! t))))\n\n(test-group \"tab widget\"\n (test-case \"tab widget add tabs\"\n (let* ((tw (qt-tab-widget-create))\n (page1 (qt-widget-create))\n (page2 (qt-widget-create)))\n (check (qt-tab-widget-count tw) => 0)\n (qt-tab-widget-add-tab! tw page1 \"Tab 1\")\n (qt-tab-widget-add-tab! tw page2 \"Tab 2\")\n (check (qt-tab-widget-count tw) => 2)\n (qt-widget-destroy! tw)))\n\n (test-case \"tab widget current index\"\n (let* ((tw (qt-tab-widget-create))\n (page1 (qt-widget-create))\n (page2 (qt-widget-create)))\n (qt-tab-widget-add-tab! tw page1 \"Tab 1\")\n (qt-tab-widget-add-tab! tw page2 \"Tab 2\")\n (check (qt-tab-widget-current-index tw) => 0)\n (qt-tab-widget-set-current-index! tw 1)\n (check (qt-tab-widget-current-index tw) => 1)\n (qt-widget-destroy! tw)))\n\n (test-case \"tab widget signal registration\"\n (let ((tw (qt-tab-widget-create)))\n (qt-on-tab-changed! tw (lambda (idx) #t))\n (qt-widget-destroy! tw))))\n\n(test-group \"tree widget\"\n (test-case \"tree widget create\"\n (let ((t (qt-tree-widget-create)))\n (qt-tree-widget-set-column-count! t 2)\n (check (qt-tree-widget-column-count t) => 2)\n (qt-tree-widget-set-header-label! t \"Name\")\n (qt-widget-destroy! t)))\n\n (test-case \"tree widget items\"\n (let ((t (qt-tree-widget-create)))\n (qt-tree-widget-set-column-count! t 1)\n (let ((item (qt-tree-item-create \"Root\")))\n (qt-tree-widget-add-top-level-item! t item)\n (check (qt-tree-widget-top-level-item-count t) => 1)\n (check (qt-tree-item-text item 0) => \"Root\")\n (let ((child (qt-tree-item-create \"Child\")))\n (qt-tree-item-add-child! item child)\n (check (qt-tree-item-child-count item) => 1)))\n (qt-widget-destroy! t)))\n\n (test-case \"tree widget signals\"\n (let ((t (qt-tree-widget-create)))\n (qt-on-current-item-changed! t (lambda () #t))\n (qt-on-tree-item-double-clicked! t (lambda () #t))\n (qt-on-item-expanded! t (lambda () #t))\n (qt-on-item-collapsed! t (lambda () #t))\n (qt-widget-destroy! t))))\n\n;; ==================== Phase 5: Timer, Clipboard ====================\n\n(test-group \"timer\"\n (test-case \"timer create and configure\"\n (let ((tm (qt-timer-create)))\n (qt-timer-set-interval! tm 1000)\n (check (qt-timer-interval tm) => 1000)\n (qt-timer-set-single-shot! tm #t)\n (qt-on-timeout! tm (lambda () #t))\n (qt-timer-destroy! tm)))\n\n (test-case \"timer start/stop\"\n (let ((tm (qt-timer-create)))\n (qt-timer-set-interval! tm 500)\n (check (qt-timer-active? tm) => #f)\n (qt-timer-start! tm 500)\n (check (qt-timer-active? tm) => #t)\n (qt-timer-stop! tm)\n (check (qt-timer-active? tm) => #f)\n (qt-timer-destroy! tm))))\n\n(test-group \"clipboard\"\n (test-case \"clipboard text round-trip\"\n (qt-clipboard-set-text! test-app \"jerboa-qt test\")\n (check (qt-clipboard-text test-app) => \"jerboa-qt test\")))\n\n;; ==================== Phase 6: Keyboard, Window State ====================\n\n(test-group \"keyboard and window state\"\n (test-case \"key handler registration\"\n (let ((w (qt-widget-create)))\n (qt-on-key-press! w (lambda () #t))\n (qt-widget-destroy! w)))\n\n (test-case \"window state functions\"\n (let ((win (qt-main-window-create)))\n (qt-widget-show-minimized! win)\n (qt-widget-show-normal! win)\n (qt-widget-move! win 100 100)\n (qt-widget-destroy! win)))\n\n (test-case \"widget geometry\"\n (let ((w (qt-widget-create)))\n (qt-widget-resize! w 200 150)\n (qt-widget-destroy! w))))\n\n;; ==================== Phase 7: Pixmap, Icon, Radio, Groups ====================\n\n(test-group \"radio buttons and groups\"\n (test-case \"radio button create\"\n (let ((r (qt-radio-button-create \"Option A\")))\n (check (qt-radio-button-text r) => \"Option A\")\n (qt-radio-button-set-text! r \"Option B\")\n (check (qt-radio-button-text r) => \"Option B\")\n (qt-widget-destroy! r)))\n\n (test-case \"radio button checked round-trip\"\n (let ((r (qt-radio-button-create \"Test\")))\n (check (qt-radio-button-checked? r) => #f)\n (qt-radio-button-set-checked! r #t)\n (check (qt-radio-button-checked? r) => #t)\n (qt-widget-destroy! r)))\n\n (test-case \"radio button signal registration\"\n (let ((r (qt-radio-button-create \"Test\")))\n (qt-on-radio-toggled! r (lambda (checked) #t))\n (qt-widget-destroy! r)))\n\n (test-case \"button group\"\n (let ((bg (qt-button-group-create))\n (r1 (qt-radio-button-create \"A\"))\n (r2 (qt-radio-button-create \"B\")))\n (qt-button-group-add-button! bg r1 0)\n (qt-button-group-add-button! bg r2 1)\n (qt-button-group-set-exclusive! bg #t)\n (check (qt-button-group-exclusive? bg) => #t)\n (qt-on-button-group-clicked! bg (lambda (id) #t))\n (qt-button-group-destroy! bg)\n (qt-widget-destroy! r1)\n (qt-widget-destroy! r2)))\n\n (test-case \"group box\"\n (let ((gb (qt-group-box-create \"Settings\")))\n (check (qt-group-box-title gb) => \"Settings\")\n (qt-group-box-set-title! gb \"Options\")\n (check (qt-group-box-title gb) => \"Options\")\n (qt-group-box-set-checkable! gb #t)\n (check (qt-group-box-checkable? gb) => #t)\n (qt-group-box-set-checked! gb #f)\n (check (qt-group-box-checked? gb) => #f)\n (qt-on-group-box-toggled! gb (lambda (checked) #t))\n (qt-widget-destroy! gb))))\n\n;; ==================== Phase 8: Font, Color ====================\n\n(test-group \"font and color\"\n (test-case \"font create and query\"\n (let ((f (qt-font-create \"Monospace\" 12)))\n (check (string? (qt-font-family f)) ? values)\n (check (qt-font-point-size f) => 12)\n (qt-font-set-bold! f #t)\n (check (qt-font-bold? f) => #t)\n (qt-font-set-italic! f #t)\n (check (qt-font-italic? f) => #t)\n (qt-font-destroy! f)))\n\n (test-case \"font set on widget\"\n (let ((w (qt-widget-create))\n (f (qt-font-create \"Sans\" 14)))\n (qt-widget-set-font! w f)\n (qt-font-destroy! f)\n (qt-widget-destroy! w)))\n\n (test-case \"color create and query\"\n (let ((c (qt-color-create 255 128 0 255)))\n (check (qt-color-red c) => 255)\n (check (qt-color-green c) => 128)\n (check (qt-color-blue c) => 0)\n (check (qt-color-alpha c) => 255)\n (check (qt-color-valid? c) => #t)\n (qt-color-destroy! c)))\n\n (test-case \"color create from name\"\n (let ((c (qt-color-create-name \"red\")))\n (check (qt-color-valid? c) => #t)\n (check (qt-color-red c) => 255)\n (qt-color-destroy! c))))\n\n;; ==================== Phase 8b: Scroll Area, Splitter, Progress, Slider ====================\n\n(test-group \"scroll area and splitter\"\n (test-case \"scroll area create\"\n (let ((sa (qt-scroll-area-create))\n (content (qt-widget-create)))\n (qt-scroll-area-set-widget! sa content)\n (qt-scroll-area-set-widget-resizable! sa #t)\n (qt-scroll-area-set-horizontal-scrollbar-policy! sa QT_SCROLLBAR_ALWAYS_OFF)\n (qt-scroll-area-set-vertical-scrollbar-policy! sa QT_SCROLLBAR_AS_NEEDED)\n (qt-widget-destroy! sa)))\n\n (test-case \"splitter create\"\n (let ((sp (qt-splitter-create QT_HORIZONTAL))\n (w1 (qt-widget-create))\n (w2 (qt-widget-create)))\n (qt-splitter-add-widget! sp w1)\n (qt-splitter-add-widget! sp w2)\n (check (qt-splitter-count sp) => 2)\n (qt-splitter-set-handle-width! sp 5)\n (qt-widget-destroy! sp))))\n\n(test-group \"progress bar\"\n (test-case \"progress bar value round-trip\"\n (let ((p (qt-progress-bar-create)))\n (qt-progress-bar-set-range! p 0 100)\n (qt-progress-bar-set-value! p 50)\n (check (qt-progress-bar-value p) => 50)\n (qt-progress-bar-set-format! p \"%p%\")\n (qt-widget-destroy! p))))\n\n(test-group \"slider\"\n (test-case \"slider value round-trip\"\n (let ((s (qt-slider-create QT_HORIZONTAL)))\n (qt-slider-set-range! s 0 100)\n (qt-slider-set-value! s 75)\n (check (qt-slider-value s) => 75)\n (qt-slider-set-single-step! s 5)\n (qt-slider-set-tick-interval! s 10)\n (qt-slider-set-tick-position! s QT_TICKS_BELOW)\n (qt-widget-destroy! s)))\n\n (test-case \"slider signal registration\"\n (let ((s (qt-slider-create QT_HORIZONTAL)))\n (qt-on-slider-value-changed! s (lambda (val) #t))\n (qt-widget-destroy! s))))\n\n;; ==================== Grid Layout ====================\n\n(test-group \"grid layout\"\n (if *run-known-crash-tests*\n (test-case \"grid layout create and add widgets\"\n (let* ((w (qt-widget-create))\n (grid (qt-grid-layout-create w))\n (l1 (qt-label-create \"Name:\"))\n (e1 (qt-line-edit-create)))\n (qt-grid-layout-add-widget! grid l1 0 0)\n (qt-grid-layout-add-widget! grid e1 0 1)\n (qt-grid-layout-set-row-stretch! grid 0 1)\n (qt-grid-layout-set-column-stretch! grid 1 2)))\n (skip-case \"grid layout create and add widgets\"\n \"set JERBOA_QT_RUN_KNOWN_CRASH_TESTS=1 to reproduce external qt_shim teardown crash\")))\n\n;; -----------------------------------------------------------------\n;; Summary\n\n(newline)\n(let ([status (if (zero? *fail*) 0 1)])\n (printf \"~a tests passed\\n\" *pass*)\n (when (> *skip* 0)\n (printf \"~a tests skipped\\n\" *skip*))\n (when (> *fail* 0)\n (printf \"~a tests FAILED\\n\" *fail*))\n (finish-tests status))\n"} {"text":";; FILE: jerboa-qt/examples/form.ss\n#!/bin/sh\n#|\nJERBOA_QT_DIR=\"$(cd \"$(dirname \"$0\")/..\" && pwd)\"\nJH=\"$(jerbuild --jerboa-home 2>/dev/null)\"\nif [ -z \"$JH\" ]; then\n echo \"jerbuild --jerboa-home failed\" >&2\n exit 1\nfi\nQT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\"\nexport JERBOA_QT_LIB=\"$JERBOA_QT_DIR\"\nexport JERBOA_QT_SHIM_DIR=\"$QT_SHIM_DIR\"\nexport DYLD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${DYLD_LIBRARY_PATH:-}\"\nexport LD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${LD_LIBRARY_PATH:-}\"\nexec jerbuild exec --libdirs \"$JERBOA_QT_DIR/lib:$JH/lib\" \"$0\" \"$@\"\n|#\n;;; Form example: exercises Phase 2 widgets\n;;; QLineEdit, QCheckBox, QComboBox, QSpinBox, QPushButton + QMessageBox\n\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n ;; Name input\n (name-edit (qt-line-edit-create))\n ;; Color selector\n (color-combo (qt-combo-box-create))\n ;; Age spinner\n (age-spin (qt-spin-box-create))\n ;; Newsletter toggle\n (news-check (qt-check-box-create \"Subscribe to newsletter\"))\n ;; Submit button\n (submit-btn (qt-push-button-create \"Submit\")))\n\n ;; Configure name input\n (qt-line-edit-set-placeholder! name-edit \"Enter your name...\")\n\n ;; Configure color selector\n (qt-combo-box-add-item! color-combo \"Red\")\n (qt-combo-box-add-item! color-combo \"Green\")\n (qt-combo-box-add-item! color-combo \"Blue\")\n (qt-combo-box-add-item! color-combo \"Yellow\")\n\n ;; Configure age spinner\n (qt-spin-box-set-range! age-spin 1 120)\n (qt-spin-box-set-value! age-spin 25)\n (qt-spin-box-set-suffix! age-spin \" years\")\n\n ;; Add widgets with labels\n (let ((name-label (qt-label-create \"Name:\"))\n (color-label (qt-label-create \"Favorite color:\"))\n (age-label (qt-label-create \"Age:\")))\n (qt-layout-add-widget! layout name-label)\n (qt-layout-add-widget! layout name-edit)\n (qt-layout-add-widget! layout color-label)\n (qt-layout-add-widget! layout color-combo)\n (qt-layout-add-widget! layout age-label)\n (qt-layout-add-widget! layout age-spin)\n (qt-layout-add-widget! layout news-check)\n (qt-layout-add-widget! layout submit-btn))\n\n (qt-layout-set-spacing! layout 8)\n (qt-layout-set-margins! layout 16 16 16 16)\n\n ;; Submit button shows summary in a message box\n (qt-on-clicked! submit-btn\n (lambda ()\n (let ((name (qt-line-edit-text name-edit))\n (color (qt-combo-box-current-text color-combo))\n (age (qt-spin-box-value age-spin))\n (subscribed (qt-check-box-checked? news-check)))\n (qt-message-box-information win \"Form Summary\"\n (string-append\n \"Name: \" name \"\\n\"\n \"Color: \" color \"\\n\"\n \"Age: \" (number->string age) \"\\n\"\n \"Newsletter: \" (if subscribed \"Yes\" \"No\"))))))\n\n (qt-main-window-set-title! win \"Form Demo\")\n (qt-main-window-set-central-widget! win central)\n (qt-widget-resize! win 350 350)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n"} {"text":";; FILE: jerboa-qt/examples/wizard.ss\n#!/bin/sh\n#|\nJERBOA_QT_DIR=\"$(cd \"$(dirname \"$0\")/..\" && pwd)\"\nJH=\"$(jerbuild --jerboa-home 2>/dev/null)\"\nif [ -z \"$JH\" ]; then\n echo \"jerbuild --jerboa-home failed\" >&2\n exit 1\nfi\nQT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\"\nexport JERBOA_QT_LIB=\"$JERBOA_QT_DIR\"\nexport JERBOA_QT_SHIM_DIR=\"$QT_SHIM_DIR\"\nexport DYLD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${DYLD_LIBRARY_PATH:-}\"\nexport LD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${LD_LIBRARY_PATH:-}\"\nexec jerbuild exec --libdirs \"$JERBOA_QT_DIR/lib:$JH/lib\" \"$0\" \"$@\"\n|#\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n (launch-btn (qt-push-button-create \"Launch Wizard\"))\n (status (qt-label-create \"Click to start the wizard\"))\n (result-label (qt-label-create \"\")))\n ;; wizard launcher\n (qt-on-clicked! launch-btn\n (lambda ()\n (let* ((wiz (qt-wizard-create win))\n ;; page 1: welcome\n (page1 (qt-wizard-page-create))\n (p1-layout (qt-vbox-layout-create page1))\n (p1-label (qt-label-create \"Welcome to the jerboa-qt Wizard.\\nThis demonstrates wizard pages with various controls.\"))\n ;; page 2: radio buttons\n (page2 (qt-wizard-page-create))\n (p2-layout (qt-vbox-layout-create page2))\n (p2-label (qt-label-create \"Choose your preference:\"))\n (radio1 (qt-radio-button-create \"Option A\"))\n (radio2 (qt-radio-button-create \"Option B\"))\n (radio3 (qt-radio-button-create \"Option C\"))\n (btn-group (qt-button-group-create))\n ;; page 3: checkboxes in group box\n (page3 (qt-wizard-page-create))\n (p3-layout (qt-vbox-layout-create page3))\n (group-box (qt-group-box-create \"Features\"))\n (gb-layout (qt-vbox-layout-create group-box))\n (cb1 (qt-check-box-create \"Feature 1\"))\n (cb2 (qt-check-box-create \"Feature 2\"))\n (cb3 (qt-check-box-create \"Feature 3\"))\n ;; page 4: summary\n (page4 (qt-wizard-page-create))\n (p4-layout (qt-vbox-layout-create page4))\n (summary (qt-label-create \"Click Finish to complete.\")))\n ;; page 1\n (qt-wizard-page-set-title! page1 \"Welcome\")\n (qt-label-set-word-wrap! p1-label #t)\n (qt-layout-add-widget! p1-layout p1-label)\n ;; page 2\n (qt-wizard-page-set-title! page2 \"Preferences\")\n (qt-layout-add-widget! p2-layout p2-label)\n (qt-layout-add-widget! p2-layout radio1)\n (qt-layout-add-widget! p2-layout radio2)\n (qt-layout-add-widget! p2-layout radio3)\n (qt-button-group-add-button! btn-group radio1 0)\n (qt-button-group-add-button! btn-group radio2 1)\n (qt-button-group-add-button! btn-group radio3 2)\n (qt-radio-button-set-checked! radio1 #t)\n (qt-on-button-group-clicked! btn-group\n (lambda (id)\n (qt-label-set-text! status (format #f \"Selected option ~a\" id))))\n ;; page 3\n (qt-wizard-page-set-title! page3 \"Features\")\n (qt-group-box-set-checkable! group-box #t)\n (qt-group-box-set-checked! group-box #t)\n (qt-layout-add-widget! gb-layout cb1)\n (qt-layout-add-widget! gb-layout cb2)\n (qt-layout-add-widget! gb-layout cb3)\n (qt-check-box-set-checked! cb1 #t)\n (qt-layout-add-widget! p3-layout group-box)\n (qt-on-group-box-toggled! group-box\n (lambda (checked)\n (qt-label-set-text! status\n (if checked \"Features enabled\" \"Features disabled\"))))\n ;; page 4\n (qt-wizard-page-set-title! page4 \"Summary\")\n (qt-layout-add-widget! p4-layout summary)\n ;; add pages\n (qt-wizard-add-page! wiz page1)\n (qt-wizard-add-page! wiz page2)\n (qt-wizard-add-page! wiz page3)\n (qt-wizard-add-page! wiz page4)\n ;; wizard signals\n (qt-on-wizard-current-changed! wiz\n (lambda (id)\n (qt-label-set-text! status (format #f \"Wizard page: ~a\" id))))\n (qt-wizard-set-title! wiz \"jerboa-qt Wizard\")\n (qt-widget-resize! wiz 500 400)\n ;; run\n (let ((result (qt-wizard-exec! wiz)))\n (qt-label-set-text! result-label\n (if (= result 1) \"Wizard completed!\" \"Wizard cancelled.\"))))))\n ;; main layout\n (qt-label-set-alignment! status QT_ALIGN_CENTER)\n (qt-label-set-alignment! result-label QT_ALIGN_CENTER)\n (qt-layout-add-stretch! layout)\n (qt-layout-add-widget! layout launch-btn)\n (qt-layout-add-spacing! layout 10)\n (qt-layout-add-widget! layout status)\n (qt-layout-add-widget! layout result-label)\n (qt-layout-add-stretch! layout)\n ;; window\n (qt-main-window-set-title! win \"Wizard Demo\")\n (qt-main-window-set-central-widget! win central)\n (qt-widget-resize! win 400 300)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n"} @@ -2361,7 +2361,7 @@ {"text":";; FILE: jerboa-code/README.md\n# jerboa-code\n\n**A portable AI coding agent written in [Jerboa](https://git.sr.ht/~lisp/jerboa) Scheme.**\n\n`jcode` is a terminal coding agent — think opencode / aider / Claude Code — that\ncompiles to a standalone binary without a Node or Python runtime. It talks to 14\nLLM providers (cloud and local), drives your editor through a real tool loop,\nand ships a reliability layer that makes even small self-hosted models call\ntools dependably.\n\n```\n┌────────────────────────────────────────────────────────────────┐\n│ jcode BUILD · sonnet │\n│ │\n│ › add a --json flag to the status command │\n│ │\n│ ● read src/cli.ss │\n│ ● edit src/cli.ss (+12 −1) │\n│ ● bash make test 411 passed, 0 failed │\n│ │\n│ Done — `--json` emits the status block as a JSON object. │\n└────────────────────────────────────────────────────────────────┘\n```\n\n## Why it exists\n\n- **Portable.** One standalone binary. Runs on macOS, Linux, FreeBSD,\n and Android (via Termux). No Node, no Python, no ecosystem.\n- **Provider-agnostic.** Anthropic, OpenAI, Google, OpenRouter, DeepSeek, xAI,\n Groq, Mistral, Together, Cerebras, Perplexity — plus local **Ollama** and\n **MLX**. Switch with `/model` mid-session.\n- **Reliable on small models.** A native port of [forge](https://github.com/azambelli/forge)\n plus [ATLAS](docs/FORGE.md#the-atlas-reliability-layer)-style verify-and-repair\n wraps every call: prose-to-tool rescue, step enforcement, verify-gate, and\n best-of-k. Always on, every provider.\n- **Delegation built in.** Named sub-agent roles for the `task` tool —\n read-only `delegate`, docs-scoped `doc-explorer`, gated `implementer`\n (BLUEPRINT → approve → EXECUTE) — with enforced write scopes, per-agent\n model routing via `jcode.json`, and plan-lifecycle skills\n (`create-plan` / `resume-plan` / `generate-handover`). See\n [docs/agents.md](docs/agents.md).\n- **A real TUI.** termbox-based panels, markdown + syntax highlighting, live\n diffs, themes, a sidebar with token / cost / GPU stats.\n\n## Quickstart\n\nYou need a C compiler and Rust/Cargo. `make build` and `make binary` use a\nlocal Jerboa toolchain when present, otherwise they fetch the configured\nrelease bundle into `.jerboa/bin`. See\n**[docs/getting-started.md](docs/getting-started.md)** for the full setup.\n\n```bash\ngit clone https://git.sr.ht/~lisp/jerboa-code && cd jerboa-code\n\nmake build # compile src/ → lib/\nmake binary # produce the standalone ./jcode\n./jcode keys add anthropic # store an API key (encrypted)\n\n./jcode # interactive REPL\n./jcode --tui # full terminal UI\n./jcode -p \"explain this repo\" # one-shot prompt\n```\n\n## Documentation\n\n| Doc | What's in it |\n|---|---|\n| **[Getting started](docs/getting-started.md)** | Prerequisites, building on every platform, configuration, keys, first run. |\n| **[CLI reference](docs/cli.md)** | Every subcommand, flag, slash command, and environment variable. |\n| **[Architecture](docs/architecture.md)** | The agent loop, module map, and how a turn flows through the guardrails. |\n| **[Providers & models](docs/providers.md)** | The 14 providers, model registry, per-model sampling, and hardware tiers. |\n| **[Tools](docs/tools.md)** | The agent's toolbox (file, bash, web, git, patch, task, MCP) and the safety model. |\n| **[Named agents & plans](docs/agents.md)** | Sub-agent roles with enforced write scopes, per-agent models, gated execution, and the plan-lifecycle skills. |\n| **[TUI](docs/tui.md)** | Layout, keybindings, themes, and the rendering features. |\n| **[Forge & ATLAS reliability](docs/FORGE.md)** | Guardrails, workflows, verify-gate, best-of-k, the proxy, and the eval harness. |\n| **[Remote & Android](docs/remote.md)** | `serve` / `relay` / `connect` and the thin-client architecture. |\n\nSee **[docs/](docs/)** for the full index.\n\n## Build targets\n\n`make build` · `test` · `run` · `run-tui` · `binary` · `install` ·\n`linux` · `linux-amd64` · `linux-arm64` · `freebsd` · `android`.\nRun `make help` for the complete list.\n\n## Layout\n\n```\nmain.ss entry point\nsrc/jcode/\n core/ agent loop, config, sessions, guardrails plumbing, ATLAS\n provider/ the 14 LLM providers + per-model sampling\n tool/ file, bash, web, git, patch, task, repomap, lsp\n guardrails/ rescue, validator, step-enforcer, respond, error budget\n proxy/ OpenAI-compatible guardrail proxy\n eval/ deterministic ablation harness\n ui/ cli, tui-*, serve/relay/connect\n mcp/ MCP client\n```\n\nSource is **Jerboa `.ss`**, compiled by `jerbuild` to Chez `.sls` under `lib/`.\nSee [`AGENTS.md`](AGENTS.md) for the language reference and [`CLAUDE.md`](CLAUDE.md)\nfor contributor conventions.\n"} {"text":";; FILE: jerboa-code/main-binary.ss\n#!chezscheme\n;;; jcode binary entry point\n;;; In binary mode, all libraries are compiled in via boot files.\n\n(import (chezscheme)\n (jcode core config)\n (jcode core prompts)\n (jcode core agent)\n (jcode ui cli))\n\n(define (has-positional-args? args)\n (cond\n ((null? args) #f)\n ;; -p starts the one-shot prompt: everything after is positional.\n ((equal? (car args) \"-p\") (pair? (cdr args)))\n ((member (car args) '(\"--help\" \"-h\" \"--version\" \"-v\" \"--debug\" \"-d\" \"--tui\" \"--no-tui\" \"--verbose\" \"--repl\" \"--no-mcp\"))\n (has-positional-args? (cdr args)))\n ((member (car args) '(\"--model\" \"-m\" \"--provider\" \"--repl-port\" \"--trace\"))\n (if (null? (cdr args)) #f (has-positional-args? (cddr args))))\n (else #t)))\n\n(cli-main (if (or (member \"--no-tui\" (command-line-arguments))\n (has-positional-args? (command-line-arguments)))\n (command-line-arguments)\n (cons \"--tui\" (command-line-arguments))))\n"} {"text":";; FILE: jerboa-code/build-jcode-cross.ss\n#!chezscheme\n;;; build-jcode-cross.ss — Cross-compile jcode from macOS to Linux musl\n;;;\n;;; Usage:\n;;; JERBOA_HOME=/Users/user/mine/jerboa TARGET_ARCH=amd64 scheme \\\n;;; --libdirs <libs> --script build-jcode-cross.ss\n;;;\n;;; TARGET_ARCH selects the cross target:\n;;; amd64 (default) — chez ta6le + x86_64-linux-musl-gcc → jcode-linux-amd64\n;;; arm64 — chez tarm64le + aarch64-linux-musl-gcc → jcode-linux-arm64\n;;;\n;;; Cross-compile analogue of build-jcode-musl.ss that runs on a non-Linux host.\n;;; Uses:\n;;; - $JERBOA_HOME/.chez-cross-<machine>/ — cross-built Chez install\n;;; - $JERBOA_HOME/build/chez/xc-<machine>/s/xpatch — host compiler emit mode\n;;; - <toolchain>-linux-musl-gcc — C compile + final static link\n;;;\n;;; This is the \"WPO as program\" pattern: main-binary.ss + all imports are\n;;; bundled into one .so via compile-whole-program, loaded at runtime via\n;;; Sscheme_program — no jcode.boot bundling required.\n\n(import (chezscheme))\n\n;; ── Params ──────────────────────────────────────────────────────────────────\n(define jerboa-home\n (or (getenv \"JERBOA_HOME\") \"/Users/user/mine/jerboa\"))\n\n(define target-arch (or (getenv \"TARGET_ARCH\") \"amd64\"))\n\n;; Per-arch dispatch:\n;; (arch chez-machine c-toolchain rust-target output-name ar-tool target-env-lower target-env-upper)\n(define arch-table\n '((\"amd64\" \"ta6le\" \"x86_64-linux-musl-gcc\" \"x86_64-unknown-linux-musl\" \"jcode-linux-amd64\"\n \"x86_64-linux-musl-ar\" \"x86_64_unknown_linux_musl\" \"X86_64_UNKNOWN_LINUX_MUSL\")\n (\"arm64\" \"tarm64le\" \"aarch64-linux-musl-gcc\" \"aarch64-unknown-linux-musl\" \"jcode-linux-arm64\"\n \"aarch64-linux-musl-ar\" \"aarch64_unknown_linux_musl\" \"AARCH64_UNKNOWN_LINUX_MUSL\")))\n\n(define arch-row\n (or (assoc target-arch arch-table)\n (error 'build-jcode-cross\n (format \"unknown TARGET_ARCH (expected amd64|arm64): ~a\" target-arch))))\n\n(define chez-machine (list-ref arch-row 1))\n(define rust-target (list-ref arch-row 3))\n(define cross-ar (list-ref arch-row 5))\n(define rust-target-env-lower (list-ref arch-row 6))\n(define rust-target-env-upper (list-ref arch-row 7))\n\n(define cross-prefix (format \"~a/.chez-cross-~a\" jerboa-home chez-machine))\n(define xpatch (format \"~a/build/chez/xc-~a/s/xpatch\" jerboa-home chez-machine))\n(define cross-cc (or (getenv \"CROSS_CC\") (list-ref arch-row 2)))\n\n(define output (list-ref arch-row 4))\n(define entry-script \"main-binary.ss\")\n\n;; jcode uses only this subset of jerboa-native-rs features:\n;; tls — provider/provider.ss (rustls)\n;; crypto — secrets.ss, hashing, hmac, aead, scrypt, argon2id\n;;\n;; SQLite is linked through vendor/jerboa-sqlite/jerboa_sqlite_shim.c plus\n;; support/sqlite-bundled. The Rust crate's sqlite feature exports a different\n;; jerboa_sqlite_* surface, so enabling it here creates duplicate symbols and\n;; still does not provide the int64/bytes/constants API the Scheme module uses.\n(define cargo-features \"tls,crypto\")\n\n(define jerboa-native-a\n (or (getenv \"JERBOA_NATIVE_A\")\n (format \"~a/jerboa-native-rs/target/~a/release/libjerboa_native.a\"\n jerboa-home rust-target)))\n\n(define sqlite-bundled-a\n (format \"support/sqlite-bundled/target/~a/release/libjcode_sqlite_bundled.a\"\n rust-target))\n\n(define cross-csv-dir\n (let ([lib (format \"~a/lib\" cross-prefix)])\n (unless (file-directory? lib)\n (error 'build-jcode-cross \"cross prefix lib dir missing — run 'make chez' in jerboa first\" lib))\n (let* ([entries (directory-list lib)]\n [csvs (filter (lambda (e)\n (and (>= (string-length e) 3)\n (string=? (substring e 0 3) \"csv\")))\n entries)])\n (when (null? csvs)\n (error 'build-jcode-cross \"no csv* in cross lib\" lib))\n (format \"~a/~a/~a\" lib (car csvs) chez-machine))))\n\n(define (require-file p)\n (unless (file-exists? p)\n (error 'build-jcode-cross \"missing file\" p)))\n\n(require-file xpatch)\n(require-file (format \"~a/libkernel.a\" cross-csv-dir))\n(require-file (format \"~a/scheme.h\" cross-csv-dir))\n(require-file (format \"~a/petite.boot\" cross-csv-dir))\n(require-file (format \"~a/scheme.boot\" cross-csv-dir))\n(require-file entry-script)\n\n(printf \"==> build-jcode-cross~n\")\n(printf \" JERBOA_HOME: ~a~n\" jerboa-home)\n(printf \" cross csv-dir: ~a~n\" cross-csv-dir)\n(printf \" xpatch: ~a~n\" xpatch)\n(printf \" cross-cc: ~a~n\" cross-cc)\n(printf \" output: ~a~n\" output)\n(printf \" features: ~a~n\" cargo-features)\n(printf \" sqlite archive: ~a~n~n\" sqlite-bundled-a)\n\n;; ── Step 0: Build/rebuild jerboa-native-rs for x86_64-linux-musl ───────────\n;; libjerboa_native.a is shared across jerboa-shell, jerboa-code, etc. If a\n;; sibling cross build (e.g. jsh-cross) built it with a different feature\n;; set, rebuild to match what jcode needs. Sentinel file records features.\n\n(define native-features-sentinel\n (format \"~a/jerboa-native-rs/target/~a/release/.built-with-~a\"\n jerboa-home rust-target\n (let ([s (string-copy cargo-features)])\n (let loop ([i 0])\n (cond [(= i (string-length s)) s]\n [(char=? (string-ref s i) #\\,)\n (string-set! s i #\\-) (loop (+ i 1))]\n [else (loop (+ i 1))])))))\n\n(define (rs-source-newer-than? a-path)\n (let ([src-dir (format \"~a/jerboa-native-rs/src\" jerboa-home)])\n (and (file-directory? src-dir)\n (file-exists? a-path)\n (let ([a-mtime (file-modification-time a-path)])\n (let walk ([dirs (list src-dir)])\n (and (pair? dirs)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter (lambda (p) (not (file-directory? p))) entries)]\n [subs (filter file-directory? entries)])\n (or (ormap (lambda (f)\n (and (let ([n (string-length f)])\n (and (> n 3)\n (string=? \".rs\" (substring f (- n 3) n))))\n (time>? (file-modification-time f) a-mtime)))\n files)\n (walk (append subs (cdr dirs)))))))))))\n\n;; Force cargo to use rustup-managed rustc. Homebrew on macOS often ships its\n;; own rustc ahead of rustup proxies on PATH; that homebrew rustc has no\n;; cross targets installed, so the musl build fails with \"can't find crate\n;; for core\". Detect rustup's active toolchain via `rustup which rustc` and\n;; pin both PATH and RUSTC to it (same trick as build-jcode-musl.ss).\n(define (path-dirname s)\n (let loop ([i (- (string-length s) 1)])\n (cond [(< i 0) \".\"]\n [(char=? (string-ref s i) #\\/) (substring s 0 i)]\n [else (loop (- i 1))])))\n\n(define (capture-line cmd)\n ;; open-process-ports returns 4 values: stdin, stdout, stderr, pid.\n (call-with-values\n (lambda () (open-process-ports cmd (buffer-mode block) (native-transcoder)))\n (lambda (to-stdin from-stdout from-stderr pid)\n (let ([line (get-line from-stdout)])\n (close-port to-stdin)\n (close-port from-stdout)\n (close-port from-stderr)\n (if (or (eof-object? line) (zero? (string-length line))) #f line)))))\n\n(define rustup-rustc-path (capture-line \"rustup which rustc 2>/dev/null\"))\n(define rustup-bin-dir (and rustup-rustc-path (path-dirname rustup-rustc-path)))\n\n(define (try-cargo-build cmd)\n (printf \" $ ~a~n\" cmd)\n (zero? (system cmd)))\n\n(define (build-sqlite-bundled!)\n (require-file \"support/sqlite-bundled/Cargo.toml\")\n (let* ([sqlite-dir \"support/sqlite-bundled\"]\n [cargo-args (format \"build --release --target ~a\" rust-target)]\n [cc-env (format \"CARGO_TARGET_~a_LINKER='~a' CC_~a='~a' AR_~a='~a' \"\n rust-target-env-upper cross-cc\n rust-target-env-lower cross-cc\n rust-target-env-lower cross-ar)]\n [via-rustup\n (and rustup-bin-dir\n (format \"cd '~a' && env ~aPATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a\"\n sqlite-dir cc-env rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))]\n [via-path (format \"cd '~a' && env ~acargo ~a\" sqlite-dir cc-env cargo-args)]\n [ok? (or (and via-rustup (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless ok?\n (error 'build-jcode-cross\n (format \"failed to build bundled SQLite for ~a with ~a\"\n rust-target cross-cc)))\n (unless (file-exists? sqlite-bundled-a)\n (error 'build-jcode-cross\n \"cargo succeeded but bundled SQLite archive is missing\"\n sqlite-bundled-a))))\n\n(define (rebuild-native-lib!)\n (let* ([nrs-dir (format \"~a/jerboa-native-rs\" jerboa-home)]\n [cargo-args (format \"build --release --no-default-features --features ~a --target ~a\"\n cargo-features rust-target)]\n [via-rustup\n (and rustup-bin-dir\n (format \"cd '~a' && env PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a\"\n nrs-dir rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))]\n [via-path (format \"cd '~a' && cargo ~a\" nrs-dir cargo-args)]\n [ok? (or (and via-rustup (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless ok?\n (error 'build-jcode-cross\n (format\n (string-append\n \"failed to build jerboa-native-rs for ~a. \"\n \"Required: `rustup target add ~a`, plus the \"\n \"FiloSottile/musl-cross toolchain on PATH so cargo finds \"\n \"~a as the linker.\")\n rust-target rust-target cross-cc)))\n (unless (file-exists? jerboa-native-a)\n (error 'build-jcode-cross \"cargo succeeded but .a missing\" jerboa-native-a))\n (call-with-output-file native-features-sentinel\n (lambda (out) (display cargo-features out) (newline out))\n 'truncate)))\n\n(cond\n [(not (file-exists? jerboa-native-a))\n (printf \"==> jerboa-native-rs missing — building (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(not (file-exists? native-features-sentinel))\n (printf \"==> jerboa-native-rs sentinel missing — rebuilding (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(time>? (file-modification-time jerboa-native-a)\n (file-modification-time native-features-sentinel))\n ;; The .a is shared across sibling repos (jerboa-shell, etc.). A newer .a\n ;; than our sentinel means someone rebuilt it — possibly with different\n ;; features — so our tag can't be trusted. Rebuild to be sure (prevents\n ;; the silent \"undefined reference to jerboa_sqlite_*\" cross-link break).\n (printf \"==> jerboa-native-rs .a newer than sentinel (foreign rebuild?) — rebuilding (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(rs-source-newer-than? jerboa-native-a)\n (printf \"==> jerboa-native-rs .rs source newer than .a — rebuilding~n\")\n (rebuild-native-lib!)]\n [else\n (printf \"==> jerboa-native-rs up to date (features=~a)~n\" cargo-features)])\n\n(printf \"==> building bundled SQLite archive (~a)~n\" rust-target)\n(build-sqlite-bundled!)\n\n(printf \"~n\")\n\n;; ── Step 0.5: isolate cross-compiled objects ───────────────────────────────\n;; Never patch source libraries in-place. Chez xpatch can compile target\n;; objects while `library-directories` maps source directories to a separate\n;; writable object directory.\n\n(define obj-dir (format \".build/~a-obj\" output))\n(define entry-so (format \"~a/program.so\" obj-dir))\n(define entry-wpo (format \"~a/program.wpo\" obj-dir))\n\n(define (prepare-obj-dir!)\n (system (format \"rm -rf '~a'\" obj-dir))\n (system (format \"mkdir -p '~a'\" obj-dir)))\n\n(define (cleanup!)\n (system (format \"rm -rf '~a'\" obj-dir)))\n\n(prepare-obj-dir!)\n\n;; ── Stage 1: load xpatch (target=ta6le emit mode) ──────────────────────────\n(define orig-libdirs (library-directories))\n(printf \"==> [1/6] loading xpatch (compiler -> ~a emit mode)~n\" chez-machine)\n(load xpatch)\n(library-directories\n (map (lambda (pair)\n (cons (if (pair? pair) (car pair) pair) obj-dir))\n orig-libdirs))\n\n(compile-imported-libraries #t)\n(generate-wpo-files #t)\n\n;; ── Stage 2: compile-program main-binary.ss ────────────────────────────────\n(printf \"==> [2/6] compile-program ~a -> ~a~n\" entry-script entry-so)\n(guard (e [#t (cleanup!) (raise e)])\n (compile-program entry-script entry-so))\n\n;; ── Stage 3: compile-whole-program → wpo .so ───────────────────────────────\n(define wpo-output (string-append output \".wp.so\"))\n(printf \"==> [3/6] compile-whole-program ~a -> ~a~n\" entry-wpo wpo-output)\n(guard (e [#t (cleanup!) (raise e)])\n (compile-whole-program entry-wpo wpo-output #t))\n\n;; ── Stage 4: embed boot files + program as C arrays ────────────────────────\n(define (embed-as-c-array in-path var-name out-path)\n (let* ([bv (call-with-port (open-file-input-port in-path) get-bytevector-all)]\n [n (bytevector-length bv)])\n (call-with-port (open-file-output-port out-path\n (file-options no-fail)\n (buffer-mode block)\n (native-transcoder))\n (lambda (out)\n (display (format \"static const unsigned char ~a[] = {\\n\" var-name) out)\n (let loop ([i 0])\n (when (< i n)\n (display (format \"0x~2,'0x,\" (bytevector-u8-ref bv i)) out)\n (when (= (mod (+ i 1) 16) 0) (newline out))\n (loop (+ i 1))))\n (when (positive? n) (newline out))\n (display \"};\\n\" out)\n (display (format \"static const unsigned int ~a_size = sizeof(~a);\\n\"\n var-name var-name)\n out)))\n (printf \" embed ~a (~a bytes) -> ~a~n\" in-path n out-path)))\n\n(printf \"==> [4/6] embed boot files + program as C arrays~n\")\n(embed-as-c-array (format \"~a/petite.boot\" cross-csv-dir) \"petite_boot\" \"petite_boot.h\")\n(embed-as-c-array (format \"~a/scheme.boot\" cross-csv-dir) \"scheme_boot\" \"scheme_boot.h\")\n(embed-as-c-array wpo-output \"jcode_program\" \"jcode_program.h\")\n\n;; ── Stage 5: generate main.c ───────────────────────────────────────────────\n;; Symbol surface mirrors build-jcode-musl.ss (FFI + libc), plus the dlopen\n;; stubs needed for fully-static binaries. dlerror MUST return non-NULL —\n;; Chez's load-shared-object error path strlen()s it.\n\n(define ffi-shim-symbols\n '(;; jerboa-sqlite shim (vendor/jerboa-sqlite/jerboa_sqlite_shim.c)\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_clear_bindings\" \"jerboa_sqlite_step\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_name\"\n \"jerboa_sqlite_column_type\" \"jerboa_sqlite_column_int64\"\n \"jerboa_sqlite_column_double\" \"jerboa_sqlite_column_text\"\n \"jerboa_sqlite_column_bytes\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_bind_int64\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\"\n \"jerboa_sqlite_bind_null\" \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_SQLITE_ROW\" \"jerboa_SQLITE_DONE\" \"jerboa_SQLITE_OK\"\n ;; termbox2 TUI shim (src/jcode/ui/jcode_tui_shim.c)\n \"jcode_tb_init\" \"jcode_tb_shutdown\"\n \"jcode_tb_width\" \"jcode_tb_height\"\n \"jcode_tb_clear\" \"jcode_tb_present\"\n \"jcode_tb_set_cursor\" \"jcode_tb_hide_cursor\"\n \"jcode_tb_change_cell\" \"jcode_tb_set_clear_attrs\"\n \"jcode_tb_print\" \"jcode_tb_printf\"\n \"jcode_tb_set_input_mode\" \"jcode_tb_set_output_mode\"\n \"jcode_tb_poll_event\" \"jcode_tb_peek_event\"\n \"jcode_tb_event_type\" \"jcode_tb_event_mod\"\n \"jcode_tb_event_key\" \"jcode_tb_event_ch\"\n \"jcode_tb_event_w\" \"jcode_tb_event_h\"\n \"jcode_tb_event_x\" \"jcode_tb_event_y\"\n ;; landlock-shim (support/landlock-shim.c)\n \"jerboa_landlock_sandbox\"\n \"jerboa_landlock_sandbox_ex\"\n \"jerboa_landlock_abi_version\"))\n\n(define jerboa-native-symbols\n '(;; jerboa-native (TLS/rustls)\n \"jerboa_tls_server_new\" \"jerboa_tls_server_new_pem\"\n \"jerboa_tls_server_new_mtls\"\n \"jerboa_tls_server_free\" \"jerboa_tls_accept\"\n \"jerboa_tls_connect\" \"jerboa_tls_connect_pinned\"\n \"jerboa_tls_connect_mtls\" \"jerboa_tls_close\"\n \"jerboa_tls_read\" \"jerboa_tls_write\" \"jerboa_tls_flush\"\n \"jerboa_tls_get_fd\" \"jerboa_tls_set_nonblock\"\n \"jerboa_last_error\"\n ;; jerboa-native (x509) — self-signed cert for the debug-REPL TLS listener\n \"jerboa_x509_generate_self_signed_mem\"\n ;; jerboa-native (crypto)\n \"jerboa_sha1\" \"jerboa_sha256\" \"jerboa_sha384\" \"jerboa_sha512\"\n \"jerboa_random_bytes\" \"jerboa_timing_safe_equal\"\n \"jerboa_hmac_sha256\" \"jerboa_hmac_sha256_verify\"\n \"jerboa_aead_seal\" \"jerboa_aead_open\"\n \"jerboa_chacha20_seal\" \"jerboa_chacha20_open\"\n \"jerboa_scrypt\"\n \"jerboa_pbkdf2_derive\" \"jerboa_pbkdf2_verify\"\n \"jerboa_argon2id_hash\" \"jerboa_argon2id_verify\"\n ;; jerboa-native (regex) — visit-time even if jcode never matches\n \"jerboa_regex_compile\" \"jerboa_regex_is_match\"\n \"jerboa_regex_find\" \"jerboa_regex_replace_all\" \"jerboa_regex_free\"\n ;; jerboa-native (aproc) — (std os aproc) for bash tool\n \"jerboa_aproc_spawn\" \"jerboa_aproc_spawn_pty\"\n \"jerboa_aproc_set_nonblock\" \"jerboa_aproc_killpg\" \"jerboa_aproc_wait4\"\n ;; jerboa-native (net/io)\n \"jerboa_writev2\"))\n\n(define posix-symbols\n '(;; sockets — std/net/tcp, std/net/udp\n \"socket\" \"bind\" \"listen\" \"accept\" \"connect\" \"close\"\n \"setsockopt\" \"getsockopt\" \"getsockname\"\n \"htons\" \"ntohs\" \"inet_pton\" \"inet_addr\"\n \"read\" \"write\" \"recvfrom\" \"sendto\"\n ;; DNS — std/net/resolve\n \"getaddrinfo\" \"freeaddrinfo\" \"inet_ntop\"\n ;; process/signals — std/misc/process, std/os/signal, aproc\n \"fork\" \"waitpid\" \"kill\" \"getpid\" \"getppid\"\n \"getpgid\" \"setpgid\" \"setsid\"\n \"getuid\" \"geteuid\" \"getgid\" \"getegid\"\n \"sigemptyset\" \"sigfillset\" \"sigaddset\" \"sigdelset\"\n \"sigismember\" \"sigprocmask\"\n ;; terminal/fd — TUI + REPL\n \"isatty\" \"tcgetattr\" \"tcsetattr\" \"tcgetpgrp\" \"tcsetpgrp\"\n \"pipe\" \"dup\" \"dup2\" \"lseek\"\n ;; env/misc — std/os/env, std/text/time\n \"setenv\" \"unsetenv\" \"strerror\" \"localtime\" \"strftime\"\n \"sysconf\" \"getpagesize\" \"getrlimit\"\n \"system\" \"getenv\" \"putenv\" \"_exit\" \"exit\" \"execvp\" \"execve\"\n ;; temporary files/directories — std/os/temp\n \"mkstemp\" \"mkdtemp\" \"unlink\" \"rmdir\"\n ;; errno location + Linux sandboxing\n \"__errno_location\" \"fcntl\" \"prctl\" \"syscall\"))\n\n(define main-c-path (string-append output \"-main.c\"))\n\n(define (emit-c out)\n (display \"/* Generated by build-jcode-cross.ss — do not edit by hand. */\\n\" out)\n (display \"#define _GNU_SOURCE\\n\" out)\n (display \"#include <stdlib.h>\\n\" out)\n (display \"#include <string.h>\\n\" out)\n (display \"#include <stdio.h>\\n\" out)\n (display \"#include <unistd.h>\\n\" out)\n (display \"#include <sys/mman.h>\\n\" out)\n (display \"#include <sys/types.h>\\n\" out)\n (display \"#include <sys/stat.h>\\n\" out)\n (display \"#include <sys/wait.h>\\n\" out)\n (display \"#include <sys/resource.h>\\n\" out)\n (display \"#include <sys/prctl.h>\\n\" out)\n (display \"#include <sys/socket.h>\\n\" out)\n (display \"#include <netinet/in.h>\\n\" out)\n (display \"#include <arpa/inet.h>\\n\" out)\n (display \"#include <netdb.h>\\n\" out)\n (display \"#include <termios.h>\\n\" out)\n (display \"#include <fcntl.h>\\n\" out)\n (display \"#include <signal.h>\\n\" out)\n (display \"#include <time.h>\\n\" out)\n (display \"#include <errno.h>\\n\" out)\n (display \"#include \\\"scheme.h\\\"\\n\" out)\n (display \"#include \\\"petite_boot.h\\\"\\n\" out)\n (display \"#include \\\"scheme_boot.h\\\"\\n\" out)\n (display \"#include \\\"jcode_program.h\\\"\\n\\n\" out)\n ;; dlopen/dlsym stubs — in a fully-static -static binary musl's dlopen\n ;; always fails. Jerboa stdlib does (load-shared-object #f) and, in some\n ;; libc fallback modules, (load-shared-object \"\") to expose the main\n ;; executable; with these stubs those succeed and Chez routes lookups\n ;; through Sforeign_symbol.\n (display \"/* dlopen stubs for static linking.\\n\" out)\n (display \" * (load-shared-object #f) passes f=NULL — succeed (main exe).\\n\" out)\n (display \" * (load-shared-object \\\"\\\") passes f=\\\"\\\" — also succeed (main exe).\\n\" out)\n (display \" * (load-shared-object \\\"libfoo\\\") passes f=\\\"libfoo\\\" — fail so the\\n\" out)\n (display \" * Scheme guard falls back to a no-op stub and we never try to\\n\" out)\n (display \" * dlsym a function that's not statically linked. */\\n\" out)\n (display \"void *dlopen(const char *f, int flags) { (void)flags; return (!f || f[0] == '\\\\0') ? (void*)1 : NULL; }\\n\" out)\n (display \"void *dlsym(void *h, const char *s) { (void)h; (void)s; return NULL; }\\n\" out)\n (display \"int dlclose(void *h) { (void)h; return 0; }\\n\" out)\n ;; dlerror MUST return a non-NULL string — Chez's load-shared-object error\n ;; path calls strlen(dlerror()), and strlen(NULL) is a SIGSEGV inside libc\n ;; with no useful diagnostic. Return a stable message instead.\n (display \"static char dlerror_msg[] = \\\"static binary: dlopen of named libraries is stubbed\\\";\\n\" out)\n (display \"char *dlerror(void) { return dlerror_msg; }\\n\\n\" out)\n ;; extern decls for shim functions linked via .c files\n (display \"/* Shim function decls — jerboa_sqlite_shim.c + jcode_tui_shim.c + landlock-shim.c */\\n\" out)\n (for-each (lambda (n) (fprintf out \"extern void ~a();\\n\" n)) ffi-shim-symbols)\n ;; extern decls for libjerboa_native.a symbols\n (display \"\\n/* libjerboa_native.a — features=tls,crypto */\\n\" out)\n (for-each (lambda (n) (fprintf out \"extern void ~a();\\n\" n)) jerboa-native-symbols)\n ;; POSIX libc symbols already declared by system headers above.\n (display \"\\nextern int *__errno_location(void);\\n\" out)\n ;; register all symbols at startup\n (newline out)\n (display \"static void register_ffi_symbols(void) {\\n\" out)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n ffi-shim-symbols)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n jerboa-native-symbols)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n posix-symbols)\n (display \"}\\n\\n\" out)\n (display \"int main(int argc, char *argv[]) {\\n\" out)\n ;; Tell jerboa stdlib we are statically linked — must precede Sscheme_init.\n (display \" setenv(\\\"JERBOA_STATIC\\\", \\\"1\\\", 1);\\n\\n\" out)\n ;; memfd_create for the WPO program, with tmpfile fallback\n (display \" int fd = memfd_create(\\\"jcode-program\\\", MFD_CLOEXEC);\\n\" out)\n (display \" char prog_path[64];\\n\" out)\n (display \" if (fd >= 0) {\\n\" out)\n (display \" if (write(fd, jcode_program, jcode_program_size) != (ssize_t)jcode_program_size) {\\n\" out)\n (display \" perror(\\\"write memfd\\\"); close(fd); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"/proc/self/fd/%d\\\", fd);\\n\" out)\n (display \" } else {\\n\" out)\n (display \" const char *tmp = getenv(\\\"TMPDIR\\\"); if (!tmp) tmp = \\\"/tmp\\\";\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"%s/.jcode-prog-%d.so\\\", tmp, getpid());\\n\" out)\n (display \" FILE *fp = fopen(prog_path, \\\"wb\\\");\\n\" out)\n (display \" if (!fp) { perror(\\\"fopen tmpfile\\\"); return 1; }\\n\" out)\n (display \" if (fwrite(jcode_program, 1, jcode_program_size, fp) != jcode_program_size) {\\n\" out)\n (display \" perror(\\\"fwrite\\\"); fclose(fp); unlink(prog_path); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" fclose(fp);\\n\" out)\n (display \" }\\n\\n\" out)\n ;; Boot Chez.\n (display \" Sscheme_init(NULL);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"petite\\\", (void *)petite_boot, petite_boot_size);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"scheme\\\", (void *)scheme_boot, scheme_boot_size);\\n\" out)\n (display \" Sbuild_heap(NULL, NULL);\\n\" out)\n (display \" register_ffi_symbols();\\n\\n\" out)\n ;; argv is passed through directly to Sscheme_program — main-binary.ss\n ;; reads (command-line-arguments) for --tui detection.\n (display \" int status = Sscheme_program(prog_path, argc, (const char **)argv);\\n\\n\" out)\n (display \" if (fd >= 0) close(fd); else unlink(prog_path);\\n\" out)\n (display \" Sscheme_deinit();\\n\" out)\n (display \" return status;\\n\" out)\n (display \"}\\n\" out))\n\n(call-with-port (open-file-output-port main-c-path\n (file-options no-fail) (buffer-mode block) (native-transcoder))\n emit-c)\n(printf \"==> [5/6] generated ~a (~a shim + ~a native + ~a posix)~n\"\n main-c-path\n (length ffi-shim-symbols)\n (length jerboa-native-symbols)\n (length posix-symbols))\n\n;; ── Stage 6: compile + link with cross-cc ──────────────────────────────────\n(printf \"==> [6/6] compile + link with ~a~n\" cross-cc)\n\n(define sqlite-shim-c \"vendor/jerboa-sqlite/jerboa_sqlite_shim.c\")\n(define jcode-tui-shim-c \"src/jcode/ui/jcode_tui_shim.c\")\n(define landlock-shim-c \"support/landlock-shim.c\")\n(define sqlite-include-dir \"support\")\n\n(require-file sqlite-shim-c)\n(require-file jcode-tui-shim-c)\n(require-file landlock-shim-c)\n(require-file jerboa-native-a)\n(require-file sqlite-bundled-a)\n(require-file \"support/sqlite3.h\")\n\n(printf \" sqlite3.h: support/sqlite3.h~n\")\n(printf \" tls/crypto via libjerboa_native.a; sqlite via jerboa_sqlite_shim.c + bundled SQLite~n\")\n\n;; -Wl,--export-dynamic exports symbols into the dynamic symbol table so\n;; Chez's foreign-procedure / dlsym(RTLD_DEFAULT) can find them in a\n;; -static binary. (Same trick as build-jsh-cross.ss.)\n(define link-cmd\n (format\n (string-append\n \"~a -O2 -static -Wl,--export-dynamic \"\n \"-I~a \" ;; scheme.h\n \"-I~a \" ;; sqlite3.h\n \"-Ivendor/termbox2 -DTB_OPT_ATTR_W=32 \" ;; jcode_tui_shim\n \"-o ~a \" ;; output\n \"~a ~a ~a ~a \" ;; main.c + 3 shims\n \"~a/libkernel.a ~a/libz.a ~a/liblz4.a \" ;; chez kernel\n \"~a \" ;; libjerboa_native.a\n \"~a \" ;; bundled sqlite3\n \"-Wl,--allow-multiple-definition \"\n \"-Wl,--defsym=_dl_find_object=0 \"\n \"-lm -ldl -lpthread\")\n cross-cc cross-csv-dir sqlite-include-dir output\n main-c-path sqlite-shim-c jcode-tui-shim-c landlock-shim-c\n cross-csv-dir cross-csv-dir cross-csv-dir\n jerboa-native-a sqlite-bundled-a))\n(printf \" ~a~n\" link-cmd)\n(let ([rc (system link-cmd)])\n (unless (zero? rc)\n (cleanup!)\n (error 'build-jcode-cross \"cross-link failed\" rc)))\n\n;; ── Cleanup: remove isolated cross objects ─────────────────────────────────\n(cleanup!)\n\n(printf \"~n=== Build complete: ~a ===~n\" output)\n(system (format \"ls -lh ~a\" output))\n(system (format \"file ~a\" output))\n"} -{"text":";; FILE: jerboa-code/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-code/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-code/build-jcode-musl.ss\n#!chezscheme\n;;; build-jcode-musl.ss — Build a fully static jcode binary using musl libc\n;;;\n;;; Usage: scheme -q --libdirs <jerboa-lib>:./lib:vendor/jerboa-sqlite/src < build-jcode-musl.ss\n;;;\n;;; This script:\n;;; 1. Compiles jcode modules (using stock scheme with glibc)\n;;; 2. Creates boot file + optimized program .so\n;;; 3. Generates C files with embedded boot data\n;;; 4. Compiles C with musl-gcc against musl-built Chez's scheme.h\n;;; 5. Links fully static binary with libkernel.a from musl-built Chez\n;;;\n;;; The resulting jcode-musl binary has zero runtime dependencies.\n\n(import\n (except (chezscheme) void box box? unbox set-box!\n andmap ormap iota last-pair find\n 1+ 1- fx/ fx1+ fx1-\n error error? raise with-exception-handler identifier?\n hash-table? make-hash-table)\n (jerboa build)\n (jerboa build musl))\n\n;; ========== Auto-bootstrap musl Chez if missing ==========\n;;\n;; The musl-static binary requires a libkernel.a built with musl-gcc.\n;; /usr/local Chez on Linux is glibc-built (its libkernel.a references\n;; __memcpy_chk / __fprintf_chk / __stack_chk_fail — glibc-fortify ABI\n;; symbols absent from musl) and therefore cannot satisfy a musl-static\n;; link. So we need a *separate* musl-built Chez prefix.\n;;\n;; We keep it in-tree as ~/mine/ChezScheme/musl-out so it's obviously a\n;; build artifact (not a system install) and stays version-locked to the\n;; source. If missing, build it via support/musl-chez-build.sh.\n\n(define jcode-musl-chez-prefix\n (or (getenv \"JERBOA_MUSL_CHEZ_PREFIX\")\n (format \"~a/mine/ChezScheme/musl-out\" (or (getenv \"HOME\") \"/root\"))))\n\n;; Tell (jerboa build musl) where the prefix lives. We respect\n;; JERBOA_MUSL_CHEZ_PREFIX (set by e.g. the jerboa21/jerboa Docker base\n;; image, which ships a pre-built musl Chez at /build/chez-musl) and\n;; otherwise default to an in-tree install. Overrides the default probe\n;; order so we don't accidentally pick up a stale ~/chez-musl from a\n;; previous setup.\n(musl-chez-prefix-set! jcode-musl-chez-prefix)\n\n(unless (file-directory? jcode-musl-chez-prefix)\n (let* ([home (or (getenv \"HOME\") \"/root\")]\n [chez-src (format \"~a/mine/ChezScheme\" home)]\n [bootstrap (format \"~a/mine/jerboa/support/musl-chez-build.sh\" home)])\n (printf \"~n=== musl Chez not found — auto-bootstrapping ===~n\")\n (printf \" source: ~a~n\" chez-src)\n (printf \" prefix: ~a~n~n\" jcode-musl-chez-prefix)\n (cond\n [(not (file-exists? \"/usr/bin/musl-gcc\"))\n (printf \"FATAL: musl-gcc not found. Install with: apt install musl-tools~n\")\n (exit 1)]\n [(not (file-directory? chez-src))\n (printf \"FATAL: Chez source not found at ~a~n\" chez-src)\n (printf \" git clone https://github.com/cisco/ChezScheme.git ~a~n\" chez-src)\n (exit 1)]\n [(not (file-exists? bootstrap))\n (printf \"FATAL: bootstrap script not found: ~a~n\" bootstrap)\n (exit 1)]\n [else\n (printf \"This takes ~~5-10 minutes; subsequent runs reuse it.~n~n\")\n (let ([rc (system (format \"bash '~a' '~a' '~a'\" bootstrap chez-src jcode-musl-chez-prefix))])\n (unless (= rc 0)\n (printf \"~nFATAL: musl Chez bootstrap failed (rc=~a)~n\" rc)\n (printf \"Run manually to inspect:~n bash ~a ~a ~a~n\" bootstrap chez-src jcode-musl-chez-prefix)\n (exit 1))\n (printf \"~n=== musl Chez bootstrap complete ===~n~n\"))])))\n\n;; ========== Validate musl setup ==========\n\n(let ([result (validate-musl-setup)])\n (unless (eq? (car result) 'ok)\n (printf \"Error: ~a~n\" (cdr result))\n (printf \"~nTo build Chez Scheme with musl:~n\")\n (printf \" cd ~/mine/ChezScheme~n\")\n (printf \" ./configure --threads --static CC=musl-gcc --installprefix=~a~n\"\n jcode-musl-chez-prefix)\n (printf \" make -j$(nproc) && make install~n\")\n (exit 1)))\n\n(printf \"musl Chez found: ~a~n~n\" (musl-chez-lib-dir))\n\n;; (Previously had a (scheme-version) vs csv-dir version-string check\n;; here. It was buggy — (scheme-version) returns \"Chez Scheme Version\n;; 10.4.0\" which can never equal the install-dir version \"10.4.0-pre-\n;; release.4\" — so it produced false positives. The scenario it was\n;; meant to catch (stale musl prefix vs newer host scheme) is now\n;; prevented structurally: Docker uses the base image's matched pair,\n;; and the native path auto-bootstraps musl Chez from the same source\n;; tree the host scheme was built from. Boot-file FASL mismatches will\n;; surface as a clear runtime error if they ever occur again.)\n\n;; ========== Locate directories ==========\n\n(define home-dir (or (getenv \"HOME\") \"/root\"))\n\n(define jerboa-dir\n (let ([jh (getenv \"JERBOA_HOME\")])\n (if jh\n (format \"~a/lib\" jh)\n (format \"~a/mine/jerboa/lib\" home-dir))))\n\n(define jerboa-dir-base\n (let ([jh (getenv \"JERBOA_HOME\")])\n (or jh (format \"~a/mine/jerboa\" home-dir))))\n\n(printf \"Jerboa lib: ~a~n\" jerboa-dir)\n\n(define build-dir \"/tmp/jerboa-musl-jcode-build\")\n(define obj-dir (format \"~a/obj\" build-dir))\n(define program-so (format \"~a/program.so\" obj-dir))\n\n(define (prepare-build-dir!)\n (system (format \"rm -rf '~a'\" build-dir))\n (system (format \"mkdir -p '~a'\" obj-dir)))\n\n(define (cleanup-build-dir!)\n (system (format \"rm -rf '~a'\" build-dir)))\n\n;; ========== Auto-discovery helpers ==========\n;;\n;; These helpers eliminate the hardcoded parallel lists of modules that\n;; historically drifted every time a new src/jcode/*.ss file was added.\n;; jcode-modules and external-libs are now derived from the filesystem.\n\n(define (find-files-with-suffix root suffix)\n ;; Recursively find all files under `root` whose name ends in `suffix`.\n ;; Returns an alphabetically sorted list of full paths.\n (if (and (string? root)\n (file-exists? root)\n (file-directory? root))\n (let loop ([dirs (list root)] [acc '()])\n (if (null? dirs)\n (sort string<? acc)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter\n (lambda (p)\n (and (not (file-directory? p))\n (let ([n (string-length p)]\n [sn (string-length suffix)])\n (and (>= n sn)\n (string=?\n suffix\n (substring p (- n sn) n))))))\n entries)]\n [subdirs (filter file-directory? entries)])\n (loop (append subdirs (cdr dirs)) (append files acc)))))\n '()))\n\n(define (strip-suffix s suffix)\n (let ([ls (string-length s)] [lsu (string-length suffix)])\n (if (and (>= ls lsu)\n (string=? suffix (substring s (- ls lsu) ls)))\n (substring s 0 (- ls lsu))\n s)))\n\n(define (assert-so-files-exist! who paths kind)\n ;; Strict replacement for the old silent `existing-so-files` filter.\n ;; Errors loudly if any entry is missing so drift surfaces immediately.\n (let ([missing (filter (lambda (p) (not (file-exists? p))) paths)])\n (cond\n [(null? missing) paths]\n [else\n (printf \"~n[ERROR] ~a: ~a of ~a ~a .so file(s) missing:~n\"\n who (length missing) (length paths) kind)\n (for-each (lambda (p) (printf \" - ~a~n\" p)) missing)\n (error who\n (format \"missing ~a .so file(s) — drift between source tree and build script\"\n kind))])))\n\n;; ========== Auto-discover jcode modules ==========\n;; lib/jcode/**/*.sls is generated by jerbuild (make gen) before this script\n;; runs. Walking the filesystem keeps this list perpetually in sync with the\n;; source tree.\n\n(define jcode-modules\n (map (lambda (sls-path) (strip-suffix sls-path \".sls\"))\n (find-files-with-suffix \"lib/jcode\" \".sls\")))\n\n(printf \"~n[discovery] Found ~a jcode modules under lib/jcode~n\"\n (length jcode-modules))\n(when (null? jcode-modules)\n (error 'build-jcode-musl\n \"No .sls files found under lib/jcode — run 'make gen' first\"))\n(for-each (lambda (m) (printf \" ~a~n\" m)) jcode-modules)\n\n;; libc symbols needed by std/net/* and std/os/* (already linked from musl).\n;; All are real libc functions, not macros — straight (void*)foo casts work.\n;; Variadic/macro ones (open/fcntl/ioctl/umask) are intentionally omitted;\n;; the modules that need them either run through the std/os shims (ffi_*)\n;; or call into the patched (load-shared-object) path that no longer fires.\n(define libc-symbols\n '(;; sockets — std/net/tcp, std/net/udp\n \"socket\" \"bind\" \"listen\" \"accept\" \"connect\" \"close\"\n \"setsockopt\" \"getsockopt\" \"getsockname\"\n \"htons\" \"ntohs\" \"inet_pton\" \"inet_addr\"\n \"read\" \"write\" \"recvfrom\" \"sendto\"\n ;; DNS resolver — std/net/resolve\n \"getaddrinfo\" \"freeaddrinfo\" \"inet_ntop\"\n ;; process / signals — std/misc/process, std/os/signal, aproc\n \"fork\" \"waitpid\" \"kill\" \"getpid\" \"getppid\"\n \"getpgid\" \"setpgid\" \"setsid\"\n \"getuid\" \"geteuid\" \"getgid\" \"getegid\"\n \"sigemptyset\" \"sigfillset\" \"sigaddset\" \"sigdelset\"\n \"sigismember\" \"sigprocmask\"\n ;; terminal / fd — TUI + REPL\n \"isatty\" \"tcgetattr\" \"tcsetattr\" \"tcgetpgrp\" \"tcsetpgrp\"\n \"pipe\" \"dup\" \"dup2\" \"lseek\"\n ;; env / misc — std/os/env, std/text/time\n \"setenv\" \"unsetenv\" \"strerror\" \"localtime\" \"strftime\"\n \"sysconf\" \"getpagesize\" \"getrlimit\"\n \"system\" \"getenv\" \"putenv\" \"_exit\" \"exit\" \"execvp\" \"execve\"\n ;; temporary files/directories — std/os/temp\n \"mkstemp\" \"mkdtemp\" \"unlink\" \"rmdir\"\n ;; errno location + Linux sandboxing\n \"__errno_location\" \"fcntl\" \"prctl\" \"syscall\"))\n\n;; FFI symbols that need Sforeign_symbol registration\n(define ffi-symbols\n '(;; jerboa-sqlite shim\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_clear_bindings\" \"jerboa_sqlite_step\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_name\"\n \"jerboa_sqlite_column_type\" \"jerboa_sqlite_column_int64\"\n \"jerboa_sqlite_column_double\" \"jerboa_sqlite_column_text\"\n \"jerboa_sqlite_column_bytes\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_bind_int64\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\"\n \"jerboa_sqlite_bind_null\" \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_SQLITE_ROW\" \"jerboa_SQLITE_DONE\" \"jerboa_SQLITE_OK\"\n ;; termbox2 TUI shim\n \"jcode_tb_init\" \"jcode_tb_shutdown\"\n \"jcode_tb_width\" \"jcode_tb_height\"\n \"jcode_tb_clear\" \"jcode_tb_present\"\n \"jcode_tb_set_cursor\" \"jcode_tb_hide_cursor\"\n \"jcode_tb_change_cell\" \"jcode_tb_set_clear_attrs\"\n \"jcode_tb_print\" \"jcode_tb_printf\"\n \"jcode_tb_set_input_mode\" \"jcode_tb_set_output_mode\"\n \"jcode_tb_poll_event\" \"jcode_tb_peek_event\"\n \"jcode_tb_event_type\" \"jcode_tb_event_mod\"\n \"jcode_tb_event_key\" \"jcode_tb_event_ch\"\n \"jcode_tb_event_w\" \"jcode_tb_event_h\"\n \"jcode_tb_event_x\" \"jcode_tb_event_y\"\n ;; jerboa-native (TLS/rustls)\n \"jerboa_tls_server_new\" \"jerboa_tls_server_new_mtls\"\n \"jerboa_tls_server_free\" \"jerboa_tls_accept\"\n \"jerboa_tls_connect\" \"jerboa_tls_connect_pinned\"\n \"jerboa_tls_connect_mtls\" \"jerboa_tls_close\"\n \"jerboa_tls_read\" \"jerboa_tls_write\" \"jerboa_tls_flush\"\n \"jerboa_tls_get_fd\" \"jerboa_tls_set_nonblock\"\n \"jerboa_last_error\"\n ;; jerboa-native (crypto/ring) — used by secrets.ss via (std crypto native-rust)\n \"jerboa_sha1\" \"jerboa_sha256\" \"jerboa_sha384\" \"jerboa_sha512\"\n \"jerboa_random_bytes\" \"jerboa_timing_safe_equal\"\n \"jerboa_hmac_sha256\" \"jerboa_hmac_sha256_verify\"\n \"jerboa_aead_seal\" \"jerboa_aead_open\"\n \"jerboa_chacha20_seal\" \"jerboa_chacha20_open\"\n \"jerboa_scrypt\"\n \"jerboa_pbkdf2_derive\" \"jerboa_pbkdf2_verify\"\n \"jerboa_argon2id_hash\" \"jerboa_argon2id_verify\"\n ;; jerboa-native (regex) — pulled in transitively via (jerboa prelude)\n ;; which imports (std regex). foreign-procedure forms run at library\n ;; visit time, so these have to exist even if jcode never matches a regex.\n \"jerboa_regex_compile\" \"jerboa_regex_is_match\"\n \"jerboa_regex_find\" \"jerboa_regex_replace_all\" \"jerboa_regex_free\"\n ;; jerboa-native (aproc) — used by (std os aproc) for bash tool\n \"jerboa_aproc_spawn\" \"jerboa_aproc_spawn_pty\"\n \"jerboa_aproc_set_nonblock\" \"jerboa_aproc_killpg\" \"jerboa_aproc_wait4\"\n ;; jerboa-native (sqlite) — used by (std db sqlite) via sqlite-native.sls\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_step\" \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_bind_int\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\" \"jerboa_sqlite_bind_null\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_type\"\n \"jerboa_sqlite_column_int\" \"jerboa_sqlite_column_double\"\n \"jerboa_sqlite_column_text\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_column_name\"\n ;; jerboa-native (net/io) — vectored I/O wrapper used by (std net io)\n \"jerboa_writev2\"\n ;; landlock-shim (support/landlock-shim.c)\n \"jerboa_landlock_sandbox\"\n \"jerboa_landlock_sandbox_ex\"\n \"jerboa_landlock_abi_version\"))\n\n;; ========== Step 0: Prepare isolated object output ==========\n\n(printf \"[0/7] Preparing isolated build/object directories...~n\")\n(prepare-build-dir!)\n\n;; Compile imported libraries into obj-dir while loading sources from the\n;; original --libdirs. This avoids modifying $JERBOA_HOME/lib, vendor/, or\n;; generated lib/jcode files during static builds.\n(library-directories\n (map (lambda (pair)\n (cons (if (pair? pair) (car pair) pair) obj-dir))\n (library-directories)))\n\n;; ========== Step 1: Compile all modules ==========\n\n(printf \"[1/7] Compiling all modules (optimize-level 3)...~n\")\n(parameterize ((compile-imported-libraries #t)\n (optimize-level 3)\n (cp0-effort-limit 500)\n (cp0-score-limit 50)\n (cp0-outer-unroll-limit 1)\n (commonization-level 4)\n (enable-unsafe-application #t)\n (enable-unsafe-variable-reference #t)\n (enable-arithmetic-left-associative #t)\n (debug-level 0)\n (generate-inspector-information #f))\n (compile-program \"main-binary.ss\" program-so))\n\n;; Fail loud if compile-program didn't actually produce the isolated program.\n;; Historically this failure was silent — the script would continue until\n;; step 5 died with a cryptic open-file-input-port failure.\n(unless (file-exists? program-so)\n (printf \"~n[ERROR] compile-program completed but program.so was not produced.~n\")\n (printf \" cwd: ~a~n\" (current-directory))\n (printf \" entry: main-binary.ss~n\")\n (printf \" This usually means an import in main-binary.ss could not be resolved~n\")\n (printf \" or the isolated object directory was not writable: ~a~n\" obj-dir)\n (error 'build-jcode-musl\n \"program.so not produced by compile-program\"))\n(printf \" → ~a (~a bytes)~n\"\n program-so\n (file-length (open-file-input-port program-so)))\n\n;; ========== Step 2: Skip WPO for musl builds ==========\n;; Use the direct program.so from compile-program.\n(printf \"[2/7] Skipping WPO (using isolated program.so directly)...~n\")\n\n;; ========== Step 3: Auto-discover compiled libraries ==========\n;;\n;; compile-program traversed main-binary.ss's import graph and wrote every\n;; imported library object into obj-dir. Embed all of those library objects in\n;; the boot image, excluding the entry program itself.\n\n(printf \"[3/7] Discovering libraries compiled under ~a...~n\" obj-dir)\n\n(define compiled-lib-paths\n (filter (lambda (p) (not (string=? p program-so)))\n (find-files-with-suffix obj-dir \".so\")))\n\n(printf \" Found ~a compiled library .so file(s)~n\" (length compiled-lib-paths))\n(when (null? compiled-lib-paths)\n (error 'build-jcode-musl\n (format \"No library .so files under ~a after compile-program\" obj-dir)))\n\n;; ========== Step 4: Create libs-only boot file ==========\n\n(printf \"[4/7] Creating libs-only boot file...~n\")\n(printf \" Boot file contents: ~a compiled library .so files~n\"\n (length compiled-lib-paths))\n\n(apply make-boot-file \"jcode.boot\" '(\"scheme\" \"petite\") compiled-lib-paths)\n\n;; ========== Step 5: Generate C with embedded boot files + program ==========\n\n(printf \"[5/7] Generating C with embedded boot files + program...~n\")\n\n(define musl-lib-dir (musl-chez-lib-dir))\n(define gcc (musl-gcc-path))\n(define scheme-h-dir musl-lib-dir)\n(define harden-cflags\n (string-append \"-ffile-prefix-map=\" (current-directory) \"=.\"\n \" -ffile-prefix-map=\" (or (getenv \"HOME\") \"/root\") \"=~\"))\n\n;; Get boot file paths from musl Chez installation\n(define musl-boots (musl-boot-files))\n(define petite-boot-path (cdr (assoc \"petite\" musl-boots)))\n(define scheme-boot-path (cdr (assoc \"scheme\" musl-boots)))\n\n;; Generate static_boot.c: embeds petite.boot + scheme.boot + jcode.boot\n(define static-boot-c (format \"~a/static_boot.c\" build-dir))\n(call-with-output-file static-boot-c\n (lambda (out)\n (display \"#include \\\"scheme.h\\\"\\n\\n\" out)\n (display (file->c-array petite-boot-path \"petite_boot\") out)\n (newline out)\n (display (file->c-array scheme-boot-path \"scheme_boot\") out)\n (newline out)\n (display (file->c-array \"jcode.boot\" \"jcode_boot\") out)\n (newline out)\n (display \"void static_boot_init(void) {\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"petite\\\", petite_boot, petite_boot_len);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"scheme\\\", scheme_boot, scheme_boot_len);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"jcode\\\", jcode_boot, jcode_boot_len);\\n\" out)\n (display \"}\\n\" out))\n 'replace)\n\n;; Rust native library — build a project-specific musl static lib with ONLY\n;; the cargo features jcode actually uses. jcode's FFI surface is:\n;; - jerboa_tls_* (provider/provider.ss) => feature `tls`\n;; - sqlite3_* (via jerboa-sqlite shim) => feature `sqlite`\n;; That's it. `crypto`, `duckdb_feat`, `pcap`, `spidermonkey`, `wasm`,\n;; `postgres_feat` are not referenced from any jcode source.\n;;\n;; The old fall-back-to-glibc behaviour was the recurring source of \"works on\n;; Mac, breaks on Linux\": cargo build --release during normal jerboa dev\n;; rebuilds the glibc artifact, and the musl build silently picked it up\n;; (yielding __memcpy_chk / libstdc++ link errors at the final step).\n;;\n;; We force cargo to use the rustup-managed rustc — some PATH setups (e.g.\n;; Homebrew rust ahead of the rustup proxies) resolve `rustc` to a binary\n;; that has no musl target installed. Doing it via env (not `rustup run`) is\n;; critical, because `rustup run stable cargo build` only configures cargo's\n;; environment — cargo still launches whichever `rustc` appears first on\n;; PATH for the child compilations.\n;;\n;; A sentinel file under target/ records the exact feature set that produced\n;; the .a, so future builds rebuild iff features changed or any .rs source\n;; is newer than the .a (jerboa-shell uses the same pattern).\n(define jcode-cargo-features \"tls,sqlite,crypto\")\n(define native-lib-path\n (format \"~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/libjerboa_native.a\"\n jerboa-dir-base))\n(define native-features-sentinel\n (format \"~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/.built-with-~a\"\n jerboa-dir-base\n (let ([s (string-copy jcode-cargo-features)])\n (let loop ([i 0])\n (cond [(= i (string-length s)) s]\n [(char=? (string-ref s i) #\\,) (string-set! s i #\\-) (loop (+ i 1))]\n [else (loop (+ i 1))])))))\n\n(define (rs-source-newer-than? a-path)\n (let ([src-dir (format \"~a/jerboa-native-rs/src\" jerboa-dir-base)])\n (and (file-directory? src-dir)\n (file-exists? a-path)\n (let ([a-mtime (file-modification-time a-path)])\n (let walk ([dirs (list src-dir)])\n (and (pair? dirs)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter (lambda (p) (not (file-directory? p))) entries)]\n [subs (filter file-directory? entries)])\n (or (ormap (lambda (f)\n (and (let ([n (string-length f)])\n (and (> n 3)\n (string=? \".rs\" (substring f (- n 3) n))))\n (time>? (file-modification-time f) a-mtime)))\n files)\n (walk (append subs (cdr dirs)))))))))))\n\n(define (try-cargo-build cmd)\n (printf \" $ ~a~n\" cmd)\n (zero? (system cmd)))\n\n(define (rebuild-native-lib!)\n (let* ([nrs-dir (format \"~a/jerboa-native-rs\" jerboa-dir-base)]\n [rustup-active (string-append (getenv \"HOME\")\n \"/.rustup/toolchains/stable-x86_64-unknown-linux-gnu/bin\")]\n [cargo-args (format \"build --release --no-default-features --features ~a --target x86_64-unknown-linux-musl\"\n jcode-cargo-features)]\n [via-rustup\n (format \"cd '~a' && env PATH='~a:'$PATH RUSTC='~a/rustc' cargo ~a\"\n nrs-dir rustup-active rustup-active cargo-args)]\n [via-path\n (format \"cd '~a' && cargo ~a\" nrs-dir cargo-args)]\n [ok? (or (and (file-directory? rustup-active) (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless (and ok? (file-exists? native-lib-path))\n (error 'build-jcode-musl\n (string-append\n \"failed to build jerboa-native-rs for x86_64-unknown-linux-musl. \"\n \"Required: `rustup target add x86_64-unknown-linux-musl`, musl-gcc, \"\n \"and musl headers at /usr/include/x86_64-linux-musl. Do NOT fall back \"\n \"to the glibc artifact at target/release/libjerboa_native.a — it \"\n \"references __memcpy_chk and libstdc++ symbols musl-gcc cannot link.\")\n native-lib-path))\n ;; Record the feature set this .a was built with.\n (call-with-output-file native-features-sentinel\n (lambda (out)\n (display jcode-cargo-features out)\n (newline out))\n 'truncate)))\n\n(cond\n [(not (file-exists? native-lib-path))\n (printf \"[0.2/7] Building jerboa-native-rs (musl, features=~a)...~n\" jcode-cargo-features)\n (rebuild-native-lib!)]\n [(not (file-exists? native-features-sentinel))\n (printf \"[0.2/7] Rebuilding jerboa-native-rs — sentinel missing (features=~a)...~n\" jcode-cargo-features)\n (rebuild-native-lib!)]\n [(rs-source-newer-than? native-lib-path)\n (printf \"[0.2/7] Rebuilding jerboa-native-rs — .rs source newer than .a...~n\")\n (rebuild-native-lib!)]\n [else\n (printf \"[0.2/7] jerboa-native-rs up to date (features=~a)~n\" jcode-cargo-features)])\n(define has-native-lib? #t)\n\n;; Generate jcode_main_musl.c\n(define program-c (format \"~a/jcode_main_musl.c\" build-dir))\n(call-with-output-file program-c\n (lambda (out)\n (display \"#define _GNU_SOURCE\\n\" out)\n (display \"#include <stdlib.h>\\n\" out)\n (display \"#include <string.h>\\n\" out)\n (display \"#include <stdio.h>\\n\" out)\n (display \"#include <unistd.h>\\n\" out)\n (display \"#include <sys/mman.h>\\n\" out)\n (display \"#include <sys/types.h>\\n\" out)\n (display \"#include <sys/stat.h>\\n\" out)\n (display \"#include <fcntl.h>\\n\" out)\n (display \"#include <signal.h>\\n\" out)\n (display \"#include <errno.h>\\n\" out)\n (display \"#include \\\"scheme.h\\\"\\n\\n\" out)\n ;; dlopen/dlsym stubs for static builds\n (display \"/* dlopen stubs — override musl's failing stubs in static builds */\\n\" out)\n (display \"void *dlopen(const char *filename, int flags) {\\n\" out)\n (display \" (void)flags; (void)filename;\\n\" out)\n (display \" return (void*)1; /* all symbols pre-registered via Sforeign_symbol */\\n\" out)\n (display \"}\\n\" out)\n (display \"void *dlsym(void *handle, const char *symbol) {\\n\" out)\n (display \" (void)handle; (void)symbol;\\n\" out)\n (display \" return NULL; /* symbols found via Sforeign_symbol */\\n\" out)\n (display \"}\\n\" out)\n (display \"int dlclose(void *handle) { (void)handle; return 0; }\\n\" out)\n (display \"char *dlerror(void) { return NULL; }\\n\\n\" out)\n ;; Embed program .so\n (display (file->c-array program-so \"jcode_program_data\") out)\n (newline out)\n ;; Declare static_boot_init\n (display \"extern void static_boot_init(void);\\n\\n\" out)\n ;; Declare FFI symbols (project-specific shims)\n (display \"/* FFI symbols */\\n\" out)\n (for-each\n (lambda (name) (fprintf out \"extern void ~a();\\n\" name))\n ffi-symbols)\n (newline out)\n ;; libc symbols — proper includes so prototypes match.\n ;; Adding a symbol to libc-symbols above usually requires bumping the\n ;; include set here too; otherwise the C compile fails with\n ;; \"implicit declaration\" or \"undeclared\".\n (display \"/* libc symbols for Sforeign_symbol registration */\\n\" out)\n (display \"#include <sys/socket.h>\\n\" out)\n (display \"#include <netinet/in.h>\\n\" out)\n (display \"#include <arpa/inet.h>\\n\" out)\n (display \"#include <netdb.h>\\n\" out) ;; getaddrinfo, freeaddrinfo\n (display \"#include <sys/wait.h>\\n\" out) ;; waitpid\n (display \"#include <sys/resource.h>\\n\" out) ;; getrlimit\n (display \"#include <sys/prctl.h>\\n\" out) ;; prctl\n (display \"#include <termios.h>\\n\" out) ;; tcgetattr/tcsetattr/tcgetpgrp/tcsetpgrp\n (display \"#include <signal.h>\\n\" out) ;; kill, sigemptyset/sigprocmask family\n (display \"#include <time.h>\\n\" out) ;; localtime, strftime\n (display \"#include <fcntl.h>\\n\" out) ;; fcntl\n (display \"#include <unistd.h>\\n\" out) ;; fork, dup, pipe, sysconf, ids, isatty\n (display \"#include <stdlib.h>\\n\" out) ;; setenv, unsetenv\n (display \"#include <string.h>\\n\" out) ;; strerror\n ;; __errno_location has no public header — declare it ourselves.\n (display \"extern int *__errno_location(void);\\n\" out)\n (newline out)\n ;; Register FFI symbols callback\n (display \"static void register_ffi(void) {\\n\" out)\n (for-each\n (lambda (name)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" name name))\n ffi-symbols)\n ;; Register libc symbols (already in static binary from musl)\n (for-each\n (lambda (name)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" name name))\n libc-symbols)\n (display \"}\\n\\n\" out)\n ;; Main\n (display \"int main(int argc, char *argv[]) {\\n\" out)\n (display \" /* Write program .so to temp file for Sscheme_script */\\n\" out)\n (display \" char prog_path[256];\\n\" out)\n (display \" const char *tmpdir = getenv(\\\"TMPDIR\\\");\\n\" out)\n (display \" if (!tmpdir) tmpdir = \\\"/tmp\\\";\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"%s/jcode-XXXXXX\\\", tmpdir);\\n\" out)\n (display \" int fd = mkstemp(prog_path);\\n\" out)\n (display \" if (fd < 0) { perror(\\\"mkstemp\\\"); return 1; }\\n\" out)\n (display \" if (write(fd, jcode_program_data, jcode_program_data_len)\\n\" out)\n (display \" != (ssize_t)jcode_program_data_len) {\\n\" out)\n (display \" perror(\\\"write\\\"); close(fd); unlink(prog_path); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" close(fd);\\n\\n\" out)\n (display \" /* Tell jerboa stdlib libraries (std/net/*, std/os/*, std/db/*)\\n\" out)\n (display \" * we are statically linked. Without JERBOA_STATIC=1 their\\n\" out)\n (display \" * library visit-time code calls (load-shared-object #f) which\\n\" out)\n (display \" * raises in a static binary. Variable must be set BEFORE\\n\" out)\n (display \" * Sscheme_init since libraries are visited during heap build. */\\n\" out)\n (display \" setenv(\\\"JERBOA_STATIC\\\", \\\"1\\\", 1);\\n\" out)\n (display \"\\n\" out)\n (display \" Sscheme_init(NULL);\\n\" out)\n (display \" static_boot_init();\\n\" out)\n (display \" Sbuild_heap(NULL, register_ffi);\\n\" out)\n (display \" int status = Sscheme_script(prog_path, argc, (const char **)argv);\\n\" out)\n (display \" unlink(prog_path);\\n\" out)\n (display \" Sscheme_deinit();\\n\" out)\n (display \" return status;\\n\" out)\n (display \"}\\n\" out))\n 'replace)\n\n;; ========== Step 6: Compile C with musl-gcc ==========\n\n(printf \"[6/7] Compiling C with musl-gcc...~n\")\n\n(define (run-cmd cmd)\n (printf \" ~a~n\" cmd)\n (unless (= 0 (system cmd))\n (error 'build-jcode-musl \"Command failed\" cmd)))\n\n;; Compile static_boot.c\n(run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/static_boot.o' '~a'\"\n gcc harden-cflags scheme-h-dir\n build-dir static-boot-c))\n\n;; Compile jcode_main_musl.c\n(run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/jcode_main_musl.o' '~a'\"\n gcc harden-cflags scheme-h-dir\n build-dir program-c))\n\n;; Compile jerboa-sqlite shim\n;; Copy sqlite3.h to build dir (can't use -I/usr/include with musl-gcc — glibc conflict)\n(let ([shim-src \"vendor/jerboa-sqlite/jerboa_sqlite_shim.c\"]\n [sqlite3-h \"/usr/include/sqlite3.h\"])\n (if (file-exists? shim-src)\n (begin\n (when (file-exists? sqlite3-h)\n (system (format \"cp '~a' '~a/'\" sqlite3-h build-dir)))\n (run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/jerboa-sqlite-shim.o' '~a' -Wall\"\n gcc harden-cflags build-dir build-dir shim-src)))\n (begin\n (printf \" Note: jerboa-sqlite shim not found — creating stub~n\")\n (system (format \"echo '' | ~a -c -x c -o '~a/jerboa-sqlite-shim.o' -\" gcc build-dir)))))\n\n;; Compile termbox2 TUI shim\n(run-cmd (format \"~a -c -O2 ~a -DTB_OPT_ATTR_W=32 -Ivendor/termbox2 -o '~a/jcode-tui-shim.o' src/jcode/ui/jcode_tui_shim.c -Wall\"\n gcc harden-cflags build-dir))\n\n;; Compile landlock shim from this repo.\n(let ([landlock-src \"support/landlock-shim.c\"])\n (if (file-exists? landlock-src)\n (run-cmd (format \"~a -c -O2 ~a -o '~a/landlock-shim.o' '~a' -Wall\"\n gcc harden-cflags build-dir landlock-src))\n (begin\n (printf \" Note: landlock-shim.c not found — creating stub~n\")\n (system (format \"echo '' | ~a -c -x c -o '~a/landlock-shim.o' -\" gcc build-dir)))))\n\n;; ========== Step 7: Link static binary ==========\n\n(printf \"[7/7] Linking static jcode-musl binary...~n\")\n\n(let ([link-cmd (apply musl-link-command\n \"jcode-musl\"\n (list (format \"~a/jcode_main_musl.o\" build-dir)\n (format \"~a/static_boot.o\" build-dir)\n (format \"~a/jerboa-sqlite-shim.o\" build-dir)\n (format \"~a/jcode-tui-shim.o\" build-dir)\n (format \"~a/landlock-shim.o\" build-dir))\n ;; Rust native lib includes sqlite3, TLS (rustls), regex, etc.\n (if has-native-lib?\n (list native-lib-path)\n (list \"/usr/lib/x86_64-linux-gnu/libsqlite3.a\"))\n '(no-harden: #t))])\n ;; GCC 13+ libgcc_eh.a references _dl_find_object (glibc 2.35+) which\n ;; doesn't exist in musl. Stub it out with --defsym.\n (run-cmd (string-append link-cmd\n \" -Wl,--allow-multiple-definition\"\n \" -Wl,--defsym=_dl_find_object=0\")))\n\n;; ========== Hardening: strip + integrity hash ==========\n\n(when (file-exists? \"jcode-musl\")\n (printf \"~n[harden] Stripping symbols...~n\")\n (let ([pre-size (file-length (open-file-input-port \"jcode-musl\"))])\n (run-cmd \"strip --strip-all jcode-musl\")\n (when (= 0 (system \"objcopy --strip-section-headers jcode-musl 2>/dev/null\"))\n (printf \" Section headers removed~n\"))\n (let ([post-size (file-length (open-file-input-port \"jcode-musl\"))])\n (printf \" Stripped: ~a → ~a bytes (~a% reduction)~n\"\n pre-size post-size\n (inexact->exact (round (* 100 (/ (- pre-size post-size) pre-size))))))))\n\n;; Compute SHA-256 integrity hash\n(when (file-exists? \"jcode-musl\")\n (printf \"[harden] Computing integrity hash...~n\")\n (system \"sha256sum jcode-musl | cut -d' ' -f1 | tr -d '\\\\n' > /tmp/_jcode_hash.txt\")\n (let ([hash-hex (call-with-input-file \"/tmp/_jcode_hash.txt\" get-string-all)])\n (system \"rm -f /tmp/_jcode_hash.txt\")\n (printf \" SHA-256: ~a~n\" hash-hex)\n (when (= (string-length hash-hex) 64)\n (let ([bv (make-bytevector 32)])\n (do ([i 0 (+ i 1)])\n ((= i 32))\n (bytevector-u8-set! bv i\n (string->number (substring hash-hex (* i 2) (+ (* i 2) 2)) 16)))\n (let ([port (open-file-output-port \"jcode-musl.sha256\" (file-options no-fail))])\n (put-bytevector port bv)\n (close-port port))\n (printf \" Wrote jcode-musl.sha256 (32 bytes)~n\")))))\n\n;; ========== Cleanup isolated build files ==========\n\n(printf \"~n[cleanup] Removing isolated build directory...~n\")\n(cleanup-build-dir!)\n(for-each (lambda (f)\n (when (file-exists? f) (delete-file f)))\n '(\"jcode.boot\"))\n\n;; Summary\n(printf \"~n========================================~n\")\n(printf \"Static binary created: jcode-musl~n~n\")\n(system \"ls -lh jcode-musl\")\n(printf \"~n\")\n(system \"file jcode-musl\")\n(printf \"~nTest: ./jcode-musl --help~n\")\n"} {"text":";; FILE: jerboa-code/CLAUDE.md\n# jerboa-code — Project Instructions\n\n## MANDATORY: Editing .ss Files\n\n**ALWAYS use `jerboa_balanced_replace` (MCP tool) instead of `Edit` when modifying `.ss` Scheme source files.**\n\nIt validates parenthesis balance before AND after the change, rejecting edits that break balance. This prevents the most common class of bug in this project.\n\n```\n# Workflow for every .ss edit:\n1. jerboa_balanced_replace (dry_run: true) — preview\n2. jerboa_balanced_replace (dry_run: false) — apply\n3. jerboa_check_balance — confirm file is clean\n```\n\nIf you need to add a new top-level `def`/`def`/`defstruct` form, prefer appending with `jerboa_balanced_replace` on a known anchor string rather than writing free-form code with `Edit`.\n\nAfter ALL edits to .ss files, run `jerboa_check_balance` on every modified file before attempting `make build`.\n\n## NEVER COMMIT THESE FILES\n\n**`jcode.json` contains live API keys. It is in `.gitignore`. NEVER stage or commit it.**\n\nDo not commit any file matching: `*.json` in the project root, `.env`, `*secret*`, `*key*`, `*token*` unless you have read its full contents and confirmed it has no credentials.\n\nWhen committing, always run `git diff --cached` and scan for key-shaped strings (`sk-`, `AIza`, `Bearer `) before confirming.\n\n## Build\n\n```bash\nmake build # compiles src/ → lib/ via jerbuild\nmake test # runs test/run.ss\nmake run # interactive agent REPL\n```\n\nEntry point: `main.ss`. Source lives under `src/jcode/`.\n\n## Architecture\n\n```\nsrc/jcode/\n core/ agent.ss config.ss log.ss message.ss session.ss\n provider/ provider.ss\n tool/ registry.ss file.ss bash.ss web.ss batch.ss\n ui/ cli.ss\n```\n\n## Language\n\nThis is Jerboa Scheme compiled by jerbuild. Files are `.ss`. Never write `.sls` — those are generated output in `lib/`. See `~/.claude/CLAUDE.md` for the full Jerboa language reference.\n\n## Act First, Read Less\n\nWhen making changes, read only what you need to make the edit, then make it.\nDo not read more than 3 files before acting. Do not re-read files you already\nread. Do not verify things you already know. If you have enough context to make\na change, make it. The user will interrupt you if you are wrong.\n"} {"text":";; FILE: jerboa-code/test/run.ss\n#!/usr/bin/env scheme --script\n;;; jcode test suite\n\n(import (chezscheme)\n (jcode core log)\n (jcode core agent-defs)\n (jcode tool task)\n (jcode core builtin-skills)\n (jcode core message)\n (jcode core grok-auth)\n (jcode core config)\n (jcode core escalation)\n (jcode core agent)\n (jcode core models)\n (jcode core secrets-import)\n (jcode provider provider)\n (jcode tool registry)\n (jcode tool file)\n (jcode tool bash)\n (jcode tool todo)\n (jcode tool external-llm)\n (jcode tool verified)\n (jcode guardrails nudge)\n (jcode guardrails error-tracker)\n (jcode guardrails message-type)\n (jcode guardrails rescue)\n (jcode guardrails validator)\n (jcode guardrails respond)\n (jcode guardrails guardrails)\n (jcode core errors)\n (jcode provider sampling)\n (jcode core hardware)\n (jcode core compaction)\n (jcode core compaction-strategy)\n (jcode core workflow)\n (jcode core steps)\n (jcode guardrails step-enforcer)\n (jcode core workflow-runner)\n (jcode core verified)\n (jcode core best-of-k)\n (jcode core verified-run)\n (jcode proxy convert)\n (jcode proxy handler)\n (jcode ui tui-message)\n (jcode core slot-worker)\n (jcode proxy server)\n (jcode eval scenario)\n (jcode eval ablation)\n (jcode eval runner)\n (std text json)\n (std net tcp))\n\n;; ── Helpers ──────────────────────────────────────────────────────\n\n(define pass-count 0)\n(define fail-count 0)\n\n(define (check! desc result expected)\n (if (equal? result expected)\n (begin (set! pass-count (+ pass-count 1))\n (printf \" PASS: ~a~n\" desc))\n (begin (set! fail-count (+ fail-count 1))\n (printf \" FAIL: ~a~n expected: ~s~n got: ~s~n\" desc expected result))))\n\n(define (check-pred! desc result pred)\n (if (pred result)\n (begin (set! pass-count (+ pass-count 1))\n (printf \" PASS: ~a~n\" desc))\n (begin (set! fail-count (+ fail-count 1))\n (printf \" FAIL: ~a~n got: ~s~n\" desc result))))\n\n(define (section name) (printf \"~n~a~n\" name))\n\n;; Build an args hashtable from flat key/value pairs\n(define (args . pairs)\n (let ([h (make-hashtable equal-hash equal?)])\n (let loop ([p pairs])\n (unless (null? p)\n (hashtable-set! h (car p) (cadr p))\n (loop (cddr p))))\n h))\n\n(define (str-contains? s needle)\n (let ([slen (string-length s)] [nlen (string-length needle)])\n (let loop ([i 0])\n (cond [(> (+ i nlen) slen) #f]\n [(string=? (substring s i (+ i nlen)) needle) #t]\n [else (loop (+ i 1))]))))\n\n(define (str-prefix? p s)\n (and (>= (string-length s) (string-length p))\n (string=? (substring s 0 (string-length p)) p)))\n\n(define (string-trim-right s)\n (let loop ([i (string-length s)])\n (if (and (> i 0) (char-whitespace? (string-ref s (- i 1))))\n (loop (- i 1))\n (substring s 0 i))))\n\n(define (condition->string thunk)\n (guard (e [(condition? e)\n (with-output-to-string (lambda () (display-condition e)))])\n (call-with-values thunk (lambda vals #f))))\n\n(define (msg-block-plain-text m)\n (apply string-append\n (map (lambda (line)\n (apply string-append (map car line)))\n (msg-block-lines m))))\n\n(define (read-test-http-request in)\n (let header-loop ([content-length 0])\n (let ([line (get-line in)])\n (cond\n [(eof-object? line) (void)]\n [(or (string=? line \"\") (string=? line \"\\r\"))\n (let ([body (open-output-string)])\n (let drain ([remaining content-length])\n (when (> remaining 0)\n (let ([c (read-char in)])\n (unless (eof-object? c)\n (write-char c body)\n (drain (- remaining 1))))))\n (get-output-string body))]\n [else\n (let ([clean (string-trim-right line)])\n (header-loop\n (if (str-prefix? \"Content-Length: \" clean)\n (or (string->number\n (substring clean (string-length \"Content-Length: \")\n (string-length clean)))\n content-length)\n content-length)))]))))\n\n(define (serve-one-chunked-500! srv body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (read-test-http-request in)\n (let ([chunk-size (number->string (string-length body) 16)])\n (put-string out\n (string-append\n \"HTTP/1.1 500 Internal Server Error\\r\\n\"\n \"Content-Type: application/json\\r\\n\"\n \"Transfer-Encoding: chunked\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n chunk-size \"\\r\\n\"\n body \"\\r\\n\"\n \"0\\r\\n\"\n \"\\r\\n\"))\n (flush-output-port out)))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n(define (serve-one-captured-sse! srv captured-body body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (vector-set! captured-body 0 (read-test-http-request in))\n (put-string out\n (string-append\n \"HTTP/1.1 200 OK\\r\\n\"\n \"Content-Type: text/event-stream\\r\\n\"\n \"Content-Length: \" (number->string (string-length body)) \"\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n body))\n (flush-output-port out))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n(define (serve-one-captured-json! srv captured-body status body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (vector-set! captured-body 0 (read-test-http-request in))\n (put-string out\n (string-append\n \"HTTP/1.1 \" (number->string status) \" OK\\r\\n\"\n \"Content-Type: application/json\\r\\n\"\n \"Content-Length: \" (number->string (string-length body)) \"\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n body))\n (flush-output-port out))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n;; ── Setup ─────────────────────────────────────────────────────────\n\n(current-log-level 'warn)\n(init-file-tools)\n(init-bash-tool)\n(init-todo-tool)\n\n;; ── Message tests ─────────────────────────────────────────────────\n\n(section \"=== message ===\")\n\n(let ([m (make-user-message \"hello\")])\n (check! \"user role\" (message-role m) \"user\")\n (check! \"user content\" (message-content m) \"hello\")\n (check! \"user no tcs\" (message-tool-calls m) #f))\n\n(let ([m (make-assistant-message \"hi\")])\n (check! \"assistant role\" (message-role m) \"assistant\")\n (check! \"assistant content\" (message-content m) \"hi\"))\n\n(let* ([tc (make-tool-call \"read\" \"{\\\"path\\\":\\\"foo\\\"}\")]\n [m (make-assistant-message #f (list tc))]\n [j (message->json m)])\n (check! \"assistant tool-call json content\" (hashtable-ref j \"content\" #f) \"\")\n (check-pred! \"assistant tool-call json tcs\" (hashtable-ref j \"tool_calls\" #f) pair?))\n\n(let* ([tc-empty (make-tool-call \"verify\" '())]\n [tc-assoc (make-tool-call \"edit\" '((\"path\" . \"x.ss\") (\"content\" . \"body\")))]\n [m (make-assistant-message #f (list tc-empty tc-assoc))]\n [j (message->json m)]\n [tcs (hashtable-ref j \"tool_calls\" #f)]\n [empty-fn (hashtable-ref (car tcs) \"function\" #f)]\n [assoc-fn (hashtable-ref (cadr tcs) \"function\" #f)]\n [assoc-args (string->json-object (hashtable-ref assoc-fn \"arguments\" \"\"))])\n (check! \"assistant tool-call empty args object\"\n (hashtable-ref empty-fn \"arguments\" #f) \"{}\")\n (check! \"assistant tool-call assoc args path\"\n (hashtable-ref assoc-args \"path\" #f) \"x.ss\")\n (check! \"assistant tool-call assoc args content\"\n (hashtable-ref assoc-args \"content\" #f) \"body\"))\n\n(let ([tc (make-tool-call \"read\" \"{\\\"path\\\":\\\"foo\\\"}\")])\n (check! \"tool-call name\" (tool-call-name tc) \"read\")\n (check! \"tool-call args\" (tool-call-arguments tc) \"{\\\"path\\\":\\\"foo\\\"}\")\n (check-pred! \"tool-call id non-empty\" (tool-call-id tc)\n (lambda (s) (> (string-length s) 0))))\n\n(let ([tc (restore-tool-call \"my-id\" \"bash\" \"{}\")])\n (check! \"restore-tool-call id\" (tool-call-id tc) \"my-id\"))\n\n(let ([m (make-tool-result \"call-123\" \"result\")])\n (check! \"tool-result role\" (message-role m) \"tool\")\n (check! \"tool-result content\" (message-content m) \"result\")\n (check! \"tool-result call-id\" (message-tool-call-id m) \"call-123\"))\n\n;; ── File tool tests ───────────────────────────────────────────────\n\n(section \"=== file tools ===\")\n\n;; write + read round-trip\n(let* ([tmp \"/tmp/jcode-test-write.txt\"]\n [data \"hello\\nworld\\n\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" data))]\n [r (tool-execute \"read\" (args \"path\" tmp))])\n (check! \"write+read round-trip\" r data))\n\n;; read missing file\n(let ([r (tool-execute \"read\" (args \"path\" \"/tmp/jcode-no-such-file-xyz-abc\"))])\n (check-pred! \"read missing returns error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; edit\n(let* ([tmp \"/tmp/jcode-test-edit.txt\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" \"foo bar baz\"))]\n [_ (tool-execute \"edit\" (args \"path\" tmp \"old_str\" \"bar\" \"new_str\" \"QUX\"))]\n [r (tool-execute \"read\" (args \"path\" tmp))])\n (check! \"edit replaces string\" r \"foo QUX baz\"))\n\n;; edit missing string\n(let* ([tmp \"/tmp/jcode-test-edit2.txt\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" \"abc\"))]\n [r (tool-execute \"edit\" (args \"path\" tmp \"old_str\" \"zzz\" \"new_str\" \"q\"))])\n (check-pred! \"edit missing string returns error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; generated artifact guard is workspace-aware\n(let ([root (format \"/tmp/jcode-artifact-generated-~a\" (random 100000000))])\n (mkdir root)\n (parameterize ([current-directory root])\n (tool-execute \"write\" (args \"path\" \"src/pkg/foo.ss\" \"content\" \"source\"))\n (let ([r (tool-execute \"write\" (args \"path\" \"lib/pkg/foo.sls\" \"content\" \"generated\"))])\n (check-pred! \"generated .sls with src counterpart refused\" r\n (lambda (s) (and (str-prefix? \"Error:\" s)\n (str-contains? s \"src/pkg/foo.ss\")))))))\n\n(let ([root (format \"/tmp/jcode-artifact-source-~a\" (random 100000000))])\n (mkdir root)\n (parameterize ([current-directory root])\n (let ([r (tool-execute \"write\" (args \"path\" \"lib/pkg/foo.sls\" \"content\" \"source-sls\"))])\n (check-pred! \"source .sls without src counterpart allowed\" r\n (lambda (s) (str-prefix? \"Successfully wrote\" s))))\n (check! \"source .sls write persisted\"\n (tool-execute \"read\" (args \"path\" \"lib/pkg/foo.sls\"))\n \"source-sls\")))\n\n;; glob\n(let ([r (tool-execute \"glob\" (args \"pattern\" \"*.ss\" \"path\" (current-directory)))])\n (check-pred! \"glob finds root .ss files\" r\n (lambda (s) (str-contains? s \"main.ss\"))))\n\n(let ([r (tool-execute \"glob\" (args \"pattern\" \"**/*.ss\" \"path\" (current-directory)))])\n (check-pred! \"glob finds src .ss files\" r\n (lambda (s) (str-contains? s \".ss\"))))\n\n;; ls\n(let ([r (tool-execute \"ls\" (args \"path\" \".\"))])\n (check-pred! \"ls lists src dir\" r (lambda (s) (str-contains? s \"src\")))\n (check-pred! \"ls marks dirs with /\" r (lambda (s) (str-contains? s \"src/\"))))\n\n(let ([r (tool-execute \"ls\" (args \"path\" \"/tmp/no-such-dir-xyz\"))])\n (check-pred! \"ls missing dir error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; grep\n(let ([r (tool-execute \"grep\" (args \"pattern\" \"cli-main\"\n \"path\" \"src/jcode/ui/cli.ss\"))])\n (check-pred! \"grep finds pattern\" r (lambda (s) (str-contains? s \"cli-main\"))))\n\n(let ([r (tool-execute \"grep\" (args \"pattern\" \"zzz_not_found_zzz\"\n \"path\" \"src/jcode/ui/cli.ss\"))])\n (check! \"grep no match\" r \"No matches found\"))\n\n;; ── Bash tool tests ───────────────────────────────────────────────\n\n(section \"=== bash tool ===\")\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"echo hello\"))])\n (check! \"bash echo\" (string-trim-right r) \"hello\"))\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"echo -n abc && echo def\"))])\n (check-pred! \"bash multi-cmd\" r (lambda (s) (str-contains? s \"abc\"))))\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"exit 42\"))])\n (check-pred! \"bash non-zero exit shown\" r (lambda (s) (str-contains? s \"Exit code\"))))\n\n(let* ([todo1 (args \"content\" \"Inspect sidebar\" \"status\" \"completed\")]\n [todo2 (args \"content\" \"Wire todo list\" \"status\" \"in_progress\")]\n [r (tool-execute \"todowrite\" (args \"todos\" (list todo1 todo2)))])\n (check-pred! \"todowrite progress summary\"\n r\n (lambda (s) (str-contains? s \"1 of 2 complete\"))))\n\n;; ── TUI rendering ─────────────────────────────────────────────────\n\n(section \"=== tui rendering ===\")\n\n(let* ([esc (integer->char #x1b)]\n [colored (string-append \"Error: \"\n (string esc) \"[91m\"\n (string esc) \"[1mboom\"\n (string esc) \"[0m ok\")]\n [m (msg-block-assistant colored)])\n (check! \"assistant strips ansi escapes\"\n (msg-block-plain-text m)\n \"Error: boom ok\"))\n\n;; ── Text-form tool call recovery ──────────────────────────────────\n;; Local Ollama-hosted GGUF models (fine-tuned Qwen/Hermes etc.) often\n;; emit tool calls as text in the content stream instead of via the\n;; structured tool_calls field. extract-text-tool-calls lifts those.\n\n(section \"=== text-form tool call recovery ===\")\n(printf \"DEBUG model-rejects-tools? = ~s~n\" model-rejects-tools?)\n(printf \"DEBUG extract-text-tool-calls = ~s~n\" extract-text-tool-calls)\n\n(define (extract-call s)\n ;; Returns (list stripped count name args) for the first recovered call.\n (call-with-values\n (lambda () (extract-text-tool-calls s))\n (lambda (stripped extras)\n (list stripped (length extras)\n (and (pair? extras) (tool-call-name (car extras)))\n (and (pair? extras) (tool-call-arguments (car extras)))))))\n\n(let ([r (extract-call\n \"Sure:\\n```json\\n{\\\"name\\\":\\\"grep\\\",\\\"arguments\\\":{\\\"pattern\\\":\\\"defstruct\\\",\\\"path\\\":\\\"src\\\"}}\\n```\\nDone.\")])\n (check! \"md-fence count\" (list-ref r 1) 1)\n (check! \"md-fence name\" (list-ref r 2) \"grep\")\n (check-pred! \"md-fence args has pattern\" (list-ref r 3)\n (lambda (s) (str-contains? s \"defstruct\"))))\n\n(let ([r (extract-call\n \"<tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call>\")])\n (check! \"qwen tag count\" (list-ref r 1) 1)\n (check! \"qwen tag name\" (list-ref r 2) \"ls\"))\n\n(let ([r (extract-call \"Just a normal answer with no tool call.\")])\n (check! \"no-match count\" (list-ref r 1) 0)\n (check! \"no-match stripped\" (list-ref r 0) \"Just a normal answer with no tool call.\"))\n\n;; A code block that *isn't* a tool call (no name+arguments) must stay put.\n(let ([r (extract-call \"```json\\n{\\\"foo\\\":1,\\\"bar\\\":2}\\n```\")])\n (check! \"non-tc fence kept\" (list-ref r 1) 0)\n (check-pred! \"non-tc fence content intact\" (list-ref r 0)\n (lambda (s) (str-contains? s \"\\\"foo\\\":1\"))))\n\n;; Multiple calls in one response, with surrounding text.\n(let ([r (call-with-values\n (lambda ()\n (extract-text-tool-calls\n (string-append\n \"First:\\n<tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call>\"\n \"\\nThen:\\n<tool_call>{\\\"name\\\":\\\"grep\\\",\\\"arguments\\\":{\\\"pattern\\\":\\\"x\\\"}}</tool_call>\")))\n list)])\n (check! \"two-call count\" (length (cadr r)) 2)\n (check! \"two-call names\"\n (map tool-call-name (cadr r))\n '(\"ls\" \"grep\")))\n\n;; recover-text-tool-calls on a message must merge into the structured list.\n(let* ([orig (make-assistant-message\n \"Reply:\\n```json\\n{\\\"name\\\":\\\"bash\\\",\\\"arguments\\\":{\\\"command\\\":\\\"ls\\\"}}\\n```\")]\n [fixed (recover-text-tool-calls orig)])\n (check-pred! \"recover: tool-calls populated\" (message-tool-calls fixed)\n (lambda (lst) (and (list? lst) (= (length lst) 1))))\n (check! \"recover: tool-call name\"\n (tool-call-name (car (message-tool-calls fixed))) \"bash\"))\n\n;; ── Guardrails: nudges ────────────────────────────────────────────\n;; Verbatim port of forge's nudge templates. Texts must be byte-for-byte\n;; identical to forge — these checks lock that down.\n\n(section \"=== guardrails: nudges ===\")\n\n(check! \"retry-nudge-text verbatim\"\n (retry-nudge-text \"anything\")\n (string-append\n \"Your previous response was not a valid tool call. \"\n \"You must respond with a tool call, not free text. \"\n \"Please try again with a valid tool call.\"))\n\n(let ([n (make-retry-nudge \"junk\")])\n (check! \"retry nudge role\" (nudge-role n) \"user\")\n (check! \"retry nudge kind\" (nudge-kind n) \"retry\")\n (check! \"retry nudge tier\" (nudge-tier n) 0))\n\n(check! \"unknown-tool-nudge-text verbatim\"\n (unknown-tool-nudge-text \"foo\" '(\"a\" \"b\"))\n \"Tool 'foo' does not exist. Available tools: a, b. Call one of them.\")\n\n(check! \"unknown-tool nudge kind\"\n (nudge-kind (make-unknown-tool-nudge \"foo\" '(\"a\" \"b\"))) \"unknown_tool\")\n\n(check! \"step-nudge tier 1 verbatim\"\n (step-nudge-text \"respond\" '(\"read\") 1)\n (string-append\n \"You cannot call respond yet. \"\n \"You must first complete these required steps: read. \"\n \"Call one of them now.\"))\n\n(check! \"step-nudge tier 2 verbatim\"\n (step-nudge-text \"respond\" '(\"read\" \"grep\") 2)\n \"You must call one of these tools now: read, grep. Pick one.\")\n\n(check! \"step-nudge tier 3 verbatim\"\n (step-nudge-text \"respond\" '(\"read\") 3)\n (string-append\n \"STOP. You MUST call one of: read. \"\n \"Do NOT call respond. \"\n \"Your next response MUST be a tool call to one of: read.\"))\n\n;; tier clamps to 1..3\n(check! \"step-nudge tier 0 clamps to 1\"\n (step-nudge-text \"respond\" '(\"read\") 0)\n (step-nudge-text \"respond\" '(\"read\") 1))\n(check! \"step-nudge tier 9 clamps to 3\"\n (step-nudge-text \"respond\" '(\"read\") 9)\n (step-nudge-text \"respond\" '(\"read\") 3))\n\n(let ([n (make-step-nudge \"respond\" '(\"read\") 2)])\n (check! \"step nudge kind\" (nudge-kind n) \"step\")\n (check! \"step nudge tier preserved\" (nudge-tier n) 2))\n\n(check! \"prerequisite-nudge-text verbatim\"\n (prerequisite-nudge-text \"write\" '(\"read\"))\n \"You cannot call write yet. You must first call: read. Call the prerequisite tool now.\")\n\n(check! \"prerequisite nudge kind\"\n (nudge-kind (make-prerequisite-nudge \"write\" '(\"read\"))) \"prerequisite\")\n\n;; ── Guardrails: error tracker ─────────────────────────────────────\n;; Exhaustion is strict `>`: a budget of N tolerates N, the (N+1)th trips it.\n\n(section \"=== guardrails: error tracker ===\")\n\n(let ([t (make-error-tracker 3 2)])\n (check! \"fresh retries 0\" (error-tracker-consecutive-retries t) 0)\n (check! \"fresh tool-errs 0\" (error-tracker-consecutive-tool-errors t) 0)\n (check! \"fresh not exhausted\" (error-tracker-retries-exhausted? t) #f)\n\n ;; 3 retries == budget, not yet exhausted (3 > 3 is false)\n (error-tracker-record-retry! t)\n (error-tracker-record-retry! t)\n (error-tracker-record-retry! t)\n (check! \"retries at budget count\" (error-tracker-consecutive-retries t) 3)\n (check! \"retries at budget ok\" (error-tracker-retries-exhausted? t) #f)\n ;; 4th trips it\n (error-tracker-record-retry! t)\n (check! \"retries over budget\" (error-tracker-retries-exhausted? t) #t)\n ;; reset clears\n (error-tracker-reset-retries! t)\n (check! \"retries reset\" (error-tracker-retries-exhausted? t) #f)\n (check! \"retries reset to 0\" (error-tracker-consecutive-retries t) 0))\n\n(let ([t (make-error-tracker 3 2)])\n ;; success never increments\n (error-tracker-record-result! t #t)\n (check! \"success no tool-err\" (error-tracker-consecutive-tool-errors t) 0)\n ;; soft errors do not count\n (error-tracker-record-result! t #f #t)\n (check! \"soft-err no count\" (error-tracker-consecutive-tool-errors t) 0)\n ;; 2 hard errors == budget, not exhausted\n (error-tracker-record-result! t #f)\n (error-tracker-record-result! t #f)\n (check! \"tool-errs at budget\" (error-tracker-consecutive-tool-errors t) 2)\n (check! \"tool-errs at budget ok\" (error-tracker-tool-errors-exhausted? t) #f)\n ;; 3rd trips it\n (error-tracker-record-result! t #f)\n (check! \"tool-errs over budget\" (error-tracker-tool-errors-exhausted? t) #t)\n ;; clean batch resets\n (error-tracker-reset-errors! t)\n (check! \"tool-errs reset\" (error-tracker-tool-errors-exhausted? t) #f))\n\n;; ── Guardrails: message types ─────────────────────────────────────\n\n(section \"=== guardrails: message types ===\")\n\n(check! \"mt system_prompt\" message-type-system-prompt \"system_prompt\")\n(check! \"mt tool_call\" message-type-tool-call \"tool_call\")\n(check! \"mt retry_nudge\" message-type-retry-nudge \"retry_nudge\")\n(check! \"mt summary\" message-type-summary \"summary\")\n(check! \"message-type? valid\" (message-type? \"tool_result\") #t)\n(check! \"message-type? invalid\" (message-type? \"bogus\") #f)\n(check! \"kind retry->retry_nudge\"\n (nudge-kind->message-type \"retry\") \"retry_nudge\")\n(check! \"kind unknown_tool->retry_nudge\"\n (nudge-kind->message-type \"unknown_tool\") \"retry_nudge\")\n(check! \"kind step->step_nudge\"\n (nudge-kind->message-type \"step\") \"step_nudge\")\n(check! \"kind prerequisite->prerequisite_nudge\"\n (nudge-kind->message-type \"prerequisite\") \"prerequisite_nudge\")\n(check! \"kind unknown->#f\"\n (nudge-kind->message-type \"wat\") #f)\n\n;; ── Guardrails: rescue ────────────────────────────────────────────\n;; Canonical 4-strategy tool-call rescue from free text. Args are stored as\n;; a JSON string (jcode convention).\n\n(section \"=== guardrails: rescue ===\")\n\n(define (rescue1 text tools)\n ;; (count . name . args) for the first recovered call\n (let ([calls (rescue-tool-call text tools)])\n (list (length calls)\n (and (pair? calls) (tool-call-name (car calls)))\n (and (pair? calls) (tool-call-arguments (car calls))))))\n\n;; strip-think-tags\n(check! \"strip <think>\"\n (strip-think-tags \"before<think>secret</think>after\") \"beforeafter\")\n(check! \"strip [THINK]\"\n (strip-think-tags \"a[THINK]x[/THINK]b\") \"ab\")\n(check! \"strip unterminated think left intact\"\n (strip-think-tags \"keep <think> this\") \"keep <think> this\")\n\n;; strategy 1: JSON (forge style + OpenAI style + fences + tags + prose)\n(let ([r (rescue1 \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{\\\"pattern\\\":\\\"x\\\"}}\" '(\"grep\"))])\n (check! \"json forge-style count\" (list-ref r 0) 1)\n (check! \"json forge-style name\" (list-ref r 1) \"grep\")\n (check-pred! \"json forge-style args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"pattern\"))))\n\n(let ([r (rescue1 \"```json\\n{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}\\n```\" '(\"ls\"))])\n (check! \"json openai+fence count\" (list-ref r 0) 1)\n (check! \"json openai+fence name\" (list-ref r 1) \"ls\"))\n\n(let ([r (rescue1 \"Sure: <tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call> done\" '(\"ls\"))])\n (check! \"json in <tool_call> tag\" (list-ref r 1) \"ls\"))\n\n(let ([calls (rescue-tool-call\n \"{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}} then {\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\"\n '(\"ls\" \"grep\"))])\n (check! \"json multi count\" (length calls) 2)\n (check! \"json multi names\" (map tool-call-name calls) '(\"ls\" \"grep\")))\n\n(check! \"json unknown tool → none\"\n (length (rescue-tool-call \"{\\\"tool\\\":\\\"nope\\\",\\\"args\\\":{}}\" '(\"ls\"))) 0)\n(check! \"non-tool json → none\"\n (length (rescue-tool-call \"{\\\"foo\\\":1,\\\"bar\\\":2}\" '(\"ls\"))) 0)\n\n;; think block is stripped before rescue (a call inside it is ignored)\n(let ([r (rescue1 \"<think>{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}}</think>{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\"\n '(\"ls\" \"grep\"))])\n (check! \"think-block call ignored, body wins\" (list-ref r 1) \"grep\"))\n\n;; strategy 2: rehearsal name[ARGS]{...}\n(let ([r (rescue1 \"Let me call grep[ARGS]{\\\"pattern\\\":\\\"defstruct\\\"}\" '(\"grep\"))])\n (check! \"rehearsal count\" (list-ref r 0) 1)\n (check! \"rehearsal name\" (list-ref r 1) \"grep\")\n (check-pred! \"rehearsal args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"defstruct\"))))\n\n;; strategy 3: Qwen Coder XML\n(let ([r (rescue1 \"<function=ls><parameter=path>.</parameter></function>\" '(\"ls\"))])\n (check! \"qwen-xml count\" (list-ref r 0) 1)\n (check! \"qwen-xml name\" (list-ref r 1) \"ls\")\n (check-pred! \"qwen-xml args has path\" (list-ref r 2)\n (lambda (s) (str-contains? s \"path\"))))\n\n;; Qwen newline stripping: one leading + one trailing newline removed\n(let ([r (rescue1 \"<function=write><parameter=content>\\nhello\\n</parameter></function>\" '(\"write\"))])\n (check-pred! \"qwen-xml value newline-stripped\" (list-ref r 2)\n (lambda (s) (str-contains? s \"hello\"))))\n\n;; strategy 4: Mistral [TOOL_CALLS]name{...}\n(let ([r (rescue1 \"[TOOL_CALLS]grep{\\\"pattern\\\":\\\"x\\\"}\" '(\"grep\"))])\n (check! \"mistral count\" (list-ref r 0) 1)\n (check! \"mistral name\" (list-ref r 1) \"grep\"))\n\n(let ([r (rescue1 \"[TOOL_CALLS]grep {\\\"pattern\\\":\\\"x\\\"}\" '(\"grep\"))])\n (check! \"mistral whitespace before brace\" (list-ref r 1) \"grep\"))\n\n;; string-aware brace scan: a '}' inside a JSON string must not close early\n(let ([r (rescue1 \"[TOOL_CALLS]bash{\\\"command\\\":\\\"echo }\\\"}\" '(\"bash\"))])\n (check! \"mistral string-aware count\" (list-ref r 0) 1)\n (check-pred! \"mistral string-aware args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"command\"))))\n\n;; strategy ordering: JSON present → strategy 1 wins, rehearsal not double-counted\n(let ([r (rescue1 \"{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}} and grep[ARGS]{\\\"pattern\\\":\\\"x\\\"}\"\n '(\"ls\" \"grep\"))])\n (check! \"ordering: json wins\" (list-ref r 1) \"ls\"))\n\n;; nothing parseable\n(check! \"no tool call → empty\"\n (length (rescue-tool-call \"Just a normal answer.\" '(\"ls\" \"grep\"))) 0)\n\n;; ── guardrails: validator ──────────────────────────────────────────\n(section \"=== guardrails: validator ===\")\n\n(define v (make-response-validator '(\"ls\" \"grep\") #t))\n\n;; structured valid tool calls pass through\n(let ([r (validate-response v #f (list (make-tool-call \"ls\" \"{}\")))])\n (check! \"validator valid: no retry\" (validation-result-needs-retry? r) #f)\n (check! \"validator valid: tool-calls returned\"\n (length (validation-result-tool-calls r)) 1))\n\n;; unknown tool name -> retry nudge (unknown_tool kind)\n(let ([r (validate-response v #f (list (make-tool-call \"nope\" \"{}\")))])\n (check! \"validator unknown: needs retry\" (validation-result-needs-retry? r) #t)\n (check! \"validator unknown: no tool-calls\" (validation-result-tool-calls r) #f)\n (check! \"validator unknown: nudge kind\"\n (nudge-kind (validation-result-nudge r)) \"unknown_tool\"))\n\n;; bare text that contains a rescuable call -> recovered, no retry\n(let ([r (validate-response v \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{\\\"pattern\\\":\\\"x\\\"}}\" '())])\n (check! \"validator rescue: no retry\" (validation-result-needs-retry? r) #f)\n (check! \"validator rescue: name\"\n (tool-call-name (car (validation-result-tool-calls r))) \"grep\"))\n\n;; bare prose -> retry nudge (retry kind)\n(let ([r (validate-response v \"I think the answer is 42.\" '())])\n (check! \"validator prose: needs retry\" (validation-result-needs-retry? r) #t)\n (check! \"validator prose: nudge kind\"\n (nudge-kind (validation-result-nudge r)) \"retry\"))\n\n;; rescue disabled -> a rescuable bare text still retries\n(let* ([v2 (make-response-validator '(\"grep\") #f)]\n [r (validate-response v2 \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\" '())])\n (check! \"validator rescue-disabled: needs retry\" (validation-result-needs-retry? r) #t))\n\n;; ── guardrails: respond ────────────────────────────────────────────\n(section \"=== guardrails: respond ===\")\n\n(check! \"respond tool name\" respond-tool-name \"respond\")\n(check-pred! \"respond description non-empty\" respond-description\n (lambda (s) (> (string-length s) 0)))\n\n(let ([rc (make-tool-call \"respond\" \"{\\\"message\\\":\\\"all done\\\"}\")]\n [other (make-tool-call \"ls\" \"{}\")]\n [empty (make-tool-call \"respond\" \"{}\")])\n (check! \"respond-call? yes\" (respond-call? rc) #t)\n (check! \"respond-call? no\" (respond-call? other) #f)\n (check! \"respond-call->text extracts message\" (respond-call->text rc) \"all done\")\n (check! \"respond-call->text missing arg -> empty\" (respond-call->text empty) \"\")\n (check! \"respond-call->text on non-respond -> #f\" (respond-call->text other) #f))\n\n;; ── guardrails: facade ─────────────────────────────────────────────\n(section \"=== guardrails: facade ===\")\n\n;; execute path: valid structured calls\n(let* ([g (make-guardrails '(\"ls\" \"grep\"))]\n [cr (guardrails-check g #f (list (make-tool-call \"ls\" \"{}\")))])\n (check! \"facade execute action\" (check-result-action cr) \"execute\")\n (check! \"facade execute returns calls\"\n (length (check-result-tool-calls cr)) 1))\n\n;; retry path: unknown tool, within budget\n(let* ([g (make-guardrails '(\"ls\") 3 2 #t)]\n [cr (guardrails-check g #f (list (make-tool-call \"nope\" \"{}\")))])\n (check! \"facade retry action\" (check-result-action cr) \"retry\")\n (check-pred! \"facade retry nudge present\" (check-result-nudge cr)\n (lambda (n) (and n #t))))\n\n;; fatal path: budget 1 tolerates one bad response; the second trips it\n(let ([g (make-guardrails '(\"ls\") 1 2 #t)])\n (guardrails-check g \"prose one\" '())\n (let ([cr (guardrails-check g \"prose two\" '())])\n (check! \"facade fatal action\" (check-result-action cr) \"fatal\")\n (check-pred! \"facade fatal reason\" (check-result-reason cr)\n (lambda (s) (str-contains? s \"consecutive\")))))\n\n;; a good response resets the retry budget\n(let ([g (make-guardrails '(\"ls\") 1 2 #t)])\n (guardrails-check g \"prose\" '())\n (guardrails-check g #f (list (make-tool-call \"ls\" \"{}\")))\n (let ([cr (guardrails-check g \"prose again\" '())])\n (check! \"facade budget resets on success\" (check-result-action cr) \"retry\")))\n\n;; record: clean batch returns #f when no terminal tool configured\n(let ([g (make-guardrails '(\"ls\"))])\n (check! \"facade record no terminal\" (guardrails-record g '(\"ls\")) #f))\n\n;; record: terminal tool reached returns #t\n(let ([g (make-guardrails '(\"ls\" \"respond\") 3 2 #t '(\"respond\"))])\n (check! \"facade record terminal reached\" (guardrails-record g '(\"respond\")) #t))\n\n;; ── sampling defaults ──────────────────────────────────────────────\n(section \"=== sampling defaults ===\")\n\n;; jcode hashes are raw Chez equal? hashtables (the get-/apply- functions\n;; return them, and bodies are built the same way the `args` helper does), so\n;; inspect them with the Chez hashtable API.\n\n;; pure lookup: known model returns its card row\n(let ([row (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (check! \"sampling known: temperature\" (hashtable-ref row \"temperature\" #f) 0.6)\n (check! \"sampling known: top_p\" (hashtable-ref row \"top_p\" #f) 0.95)\n (check! \"sampling known: top_k int\" (hashtable-ref row \"top_k\" #f) 20)\n (check! \"sampling known: min_p\" (hashtable-ref row \"min_p\" #f) 0.0))\n\n;; unknown model: empty map, never raises\n(check! \"sampling unknown: empty\"\n (hashtable-size (get-sampling-defaults \"gpt-4o\")) 0)\n\n;; known? predicate\n(check! \"sampling known? yes\" (model-sampling-known? \"Qwen3-8B-Q4_K_M\") #t)\n(check! \"sampling known? no\" (model-sampling-known? \"no-such-model\") #f)\n\n;; lookup returns a fresh copy — mutating it must not corrupt the map\n(let ([r1 (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (hashtable-set! r1 \"temperature\" 99.0)\n (let ([r2 (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (check! \"sampling fresh copy each call\"\n (and (not (eq? r1 r2)) (hashtable-ref r2 \"temperature\" #f)) 0.6)))\n\n;; nested chat_template_kwargs preserved (gpt-oss reasoning_effort)\n(let* ([row (get-sampling-defaults \"gpt-oss:120b-q4_K_M\")]\n [ctk (hashtable-ref row \"chat_template_kwargs\" #f)])\n (check! \"sampling nested top_k zero\" (hashtable-ref row \"top_k\" #f) 0)\n (check-pred! \"sampling nested ctk is hash\" ctk hashtable?)\n (check! \"sampling nested reasoning_effort\"\n (hashtable-ref ctk \"reasoning_effort\" #f) \"medium\"))\n\n;; boolean values survive in nested kwargs (nemotron enable_thinking)\n(let* ([row (get-sampling-defaults \"Nemotron-3-Nano-30B-A3B-Q4_K_M\")]\n [ctk (hashtable-ref row \"chat_template_kwargs\" #f)])\n (check! \"sampling nested boolean #t\" (hashtable-ref ctk \"enable_thinking\" #f) #t))\n\n;; 4-quadrant policy\n(check! \"sampling policy strict+known: temperature\"\n (hashtable-ref (apply-sampling-defaults \"qwen3:8b-q4_K_M\" #t) \"temperature\" #f) 0.6)\n(check! \"sampling policy nonstrict+known: empty\"\n (hashtable-size (apply-sampling-defaults \"qwen3:8b-q4_K_M\" #f)) 0)\n(check! \"sampling policy nonstrict+unknown: empty\"\n (hashtable-size (apply-sampling-defaults \"no-such-model\" #f)) 0)\n(check! \"sampling policy strict+unknown: raises\"\n (guard (e [(unsupported-model-error? e) 'raised] [#t 'other])\n (apply-sampling-defaults \"no-such-model\" #t))\n 'raised)\n(check! \"sampling policy strict+unknown: error carries model\"\n (guard (e [(unsupported-model-error? e) (unsupported-model-error-model e)] [#t #f])\n (apply-sampling-defaults \"no-such-model\" #t))\n \"no-such-model\")\n;; unsupported-model is a member of the forge-error family\n(check! \"sampling unsupported-model is a forge-error\"\n (guard (e [(forge-error? e) #t] [#t #f])\n (apply-sampling-defaults \"no-such-model\" #t))\n #t)\n\n;; body application under the session policy\n;; 'on + known: splat the card profile onto the body\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"qwen3:8b-q4_K_M\" \"mlx\"))\n (check! \"body on+known: temperature\" (hashtable-ref body \"temperature\" #f) 0.6)\n (check! \"body on+known: top_k\" (hashtable-ref body \"top_k\" #f) 20))\n\n;; 'on + unknown mlx model: mlx safety net (0.6 / 0.95 / top_k 20 / rep 1.1).\n;; Raised from the old near-greedy 0.3/1.05 net in 566e65c — see the comment on\n;; apply-sampling-to-body! for why (Qwen3 endless-repetition under greedy decode).\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"jerboa-mlx-lora\" \"mlx\"))\n (check! \"body on+unknown mlx: temp net\" (hashtable-ref body \"temperature\" #f) 0.6)\n (check! \"body on+unknown mlx: rep net\"\n (hashtable-ref body \"repetition_penalty\" #f) 1.1))\n\n;; 'on + unknown cloud model: nothing applied (no mlx net)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"gpt-4o\" \"openai\"))\n (check! \"body on+unknown cloud: untouched\" (hashtable-size body) 0))\n\n;; 'off: forge card sampling not applied even for a known model (cloud\n;; provider, so the mlx safety net cannot confound the assertion)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'off])\n (apply-sampling-to-body! body \"qwen3:8b-q4_K_M\" \"openai\"))\n (check! \"body off+known: untouched\" (hashtable-size body) 0))\n\n;; the mlx LoRA safety net is policy-independent: it still fires under 'off\n;; for an mlx provider with no card row (degenerate-output guard)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'off])\n (apply-sampling-to-body! body \"jerboa-mlx-lora\" \"mlx\"))\n (check! \"body off+mlx: net still fires\" (hashtable-ref body \"temperature\" #f) 0.6))\n\n;; ── compaction strategies (Phase 4) ────────────────────────────────\n(section \"=== compaction strategies ===\")\n\n(check! \"effective budget small reserves overhead\" (effective-compaction-budget 3072) 572)\n(check! \"effective budget large unchanged\" (effective-compaction-budget 128000) 128000)\n(check! \"small compaction stays off for fresh prompt\"\n (should-compact?\n (list (make-system-message (make-string 1600 #\\s))\n (make-user-message \"find bugs\"))\n \"/Users/user/models/qwen3-coder-next-mlx\")\n #f)\n(check! \"small compaction triggers after one bulky tool result\"\n (should-compact?\n (list (make-system-message (make-string 1600 #\\s))\n (make-user-message \"find bugs\")\n (make-assistant-message \"\" (list (make-tool-call \"read\" \"{}\")))\n (make-tool-result \"read-1\" (make-string 768 #\\r)))\n \"/Users/user/models/qwen3-coder-next-mlx\")\n #t)\n\n(define (asst-tc content)\n (make-assistant-message content (list (make-tool-call \"read\" \"{}\"))))\n\n;; Type derivation from message shape\n(check! \"type: system\" (message-derived-type (make-system-message \"s\")) message-type-system-prompt)\n(check! \"type: user\" (message-derived-type (make-user-message \"q\")) message-type-user-input)\n(check! \"type: tool\" (message-derived-type (make-tool-result \"id\" \"r\")) message-type-tool-result)\n(check! \"type: tool_call\" (message-derived-type (asst-tc \"\")) message-type-tool-call)\n(check! \"type: text_response\" (message-derived-type (make-assistant-message \"hi\")) message-type-text-response)\n(let ([m (make-assistant-message \"\")])\n (message-thinking-set! m \"pondering\")\n (check! \"type: reasoning (thinking+empty content)\" (message-derived-type m) message-type-reasoning))\n\n;; estimate = message content plus tool-call bytes, divided by 4\n(check! \"estimate-tokens content/4\"\n (strategy-estimate-tokens (list (make-user-message (make-string 400 #\\x)))) 100)\n\n;; A 7-message history: sys,user,(tc,result)x2,final\n(define hist1\n (list (make-system-message \"sys\") (make-user-message \"q\")\n (asst-tc \"a1\") (make-tool-result \"id1\" \"r1\")\n (asst-tc \"a2\") (make-tool-result \"id2\" \"r2\")\n (make-assistant-message \"final\")))\n(check! \"step indices\" (derive-step-indices hist1) (list #f #f 1 1 2 2 3))\n(check! \"eligible-end keep=3 (nothing eligible)\" (find-eligible-end hist1 3) 2)\n(check! \"eligible-end keep=2\" (find-eligible-end hist1 2) 4)\n(check! \"eligible-end keep=1\" (find-eligible-end hist1 1) 6)\n\n;; NoCompact: always passthrough, phase 0\n(let* ([s (make-no-compact)] [r (s hist1 1000)])\n (check! \"no-compact phase 0\" (cdr r) 0)\n (check! \"no-compact length unchanged\" (length (car r)) 7))\n\n;; A big history for sliding/tiered: 11 msgs, 5 token-bearing (1000 chars each)\n;; indices: 0 sys 1 user | 2 tc 3 tool(1000) 4 text(1000) 5 tc 6 tool(1000)\n;; 7 text(1000) 8 tc 9 tool(1000) 10 final(\"final\")\n(define hist-tier\n (list (make-system-message \"\") (make-user-message \"\")\n (asst-tc \"\") (make-tool-result \"t1\" (make-string 1000 #\\T))\n (make-assistant-message (make-string 1000 #\\X))\n (asst-tc \"\") (make-tool-result \"t2\" (make-string 1000 #\\T))\n (make-assistant-message (make-string 1000 #\\X))\n (asst-tc \"\") (make-tool-result \"t3\" (make-string 1000 #\\T))\n (make-assistant-message \"final\")))\n(check! \"tier step indices\" (derive-step-indices hist-tier) (list #f #f 1 1 2 3 3 4 5 5 6))\n(check! \"tier eligible-end keep=1\" (find-eligible-end hist-tier 1) 10)\n;; original estimate includes three tool-call overheads: (5005 + 90)//4 = 1273\n(check! \"tier original estimate\" (strategy-estimate-tokens hist-tier) 1273)\n\n;; SlidingWindow keep=1: below threshold → phase 0; above → keep head+protected tail\n(let* ([s (make-sliding-window 1 0.75)] [r (s hist-tier 10000)])\n (check! \"sliding below threshold phase 0\" (cdr r) 0))\n(let* ([s (make-sliding-window 1 0.75)] [r (s hist-tier 400)])\n (check! \"sliding fires phase 1\" (cdr r) 1)\n (check! \"sliding keeps sys+user+protected\" (length (car r)) 3)\n (check! \"sliding head is system\" (message-role (car (car r))) \"system\"))\n(let ([r (run-configured-compaction hist-tier 572)])\n (check! \"configured small budget uses sliding\" (length r) 5))\n\n;; Tiered phase transitions (keep=1, uniform 0.75 threshold).\n;; budgets: 4000→t3000 (p0), 1200→t900 (p1), 800→t600 (p2), 600→t450 (p3)\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 4000)])\n (check! \"tiered below all thresholds phase 0\" (cdr r) 0)\n (check! \"tiered phase 0 length unchanged\" (length (car r)) 11))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 1200)])\n (check! \"tiered phase 1\" (cdr r) 1)\n (check! \"tiered phase 1 keeps all msgs (truncate only)\" (length (car r)) 11)\n (check-pred! \"tiered phase 1 truncated a tool result\"\n (message-content (list-ref (car r) 3)) (lambda (c) (str-contains? c \"[Truncated\"))))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 800)])\n (check! \"tiered phase 2\" (cdr r) 2)\n (check! \"tiered phase 2 drops 3 tool results\" (length (car r)) 8))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 600)])\n (check! \"tiered phase 3\" (cdr r) 3)\n (check! \"tiered phase 3 keeps only skeleton\" (length (car r)) 6)\n (check! \"tiered phase 3 preserves system\" (message-role (car (car r))) \"system\")\n (check! \"tiered phase 3 preserves protected tail\"\n (message-content (list-ref (car r) 5)) \"final\"))\n\n;; JcodeLegacy: still a valid strategy (wraps compact-messages)\n(let* ([s (make-jcode-legacy)] [r (s hist1 1000)])\n (check-pred! \"legacy returns a list\" (car r) list?)\n (check! \"legacy phase 1\" (cdr r) 1))\n\n;; Dispatcher default is tiered\n(check! \"default strategy name\" (configured-compaction-strategy-name) \"tiered\")\n(check-pred! \"by-name tiered is callable\" (compaction-strategy-by-name \"tiered\" 2 0.75) procedure?)\n(check-pred! \"by-name none is callable\" (compaction-strategy-by-name \"none\" 2 0.75) procedure?)\n\n;; ── hardware / VRAM tiers (Phase 4) ─────────────────────────────────\n(section \"=== hardware VRAM tiers ===\")\n\n(check! \"tier #f → 4096\" (vram-tier-budget-for-gb #f) 4096)\n(check! \"tier 12 → 4096\" (vram-tier-budget-for-gb 12.0) 4096)\n(check! \"tier 23.9 → 4096\" (vram-tier-budget-for-gb 23.9) 4096)\n(check! \"tier 24 → 32768\" (vram-tier-budget-for-gb 24.0) 32768)\n(check! \"tier 30 → 32768\" (vram-tier-budget-for-gb 30.0) 32768)\n(check! \"tier 48 → 262144\" (vram-tier-budget-for-gb 48.0) 262144)\n(check! \"tier 80 → 262144\" (vram-tier-budget-for-gb 80.0) 262144)\n\n(let ([p (make-hardware-profile \"Test GPU\" 24576 \"nvidia\" \"discrete\")])\n (check! \"profile vram gb\" (hardware-profile-vram-total-gb p) 24.0)\n (check! \"profile gpu name\" (hardware-profile-gpu-name p) \"Test GPU\")\n (check! \"profile → 32768 tier\"\n (vram-tier-budget-for-gb (hardware-profile-vram-total-gb p)) 32768))\n\n(check! \"quant bpw Q4_K_M\" (quant-bpw-ref \"Q4_K_M\") 4.83)\n(check! \"quant bpw F16\" (quant-bpw-ref \"F16\") 16.0)\n(check! \"quant bpw unknown → #f\" (quant-bpw-ref \"nope\") #f)\n\n;; Live probe: must not crash; returns #f or a profile, budget an int ≥ 4096.\n(parameterize ([current-log-level 'error])\n (check-pred! \"detect-hardware: #f or profile\"\n (detect-hardware) (lambda (x) (or (not x) (hardware-profile? x))))\n (check-pred! \"vram-tier-budget: int ≥ 4096\"\n (vram-tier-budget) (lambda (x) (and (integer? x) (>= x 4096)))))\n\n;; ── Workflow / steps / step-enforcer / runner (Phase 5) ───────────\n\n(define (raises? thunk) (guard (e [#t #t]) (thunk) #f))\n(define (raises-pred? thunk pred) (guard (e [(pred e) #t] [#t #f]) (thunk) #f))\n\n(define (scripted-responder responses)\n (let ([i 0] [v (list->vector responses)])\n (lambda (messages tool-specs step)\n (let ([r (if (< i (vector-length v)) (vector-ref v i)\n (make-text-response \"exhausted\"))])\n (set! i (+ i 1)) r))))\n\n;; search (required) → answer (terminal, prereq search). lookup is optional.\n(define (mk-research-wf)\n (make-workflow \"research\" \"Search then answer.\"\n (list\n (make-tool-def (make-tool-spec \"search\" \"s\" '((\"type\" . \"object\"))) (lambda (a) \"search results\") '())\n (make-tool-def (make-tool-spec \"lookup\" \"l\" '((\"type\" . \"object\"))) (lambda (a) \"looked\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\"))) (lambda (a) \"ANSWER delivered\") '(\"search\")))\n '(\"search\") \"answer\" \"You are an agent. {extra}\"))\n\n;; write requires read; finish terminal; no required steps.\n(define (mk-prereq-wf)\n (make-workflow \"prq\" \"Read then write.\"\n (list\n (make-tool-def (make-tool-spec \"read\" \"r\" '((\"type\" . \"object\"))) (lambda (a) \"read-ok\") '())\n (make-tool-def (make-tool-spec \"write\" \"w\" '((\"type\" . \"object\"))) (lambda (a) \"wrote\") '(\"read\"))\n (make-tool-def (make-tool-spec \"finish\" \"f\" '((\"type\" . \"object\"))) (lambda (a) \"FINISHED\") '()))\n '() \"finish\" \"p\"))\n\n(section \"=== workflow construction ===\")\n(let ([w (mk-research-wf)])\n (check! \"tool names\" (workflow-tool-names w) '(\"search\" \"lookup\" \"answer\"))\n (check! \"required steps\" (workflow-required-steps w) '(\"search\"))\n (check! \"terminal tools\" (workflow-terminal-tools w) '(\"answer\"))\n (check! \"terminal? answer\" (workflow-terminal-tool? w \"answer\") #t)\n (check! \"terminal? search\" (workflow-terminal-tool? w \"search\") #f)\n (check! \"get-tool-def name\" (tool-def-name (workflow-get-tool-def w \"answer\")) \"answer\")\n (check! \"get-callable runs\" ((workflow-get-callable w \"search\") '()) \"search results\")\n (check! \"tool-specs count\" (length (workflow-get-tool-specs w)) 3)\n (check! \"tool-prerequisites\" (workflow-tool-prerequisites w) '((\"answer\" . (\"search\"))))\n (check-pred! \"build-system-prompt subst\"\n (workflow-build-system-prompt w '((\"extra\" . \"Be terse.\")))\n (lambda (s) (str-contains? s \"Be terse.\")))\n (check! \"prereq-name string\" (prerequisite-name \"search\") \"search\")\n (check! \"prereq-name pair\" (prerequisite-name (cons \"open\" \"file\")) \"open\"))\n\n(let ([sp (tool-spec-from-json-schema \"n\" \"d\" '((\"type\" . \"object\")))])\n (check! \"tool-spec name\" (tool-spec-name sp) \"n\")\n (check! \"tool-spec schema round-trip\" (tool-spec-get-json-schema sp) '((\"type\" . \"object\"))))\n\n(section \"=== workflow validation ===\")\n(define (mk-bad tools req term) (lambda () (make-workflow \"x\" \"d\" tools req term \"p\")))\n(check! \"dup tool name raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '())\n (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '() \"a\")) #t)\n(check! \"required ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '(\"nope\") \"a\")) #t)\n(check! \"terminal ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '() \"zzz\")) #t)\n(check! \"terminal also required raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '(\"a\") \"a\")) #t)\n(check! \"prereq ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '(\"ghost\")))\n '() \"a\")) #t)\n\n(section \"=== step tracker ===\")\n(let ([t (make-step-tracker '(\"a\" \"b\"))])\n (check! \"fresh not satisfied\" (step-tracker-satisfied? t) #f)\n (check! \"fresh pending\" (step-tracker-pending t) '(\"a\" \"b\"))\n (check! \"fresh hint\" (step-tracker-summary-hint t) \"[No steps completed yet]\")\n (step-tracker-record! t \"a\" '())\n (check! \"after a not satisfied\" (step-tracker-satisfied? t) #f)\n (check! \"after a pending\" (step-tracker-pending t) '(\"b\"))\n (step-tracker-record! t \"b\" '())\n (check! \"after b satisfied\" (step-tracker-satisfied? t) #t)\n (check! \"after b pending\" (step-tracker-pending t) '())\n (step-tracker-record! t \"a\" '())\n (check! \"record dedups completed\" (step-tracker-completed t) '(\"a\" \"b\"))\n (check! \"hint lists completed\" (step-tracker-summary-hint t) \"[Steps completed: a, b]\"))\n\n;; name-only prereq\n(let ([t (make-step-tracker '())])\n (step-tracker-record! t \"x\" '())\n (check! \"name-only satisfied\"\n (prerequisite-check-satisfied (step-tracker-check-prerequisites t \"y\" '() '(\"x\"))) #t)\n (check! \"name-only missing\"\n (prerequisite-check-missing (step-tracker-check-prerequisites t \"y\" '() '(\"z\"))) '(\"z\")))\n\n;; arg-matched prereq\n(let ([t (make-step-tracker '())])\n (step-tracker-record! t \"open\" '((\"file\" . \"a.txt\")))\n (check! \"arg-match satisfied\"\n (prerequisite-check-satisfied\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"a.txt\")) (list (cons \"open\" \"file\")))) #t)\n (check! \"arg-match mismatch missing\"\n (prerequisite-check-missing\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"b.txt\")) (list (cons \"open\" \"file\")))) '(\"open\"))\n (check! \"arg-match tool-never-called missing\"\n (prerequisite-check-missing\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"a.txt\")) (list (cons \"save\" \"file\")))) '(\"save\")))\n\n(section \"=== step enforcer ===\")\n(let ([e (make-step-enforcer '(\"search\") '(\"answer\") '((\"answer\" . (\"search\"))))])\n (check! \"non-terminal batch ok\"\n (step-check-needs-nudge (step-enforcer-check e (list (make-wtool-call \"search\" '() #f)))) #f)\n (let ([sc (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))])\n (check! \"premature terminal nudged\" (step-check-needs-nudge sc) #t)\n (check! \"premature nudge kind\" (nudge-kind (step-check-nudge sc)) \"step\")\n (check! \"premature tier 1\" (nudge-tier (step-check-nudge sc)) 1))\n (check! \"premature attempts=1\" (step-enforcer-premature-attempts e) 1)\n (check! \"not exhausted at 1\" (step-enforcer-premature-exhausted? e) #f)\n (step-enforcer-record! e \"search\" '())\n (check! \"satisfied after search\" (step-enforcer-satisfied? e) #t)\n (check! \"terminal not nudged once satisfied\"\n (step-check-needs-nudge (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))) #f)\n (check! \"terminal-reached? true\"\n (step-enforcer-terminal-reached? e (list (make-wtool-call \"answer\" '() #f))) #t)\n (step-enforcer-reset-premature! e)\n (check! \"reset zeroes premature\" (step-enforcer-premature-attempts e) 0))\n\n;; premature exhaustion: max-premature default 3, exhausted at attempt 4 (>3)\n(let ([e (make-step-enforcer '(\"search\") '(\"answer\") '())])\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (check! \"3 premature not exhausted\" (step-enforcer-premature-exhausted? e) #f)\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (check! \"4 premature exhausted\" (step-enforcer-premature-exhausted? e) #t))\n\n;; prerequisites via enforcer\n(let ([e (make-step-enforcer '() '(\"finish\") '((\"write\" . (\"read\"))))])\n (let ([sc (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))])\n (check! \"prereq violation nudged\" (step-check-needs-nudge sc) #t)\n (check! \"prereq nudge kind\" (nudge-kind (step-check-nudge sc)) \"prerequisite\"))\n (check! \"prereq violations=1\" (step-enforcer-prereq-violations e) 1)\n (step-enforcer-record! e \"read\" '())\n (check! \"prereq ok after read\"\n (step-check-needs-nudge (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))) #f))\n\n(let ([e (make-step-enforcer '() '(\"finish\") '((\"write\" . (\"read\"))))])\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (check! \"2 prereq violations not exhausted\" (step-enforcer-prereq-exhausted? e) #f)\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (check! \"3 prereq violations exhausted\" (step-enforcer-prereq-exhausted? e) #t))\n\n(section \"=== workflow runner ===\")\n;; happy path: search then answer → terminal value\n(let* ([w (mk-research-wf)]\n [msgs '()]\n [resp (scripted-responder\n (list (list (make-wtool-call \"search\" '((\"q\" . \"j\")) \"search first\"))\n (list (make-wtool-call \"answer\" '((\"text\" . \"done\")) \"now answer\"))))]\n [result (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6)\n (cons 'on-message (lambda (m) (set! msgs (cons m msgs))))))])\n (check! \"happy terminal value\" result \"ANSWER delivered\")\n (let ([ordered (reverse msgs)])\n (check! \"first msg system\" (message-role (car ordered)) \"system\")\n (check! \"second msg user\" (message-role (cadr ordered)) \"user\")\n (check-pred! \"emitted ≥ 6 messages\" (length ordered) (lambda (n) (>= n 6)))))\n\n;; text response consumes an iteration, then tools proceed\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (list (make-text-response \"thinking out loud\")\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"text-then-tools reaches terminal\" result \"ANSWER delivered\"))\n\n;; premature terminal recovered (not exhausted): answer, then search, then answer\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"answer\" '() #f))\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"premature recovered → terminal\" result \"ANSWER delivered\"))\n\n;; StepEnforcementError when premature exhausted\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (make-list 6 (list (make-wtool-call \"answer\" '() #f))))])\n (check! \"premature exhausted raises StepEnforcementError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n step-enforcement-error?) #t))\n\n;; prereq happy: read, write, finish\n(let* ([w (mk-prereq-wf)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"read\" '() #f))\n (list (make-wtool-call \"write\" '() #f))\n (list (make-wtool-call \"finish\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"prereq happy → FINISHED\" result \"FINISHED\"))\n\n;; PrerequisiteError when prereq violations exhausted (write without read)\n(let* ([w (mk-prereq-wf)]\n [resp (scripted-responder (make-list 5 (list (make-wtool-call \"write\" '() #f))))])\n (check! \"prereq exhausted raises PrerequisiteError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n prerequisite-error?) #t))\n\n;; MaxIterationsError: all text, never a tool\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder (make-list 5 (make-text-response \"no tools here\")))])\n (check! \"max iterations raises MaxIterationsError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 3))))\n max-iterations-error?) #t))\n\n;; ToolExecutionError: a tool that always raises, error budget exhausted\n(let* ([w (make-workflow \"err\" \"d\"\n (list (make-tool-def (make-tool-spec \"boom\" \"b\" '()) (lambda (a) (error 'boom \"kaboom\")) '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '()) (lambda (a) \"OK\") '()))\n '() \"answer\" \"p\")]\n [resp (scripted-responder (make-list 5 (list (make-wtool-call \"boom\" '() #f))))])\n (check! \"tool errors exhausted raises ToolExecutionError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n tool-execution-error?) #t))\n\n;; ToolResolutionError is privileged: no error-budget hit, model retries to success\n(let* ([calls 0]\n [w (make-workflow \"res\" \"d\"\n (list (make-tool-def (make-tool-spec \"answer\" \"a\" '())\n (lambda (a) (set! calls (+ calls 1))\n (if (= calls 1) (raise-tool-resolution-error \"no data\" \"answer\") \"RESOLVED-OK\"))\n '()))\n '() \"answer\" \"p\")]\n [resp (scripted-responder\n (list (list (make-wtool-call \"answer\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)\n (cons 'max-tool-errors 1)))])\n (check! \"resolution-error privileged → eventual success\" result \"RESOLVED-OK\")\n (check! \"resolution retried exactly twice\" calls 2))\n\n;; Unknown workflow tools are surfaced as privileged ToolResolutionError\n;; results so local models can recover instead of crashing the runner.\n(let* ([w (mk-research-wf)]\n [tool-results '()]\n [resp (scripted-responder\n (list (list (make-wtool-call \"run\" '((\"command\" . \"ls\")) #f))\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6)\n (cons 'max-tool-errors 0)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results)))))))])\n (check! \"unknown workflow tool recovers → terminal\" result \"ANSWER delivered\")\n (check-pred! \"unknown workflow tool emits resolution result\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"[ToolResolutionError] Unknown tool 'run'\")))))\n\n;; cancellation\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder (list (list (make-wtool-call \"search\" '() #f))))])\n (check! \"cancel? thunk raises WorkflowCancelledError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'cancel? (lambda () #t)))))\n workflow-cancelled-error?) #t))\n\n;; ════════════════════════════════════════════════════════════════\n;; Phase 6 — OpenAI-compatible proxy (convert / handler / slot-worker /\n;; dispatch). Bodies are built from JSON-string literals via\n;; string->json-object so the representation matches a real request.\n;; ════════════════════════════════════════════════════════════════\n\n(define (p6-choice0 c) (car (hashtable-ref c \"choices\" '())))\n(define (p6-finish c) (hashtable-ref (p6-choice0 c) \"finish_reason\" #f))\n(define (p6-msg c) (hashtable-ref (p6-choice0 c) \"message\" #f))\n(define (p6-content c) (hashtable-ref (p6-msg c) \"content\" #f))\n(define (p6-tcs c) (hashtable-ref (p6-msg c) \"tool_calls\" #f))\n(define (p6-last xs) (list-ref xs (- (length xs) 1)))\n(define (p6-chunk-finish ch)\n (hashtable-ref (car (hashtable-ref ch \"choices\" '())) \"finish_reason\" #f))\n(define (p6-specs-have? specs name)\n (let loop ([s specs])\n (cond [(null? s) #f]\n [(equal? (tool-spec-name (car s)) name) #t]\n [else (loop (cdr s))])))\n\n(section \"=== proxy convert: openai->messages ===\")\n(let* ([omsgs (string->json-object \"[{\\\"role\\\":\\\"system\\\",\\\"content\\\":\\\"sys\\\"},{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"},{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"reasoning\\\",\\\"tool_calls\\\":[{\\\"id\\\":\\\"call_1\\\",\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"arguments\\\":\\\"{\\\\\\\"q\\\\\\\":\\\\\\\"x\\\\\\\"}\\\"}}]},{\\\"role\\\":\\\"tool\\\",\\\"tool_call_id\\\":\\\"call_1\\\",\\\"content\\\":\\\"result\\\"}]\")]\n [cmsgs (openai->messages omsgs)])\n (check! \"msgs count\" (length cmsgs) 4)\n (check! \"msg0 system\" (message-role (car cmsgs)) \"system\")\n (check! \"msg0 content\" (message-content (car cmsgs)) \"sys\")\n (check! \"msg1 user\" (message-role (cadr cmsgs)) \"user\")\n (check! \"msg2 assistant\" (message-role (caddr cmsgs)) \"assistant\")\n (let ([tcs (message-tool-calls (caddr cmsgs))])\n (check-pred! \"assistant 1 tool call\" tcs (lambda (x) (and (pair? x) (= (length x) 1))))\n (check! \"tool call name\" (tool-call-name (car tcs)) \"search\")\n (check! \"tool call args preserved\" (tool-call-arguments (car tcs)) \"{\\\"q\\\":\\\"x\\\"}\"))\n (check! \"msg3 tool role\" (message-role (cadddr cmsgs)) \"tool\")\n (check! \"msg3 tool_call_id\" (message-tool-call-id (cadddr cmsgs)) \"call_1\"))\n\n;; content as a block list flattens to a newline-joined string\n(let ([blk (openai->messages (string->json-object \"[{\\\"role\\\":\\\"user\\\",\\\"content\\\":[{\\\"type\\\":\\\"text\\\",\\\"text\\\":\\\"a\\\"},{\\\"type\\\":\\\"text\\\",\\\"text\\\":\\\"b\\\"}]}]\"))])\n (check! \"block content flattened\" (message-content (car blk)) \"a\\nb\"))\n\n(section \"=== proxy convert: outbound ===\")\n(let ([tco (tool-calls->openai\n (list (make-wtool-call \"search\" '((\"q\" . \"jb\")) \"reasoning text\")\n (make-wtool-call \"answer\" '((\"a\" . \"1\")) #f)) \"m1\")])\n (check! \"tco finish\" (p6-finish tco) \"tool_calls\")\n (check! \"tco content = first reasoning\" (p6-content tco) \"reasoning text\")\n (let ([entries (p6-tcs tco)])\n (check! \"tco 2 entries\" (length entries) 2)\n (let ([fn (hashtable-ref (car entries) \"function\" #f)])\n (check! \"tco entry name\" (hashtable-ref fn \"name\" #f) \"search\")\n (check! \"tco entry args roundtrip\"\n (hashtable-ref (string->json-object (hashtable-ref fn \"arguments\" #f)) \"q\" #f) \"jb\"))))\n(let ([tro (text-response->openai \"the answer\" \"m1\")])\n (check! \"tro finish stop\" (p6-finish tro) \"stop\")\n (check! \"tro content\" (p6-content tro) \"the answer\"))\n(let ([sse (text->sse-events \"hello\" \"m1\")])\n (check-pred! \"text sse is a list\" sse list?)\n (check! \"text sse last finish stop\" (p6-chunk-finish (p6-last sse)) \"stop\"))\n(let ([sse (tool-calls->sse-events (list (make-wtool-call \"search\" '((\"q\" . \"x\")) \"r\")) \"m1\")])\n (check! \"tool sse last finish tool_calls\" (p6-chunk-finish (p6-last sse)) \"tool_calls\"))\n\n(section \"=== proxy handler: extraction ===\")\n(check! \"extract-sampling present\"\n (hashtable-ref (extract-sampling (string->json-object \"{\\\"temperature\\\":0.6,\\\"top_p\\\":0.9}\")) \"temperature\" #f) 0.6)\n(check! \"extract-sampling absent → #f\"\n (extract-sampling (string->json-object \"{\\\"messages\\\":[]}\")) #f)\n(let ([especs (extract-tool-specs (string->json-object \"[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{\\\"type\\\":\\\"object\\\"}}}]\"))])\n (check! \"extract-tool-specs count\" (length especs) 1)\n (check! \"extract-tool-specs name\" (tool-spec-name (car especs)) \"search\"))\n\n(section \"=== proxy handler: completion paths ===\")\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}]}\")\n (lambda (msgs specs samp) (make-text-response \"plain answer\")))])\n (check! \"no-tools finish stop\" (p6-finish h) \"stop\")\n (check! \"no-tools content\" (p6-content h) \"plain answer\"))\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{\\\"type\\\":\\\"object\\\"}}}]}\")\n (lambda (msgs specs samp) (list (make-wtool-call \"search\" '((\"q\" . \"x\")) \"thinking\"))))])\n (check! \"tools finish tool_calls\" (p6-finish h) \"tool_calls\")\n (check! \"tools entry name\"\n (hashtable-ref (hashtable-ref (car (p6-tcs h)) \"function\" #f) \"name\" #f) \"search\"))\n;; respond is injected into the offered specs (and the original tool retained)\n(let ([seen #f])\n (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (set! seen specs) (make-text-response \"x\")))\n (check! \"respond injected into specs\" (p6-specs-have? seen \"respond\") #t)\n (check! \"original tool retained\" (p6-specs-have? seen \"search\") #t))\n;; a pure respond() call is stripped and returned as a normal text answer\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (list (make-wtool-call \"respond\" '((\"message\" . \"final words\")) #f))))])\n (check! \"respond-only finish stop\" (p6-finish h) \"stop\")\n (check! \"respond-only content = message\" (p6-content h) \"final words\"))\n;; retries exhausted (&tool-call-error) → return last raw text for the client\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (raise-tool-call-error \"exhausted\" \"raw text fallback\")))])\n (check! \"tool-call-error finish stop\" (p6-finish h) \"stop\")\n (check! \"tool-call-error returns raw\" (p6-content h) \"raw text fallback\"))\n;; stream:true → handler returns a list of chunk objects\n(check-pred! \"stream handler returns chunk list\"\n (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}],\\\"stream\\\":true}\")\n (lambda (msgs specs samp) (make-text-response \"streamed\")))\n list?)\n\n(section \"=== slot-worker: scheduling policy ===\")\n(check! \"priority lower int first\" (slot-priority<? 0 5 1 0) #t)\n(check! \"priority equal → lower seq\" (slot-priority<? 0 1 0 2) #t)\n(check! \"priority equal → higher seq not first\" (slot-priority<? 0 2 0 1) #f)\n(check! \"priority higher int not first\" (slot-priority<? 1 0 0 5) #f)\n(check! \"preempt: strictly higher\" (slot-should-preempt? 5 1) #t)\n(check! \"no preempt: lower\" (slot-should-preempt? 1 5) #f)\n(check! \"no preempt: equal\" (slot-should-preempt? 3 3) #f)\n(check! \"no preempt: idle slot\" (slot-should-preempt? #f 1) #f)\n(let ([w (make-slot-worker (scripted-responder '()))])\n (check! \"fresh worker is slot-worker?\" (slot-worker? w) #t)\n (check! \"fresh worker pending 0\" (slot-worker-pending w) 0)\n (check! \"fresh worker no running priority\" (slot-worker-running-priority w) #f))\n;; end-to-end: start, submit a one-step workflow, get its terminal value\n(let* ([wf (make-workflow \"r\" \"d\"\n (list (make-tool-def (make-tool-spec \"done\" \"d\" '()) (lambda (a) \"DONE-VAL\") '()))\n '() \"done\" \"p\")]\n [w (make-slot-worker (scripted-responder (list (list (make-wtool-call \"done\" '() #f)))))])\n (slot-worker-start! w)\n (let ([result (slot-submit! w wf \"go\" (list (cons 'max-iterations 4)))])\n (slot-worker-stop! w)\n (check! \"slot-submit! returns terminal value\" result \"DONE-VAL\")))\n\n(section \"=== proxy dispatch: routing ===\")\n(define p6-backend (lambda (msgs specs samp) (make-text-response \"pong\")))\n(let ([r (proxy-dispatch \"GET\" \"/health\" \"\" p6-backend)])\n (check! \"health status 200\" (presp-status r) 200)\n (check-pred! \"health body has ok\" (presp-body r) (lambda (b) (str-contains? b \"ok\"))))\n(let ([r (proxy-dispatch \"GET\" \"/v1/models\" \"\" p6-backend)])\n (check! \"models status 200\" (presp-status r) 200)\n (check-pred! \"models body has forge\" (presp-body r) (lambda (b) (str-contains? b \"forge\"))))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\"\n \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}]}\" p6-backend)])\n (check! \"chat status 200\" (presp-status r) 200)\n (check! \"chat content-type json\" (presp-content-type r) \"application/json\")\n (check! \"chat finish stop\" (p6-finish (string->json-object (presp-body r))) \"stop\"))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\"\n \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}],\\\"stream\\\":true}\" p6-backend)])\n (check! \"stream content-type sse\" (presp-content-type r) \"text/event-stream\")\n (check-pred! \"stream body has [DONE]\" (presp-body r) (lambda (b) (str-contains? b \"data: [DONE]\"))))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\" \"not json at all\" p6-backend)])\n (check! \"bad json → 400\" (presp-status r) 400))\n(let ([r (proxy-dispatch \"GET\" \"/nope\" \"\" p6-backend)])\n (check! \"unknown route → 404\" (presp-status r) 404))\n(let ([r (proxy-dispatch \"POST\" \"/health\" \"\" p6-backend)])\n (check! \"wrong method → 405\" (presp-status r) 405))\n\n(section \"=== eval: scenario + check-substrings ===\")\n(check! \"check-substrings all present\" (check-substrings \"The Quick Brown Fox\" '(\"quick\" \"fox\")) #t)\n(check! \"check-substrings missing\" (check-substrings \"hello world\" '(\"hello\" \"moon\")) #f)\n(check! \"check-substrings empty required\" (check-substrings \"anything\" '()) #t)\n(check! \"check-substrings comma-stripped\" (check-substrings \"total: 1,000 units\" '(\"1000\")) #t)\n(check! \"check-substrings case-insensitive\" (check-substrings \"RESULT\" '(\"result\")) #t)\n(let ([s (make-eval-scenario \"n\" \"d\" (lambda () #f) \"um\" (lambda () #f) #f)])\n (check! \"scenario name\" (eval-scenario-name s) \"n\")\n (check! \"scenario default max-iterations 15\" (eval-scenario-max-iterations s) 15)\n (check! \"scenario default max-retries 5\" (eval-scenario-max-retries-per-step s) 5)\n (check! \"scenario default max-tool-errors 2\" (eval-scenario-max-tool-errors s) 2)\n (check! \"scenario default tags\" (eval-scenario-tags s) '()))\n(let ([s (make-eval-scenario \"n\" \"d\" (lambda () #f) \"um\" (lambda () #f) #f\n (list (cons 'max-iterations 3) (cons 'tags '(\"a\"))))])\n (check! \"scenario opt max-iterations\" (eval-scenario-max-iterations s) 3)\n (check! \"scenario opt tags\" (eval-scenario-tags s) '(\"a\")))\n(let ([r (make-run-result \"n\" #t #t 4 '((\"k\" . \"v\")) #f #f '())])\n (check! \"run-result accuracy\" (run-result-accuracy r) #t)\n (check! \"run-result iters\" (run-result-iterations-used r) 4))\n\n(section \"=== eval: ablation presets ===\")\n(check! \"preset count\" (length *ablation-preset-order*) 7)\n(let ([r (ablation-preset-ref \"reforged\")])\n (check! \"reforged step-enf on\" (ablation-config-step-enforcement-enabled r) #t)\n (check! \"reforged rescue on\" (ablation-config-rescue-enabled r) #t)\n (check! \"reforged max-retries 5\" (ablation-config-max-retries-per-step r) 5)\n (check! \"reforged max-tool-errors 2\" (ablation-config-max-tool-errors r) 2))\n(check! \"no_steps step-enf off\"\n (ablation-config-step-enforcement-enabled (ablation-preset-ref \"no_steps\")) #f)\n(check! \"no_recovery max-tool-errors 0\"\n (ablation-config-max-tool-errors (ablation-preset-ref \"no_recovery\")) 0)\n(check! \"no_nudge max-retries 0\"\n (ablation-config-max-retries-per-step (ablation-preset-ref \"no_nudge\")) 0)\n(let ([b (ablation-preset-ref \"bare\")])\n (check! \"bare rescue off\" (ablation-config-rescue-enabled b) #f)\n (check! \"bare step-enf off\" (ablation-config-step-enforcement-enabled b) #f)\n (check! \"bare compaction off\" (ablation-config-compaction-enabled b) #f))\n(check! \"preset-ref unknown → #f\" (ablation-preset-ref \"nope\") #f)\n(check! \"make-ablation-config default compaction\"\n (ablation-config-compaction-enabled (make-ablation-config \"x\")) #t)\n\n(section \"=== eval: instrument-workflow ===\")\n(let* ([cap (vector 'none)]\n [wf (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"fin\" \"f\" '()) (lambda (a) \"done\") '()))\n '() \"fin\" \"p\")]\n [inst (instrument-workflow wf #t cap)])\n ((workflow-get-callable inst \"fin\") '((\"k\" . \"v\")))\n (check! \"instrument captures terminal args\" (cdr (assoc \"k\" (vector-ref cap 0))) \"v\"))\n(let ([wf (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"s\" \"s\" '()) (lambda (a) \"r\") '())\n (make-tool-def (make-tool-spec \"fin\" \"f\" '()) (lambda (a) \"done\") '()))\n '(\"s\") \"fin\" \"p\")])\n (check! \"instrument keeps required when enf on\"\n (workflow-required-steps (instrument-workflow wf #t (vector 'none))) '(\"s\"))\n (check! \"instrument strips required when enf off\"\n (workflow-required-steps (instrument-workflow wf #f (vector 'none))) '()))\n\n(section \"=== eval: error-type classification ===\")\n(check! \"eval-error-type max-iterations\"\n (eval-error-type (guard (e [#t e]) (raise-max-iterations 5 '() '(\"x\")))) \"max_iterations\")\n(check! \"eval-error-type step-enforcement\"\n (eval-error-type (guard (e [#t e]) (raise-step-enforcement \"t\" 3 '(\"s\")))) \"step_enforcement\")\n(check! \"eval-error-type prerequisite\"\n (eval-error-type (guard (e [#t e]) (raise-prerequisite-error \"t\" 2 '(\"s\")))) \"prerequisite\")\n(check! \"eval-error-type tool-execution\"\n (eval-error-type (guard (e [#t e]) (raise-tool-execution-error \"t\" \"boom\"))) \"tool_execution\")\n(check! \"eval-error-type non-condition\" (eval-error-type \"oops\") \"error\")\n\n(section \"=== eval: analyze-messages ===\")\n(let* ([msgs (list\n (make-system-message \"sys\")\n (make-user-message \"u\")\n (make-assistant-message \"thinking out loud\")\n (make-assistant-message \"\" (list (make-tool-call \"search\" '())\n (make-tool-call \"search\" '())))\n (make-tool-result \"id1\" \"[StepEnforcementError] nudge\")\n (make-tool-result \"id2\" \"[ToolError] boom\")\n (make-tool-result \"id3\" \"ok result\")\n (make-assistant-message \"\" (list (make-tool-call \"answer\" '()))))]\n [st (analyze-messages msgs)])\n (check! \"analyze total tool-calls\" (history-stats-total-tool-calls st) 3)\n (check! \"analyze unique tools\" (history-stats-unique-tools st) 2)\n (check! \"analyze step nudges\" (history-stats-step-nudges st) 1)\n (check! \"analyze tool errors\" (history-stats-tool-errors st) 1)\n (check! \"analyze reasoning msgs\" (history-stats-reasoning-messages st) 1))\n\n(section \"=== eval: run-eval-scenario + ablation ===\")\n;; demo: scripted model answers before searching; step enforcement nudges it.\n(define (eval-demo-scenario)\n (make-eval-scenario\n \"demo\" \"premature answer nudged to search\"\n (lambda ()\n (let ([searched (vector #f)])\n (cons\n (make-workflow \"research\" \"search then answer\"\n (list\n (make-tool-def (make-tool-spec \"search\" \"s\" '((\"type\" . \"object\")))\n (lambda (a) (vector-set! searched 0 #t) \"results\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\")))\n (lambda (a) \"answered\") '()))\n '(\"search\") \"answer\" \"p\")\n (lambda () (vector-ref searched 0)))))\n \"look it up\"\n (lambda ()\n (scripted-responder\n (list (list (make-wtool-call \"answer\" '((\"text\" . \"early\")) #f))\n (list (make-wtool-call \"search\" '((\"q\" . \"x\")) #f))\n (list (make-wtool-call \"answer\" '((\"text\" . \"final\")) #f)))))\n (lambda (args) (and args (assoc \"text\" args) #t))\n '((max-iterations . 8))))\n(let ([on (run-eval-scenario (eval-demo-scenario))])\n (check! \"demo reforged completeness\" (run-result-completeness on) #t)\n (check! \"demo reforged accuracy\" (run-result-accuracy on) #t)\n (check! \"demo reforged iters 3\" (run-result-iterations-used on) 3)\n (check! \"demo reforged error-type #f\" (run-result-error-type on) #f)\n (check! \"demo reforged terminal text=final\"\n (cdr (assoc \"text\" (run-result-terminal-args on))) \"final\"))\n(let ([off (run-eval-scenario (eval-demo-scenario)\n (list (cons 'ablation (ablation-preset-ref \"no_steps\"))))])\n (check! \"demo no_steps completeness\" (run-result-completeness off) #t)\n (check! \"demo no_steps accuracy #f (ungrounded)\" (run-result-accuracy off) #f)\n (check! \"demo no_steps iters 1\" (run-result-iterations-used off) 1)\n (check! \"demo no_steps answered immediately\"\n (cdr (assoc \"text\" (run-result-terminal-args off))) \"early\"))\n;; never-terminating scenario → max_iterations\n(let ([r (run-eval-scenario\n (make-eval-scenario \"loop\" \"never terminates\"\n (lambda ()\n (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"noop\" \"n\" '()) (lambda (a) \"ok\") '())\n (make-tool-def (make-tool-spec \"done\" \"d\" '()) (lambda (a) \"x\") '()))\n '() \"done\" \"p\"))\n \"go\"\n (lambda () (scripted-responder (list (list (make-wtool-call \"noop\" '() #f)))))\n #f\n (list (cons 'max-iterations 3))))])\n (check! \"loop scenario not complete\" (run-result-completeness r) #f)\n (check! \"loop scenario error-type max_iterations\" (run-result-error-type r) \"max_iterations\")\n (check! \"loop scenario accuracy #f\" (run-result-accuracy r) #f))\n;; ablation sweep + pass-rate aggregation\n(let* ([rows (run-ablation (eval-demo-scenario)\n (list (ablation-preset-ref \"reforged\") (ablation-preset-ref \"no_steps\")))]\n [rates (ablation-pass-rates rows)])\n (check! \"ablation rows count\" (length rows) 2)\n (check! \"ablation reforged passed\" (run-result-accuracy (cdr (assoc \"reforged\" rows))) #t)\n (check! \"ablation no_steps failed\" (run-result-accuracy (cdr (assoc \"no_steps\" rows))) #f)\n (check! \"pass-rate reforged 1/1\" (cdr (assoc \"reforged\" rates)) '(1 . 1))\n (check! \"pass-rate no_steps 0/1\" (cdr (assoc \"no_steps\" rates)) '(0 . 1)))\n\n(section \"=== verify-gate: ATLAS verify+repair on forge primitives ===\")\n;; A small model that tries to finish on UNWRITTEN code. make-verified-workflow\n;; sets required-steps (edit verify) and a verify callable that RAISES on\n;; failure, so the terminal stays gated until verify actually passes. The script\n;; below tries done first, then writes buggy code, verifies (fails), repairs,\n;; verifies (passes), and finishes — shipping correct code. Strip step\n;; enforcement (no_steps) and the premature done ships UNWRITTEN code: accuracy\n;; flips #t → #f. This is ATLAS's self-verified-repair win on existing machinery.\n(define (verify-gate-scenario)\n (make-eval-scenario\n \"verify-gate\" \"premature done forced through verify+repair\"\n (lambda ()\n (let ([code (vector \"UNWRITTEN\")])\n (cons\n (make-verified-workflow \"vcode\" \"edit, verify, done\"\n (make-tool-def (make-tool-spec \"edit\" \"write code\" '((\"type\" . \"object\")))\n (lambda (a)\n (vector-set! code 0 (let ([p (assoc \"content\" a)]) (if p (cdr p) \"\")))\n \"edited\")\n '())\n (make-tool-def (make-tool-spec \"verify\" \"run tests\" '((\"type\" . \"object\")))\n (make-verify-callable\n (lambda (a)\n (if (equal? (vector-ref code 0) \"correct\")\n (cons #t \"all tests passed\")\n (cons #f \"test_basic FAILED: wrong output\"))))\n '())\n (make-tool-def (make-tool-spec \"done\" \"finish\" '((\"type\" . \"object\")))\n (lambda (a) (let ([p (assoc \"summary\" a)]) (if p (cdr p) \"done\")))\n '()))\n (lambda () (equal? (vector-ref code 0) \"correct\")))))\n \"implement the feature\"\n (lambda ()\n (scripted-responder\n (list (list (make-wtool-call \"done\" '((\"summary\" . \"all set\")) #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"fixed+verified\")) #f)))))\n (lambda (args) (and args #t))\n '((max-iterations . 12))))\n(let ([on (run-eval-scenario (verify-gate-scenario))])\n (check! \"verify-gate reforged completeness\" (run-result-completeness on) #t)\n (check! \"verify-gate reforged accuracy (correct code shipped)\" (run-result-accuracy on) #t)\n (check! \"verify-gate reforged iters 6\" (run-result-iterations-used on) 6)\n (let ([st (analyze-messages (run-result-messages on))])\n (check! \"verify-gate repair fired (1 tool error)\" (history-stats-tool-errors st) 1)\n (check! \"verify-gate gate fired (1 step nudge)\" (history-stats-step-nudges st) 1)))\n(let ([off (run-eval-scenario (verify-gate-scenario)\n (list (cons 'ablation (ablation-preset-ref \"no_steps\"))))])\n (check! \"verify-gate no_steps completeness\" (run-result-completeness off) #t)\n (check! \"verify-gate no_steps accuracy #f (unwritten shipped)\" (run-result-accuracy off) #f)\n (check! \"verify-gate no_steps iters 1\" (run-result-iterations-used off) 1))\n;; the headline: the gate converts a wrong outcome into a right one.\n(let* ([rows (run-ablation (verify-gate-scenario)\n (list (ablation-preset-ref \"reforged\") (ablation-preset-ref \"no_steps\")))]\n [rates (ablation-pass-rates rows)])\n (check! \"verify-gate flip reforged 1/1\" (cdr (assoc \"reforged\" rates)) '(1 . 1))\n (check! \"verify-gate flip no_steps 0/1\" (cdr (assoc \"no_steps\" rates)) '(0 . 1)))\n\n(section \"=== best-of-k: ATLAS diverse-gen, verify selects ===\")\n;; Two candidates for one task. Candidate 0 writes buggy code and never gets it\n;; past verify within the iteration budget — run-workflow RAISES, so the\n;; candidate is rejected. Candidate 1 (a diverse re-sample) writes correct code,\n;; verifies, and finishes. best-of-1 sees only the buggy candidate and fails;\n;; best-of-2 resamples and the verify-gate selects the passing trajectory. This\n;; is ATLAS's Phase-1 diverse-generation win composed with the verify-gate.\n(define (bok-workflow code)\n (make-verified-workflow \"bok\" \"edit, verify, done\"\n (make-tool-def (make-tool-spec \"edit\" \"write code\" '((\"type\" . \"object\")))\n (lambda (a)\n (vector-set! code 0 (let ([p (assoc \"content\" a)]) (if p (cdr p) \"\")))\n \"edited\")\n '())\n (make-tool-def (make-tool-spec \"verify\" \"run tests\" '((\"type\" . \"object\")))\n (make-verify-callable\n (lambda (a)\n (if (equal? (vector-ref code 0) \"correct\")\n (cons #t \"all tests passed\")\n (cons #f \"test_basic FAILED: wrong output\"))))\n '())\n (make-tool-def (make-tool-spec \"done\" \"finish\" '((\"type\" . \"object\")))\n (lambda (a) \"SHIPPED\") '())))\n;; A factory thunk: successive calls return candidate 0, then candidate 1, …\n(define (bok-factory)\n (let ([attempt -1])\n (lambda ()\n (set! attempt (+ attempt 1))\n (if (= attempt 0)\n (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))))\n (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"fixed\")) #f))))))))\n(define bok-opts (list (cons 'max-iterations 5) (cons 'max-tool-errors 10)))\n;; best-of-1: only the buggy candidate → never verifies → run-workflow raises.\n(check! \"best-of-1 fails (buggy candidate, no selection)\"\n (raises? (lambda () (run-best-of-k (bok-workflow (vector \"UNWRITTEN\"))\n \"go\" (bok-factory) 1 bok-opts))) #t)\n;; best-of-2: candidate 1 verifies → returned as the selected trajectory.\n(check! \"best-of-2 succeeds (verify selects the passing resample)\"\n (run-best-of-k (bok-workflow (vector \"UNWRITTEN\")) \"go\" (bok-factory) 2 bok-opts)\n \"SHIPPED\")\n;; k<1 is clamped to a single attempt.\n(check! \"best-of-0 clamps to 1 (still fails on the buggy candidate)\"\n (raises? (lambda () (run-best-of-k (bok-workflow (vector \"UNWRITTEN\"))\n \"go\" (bok-factory) 0 bok-opts))) #t)\n\n(section \"=== no-progress breaker: ATLAS cheap loop breaker ===\")\n;; A model stuck calling the same executed tool forever. The error budget never\n;; trips (the call succeeds) and the terminal is never reached, so without a\n;; breaker it silently burns the whole iteration budget → MaxIterationsError.\n;; The opt-in max-repeated-calls breaker detects the identical-batch loop and\n;; breaks early with NoProgressError, wasting far less compute. (look has no\n;; prerequisite and is not a required step, so each call genuinely executes.)\n(define (mk-stuck-wf)\n (make-workflow \"stuck\" \"Look, then answer.\"\n (list\n (make-tool-def (make-tool-spec \"look\" \"l\" '((\"type\" . \"object\"))) (lambda (a) \"looked\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\"))) (lambda (a) \"ANSWER\") '()))\n '() \"answer\" \"p\"))\n;; Without the breaker: 6 identical looks burn all 6 iterations → MaxIterations.\n(let* ([w (mk-stuck-wf)]\n [calls (vector 0)]\n [base (scripted-responder (make-list 10 (list (make-wtool-call \"look\" '() #f))))]\n [resp (lambda (m s i) (vector-set! calls 0 (+ (vector-ref calls 0) 1)) (base m s i))])\n (check! \"no breaker: stuck loop raises MaxIterationsError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 6))))\n max-iterations-error?) #t)\n (check! \"no breaker burned all 6 iterations\" (vector-ref calls 0) 6))\n;; With the breaker (3): breaks at the 3rd identical executed batch → NoProgress.\n(let* ([w (mk-stuck-wf)]\n [calls (vector 0)]\n [base (scripted-responder (make-list 10 (list (make-wtool-call \"look\" '() #f))))]\n [resp (lambda (m s i) (vector-set! calls 0 (+ (vector-ref calls 0) 1)) (base m s i))])\n (check! \"breaker: stuck loop raises NoProgressError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6) (cons 'max-repeated-calls 3))))\n no-progress-error?) #t)\n (check! \"breaker fired at 3 calls, not 6 (half the wasted compute)\"\n (vector-ref calls 0) 3))\n;; The breaker only counts identical *executed* batches: a real edit→verify→edit\n;; repair cycle alternates tools, so it never trips even with a tight threshold.\n(let* ([code (vector \"UNWRITTEN\")]\n [w (bok-workflow code)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"ok\")) #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 8)\n (cons 'max-repeated-calls 2)))])\n (check! \"breaker leaves real edit/verify repair alone\" result \"SHIPPED\"))\n\n(section \"=== agent chat no-progress breaker ===\")\n;; Sub-agents use agent-chat-messages, not agent-run. This tests the lower-level\n;; per-turn breaker directly: repeated glob misses separated by ls calls must\n;; still trip on the third identical tool-call signature.\n(let ([glob-bin (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"bin/**/*.ss\\\",\\\"path\\\":\\\"/repo\\\"}\"))]\n [ls-bin (list (make-tool-call \"ls\" \"{\\\"path\\\":\\\"/repo/bin\\\"}\"))])\n (parameterize ([forge-max-repeated-calls 3]\n [forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker first glob ok\" (forge-no-progress? glob-bin) #f)\n (check! \"agent breaker interleaved ls ok\" (forge-no-progress? ls-bin) #f)\n (check! \"agent breaker second glob ok\" (forge-no-progress? glob-bin) #f)\n (check! \"agent breaker second ls ok\" (forge-no-progress? ls-bin) #f)\n (check! \"agent breaker non-consecutive third glob trips\"\n (forge-no-progress? glob-bin) #t)))\n(let ([glob-src (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"*.ss\\\",\\\"path\\\":\\\"/repo/src\\\"}\"))]\n [glob-lib (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"*.ss\\\",\\\"path\\\":\\\"/repo/lib\\\"}\"))])\n (parameterize ([forge-max-repeated-calls 3]\n [forge-max-similar-search-calls 2]\n [forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker first similar glob ok\" (forge-no-progress? glob-src) #f)\n (check! \"agent breaker second same-pattern glob trips\"\n (forge-no-progress? glob-lib) #t)))\n(parameterize ([forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker nudge initially unused\" (forge-no-progress-nudge-used?) #f)\n (forge-mark-no-progress-nudged!)\n (check! \"agent breaker nudge marked used\" (forge-no-progress-nudge-used?) #t))\n\n(section \"=== expert escalation ===\")\n;; Guessed paths during repository exploration are normal recovery steps for a\n;; local model. They should not consume expert budget as a tool-error streak,\n;; while real tool failures still should.\n(let* ([msgs (list (make-tool-result \"r1\" \"Error: File not found: /repo/src/jcode/agent.ss\")\n (make-tool-result \"r2\" \"Error: Path not found: /repo/bin\")\n (make-tool-result \"r3\" \"Error: Not a directory: /repo/README.md\"))]\n [resp (make-assistant-message \"I'll keep looking.\")])\n (check! \"escalation ignores lookup misses\"\n (should-escalate? msgs resp '()) #f))\n\n(let* ([msgs (list (make-tool-result \"r1\" \"Error: command failed: exit 1\")\n (make-tool-result \"r2\" \"Error: sandbox denied\")\n (make-tool-result \"r3\" \"MCP Error: server disconnected\"))]\n [resp (make-assistant-message \"I'll keep looking.\")]\n [reason (should-escalate? msgs resp '())])\n (check! \"escalation keeps real tool-error streak\"\n (and reason (cdr (assq 'signal reason))) 'tool-error-streak))\n\n(section \"=== verified-run: coding workflow on a REAL file + REAL shell verify ===\")\n;; The verify-gate/best-of-k tests above use mock callables. This one drives the\n;; live-model bridge's genuinely new code — do-edit (real write-file-string),\n;; run-verify-command (real /bin/sh shell-out → exit-code → pass?), and\n;; coding-workflow's gate wiring — with a scripted responder standing in for the\n;; model. verify is `grep -q correct <file>`: it FAILS on \"buggy\" (exit 1) and\n;; PASSES on \"correct\" (exit 0). The script edits buggy, verifies (fails), then\n;; tries to done — that premature done must be GATED because the failed verify\n;; RAISED (make-verify-callable) and was never recorded. Only after a repair edit\n;; and a passing verify does done go through. result == \"verified-and-done\"\n;; (never \"shipped-buggy\") proves the real shell verify actually gates the\n;; terminal; the file ending in \"correct\" proves do-edit wrote real bytes.\n(let* ([vr-dir \"/tmp\"]\n [vr-name \"jcode-verified-run-test.txt\"]\n [vr-path (string-append vr-dir \"/\" vr-name)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))]\n [tool-results '()])\n (guard (e [#t (void)]) (delete-file vr-path)) ; clean any stale file\n (let* ([wf (coding-workflow (string-append \"grep -q correct \" vr-name) vr-dir)]\n [resp (scripted-responder\n (list\n (list (make-wtool-call \"edit\" (list (cons \"path\" vr-name) (cons \"content\" \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"shipped-buggy\")) #f))\n (list (make-wtool-call \"edit\" (list (cons \"path\" vr-name) (cons \"content\" \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"verified-and-done\")) #f))))]\n [result (run-workflow wf \"implement the feature\" resp\n (list\n (cons 'max-iterations 12)\n (cons 'on-message\n\t (lambda (m)\n\t (when (equal? (message-role m) \"tool\")\n\t (set! tool-results\n\t (cons (message-content m)\n\t tool-results)))))))])\n (when (not (equal? result \"verified-and-done\"))\n (for-each (lambda (s) (printf \" trace: ~a~n\" s))\n (reverse tool-results)))\n (check! \"verified-run: gate held — done after passing verify, not the buggy one\"\n result \"verified-and-done\")\n (check! \"verified-run: do-edit wrote the repaired bytes to the real file\"\n (slurp vr-path) \"correct\"))\n (guard (e [#t (void)]) (delete-file vr-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [allowed \"jcode-verified-scope-allowed.txt\"]\n [denied \"jcode-verified-scope-denied.txt\"]\n [allowed-path (string-append vr-dir \"/\" allowed)]\n [denied-path (string-append vr-dir \"/\" denied)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file allowed-path))\n (guard (e [#t (void)]) (delete-file denied-path))\n (let* ([scope (parse-write-scope allowed)]\n [wf (coding-workflow (string-append \"grep -q scoped \" allowed) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list (make-wtool-call \"edit\" (list (cons \"path\" denied) (cons \"content\" \"bad\")) #f))\n (list (make-wtool-call \"edit\" (list (cons \"path\" allowed) (cons \"content\" \"scoped\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"scope-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"write within scope\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: scoped edit can still complete after refused out-of-scope edit\"\n result \"scope-ok\")\n (check! \"verified-run: out-of-scope edit did not create file\"\n (file-exists? denied-path) #f)\n (check! \"verified-run: in-scope edit wrote file\"\n (slurp allowed-path) \"scoped\"))\n (guard (e [#t (void)]) (delete-file allowed-path))\n (guard (e [#t (void)]) (delete-file denied-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-heredoc.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q heredoc \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"run\"\n (list (cons \"bash\"\n (string-append\n \"cat > \" target \" << 'EOF'\\n\"\n \"heredoc\\n\"\n \"EOF\")))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"heredoc-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"write heredoc safely\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: cat heredoc alias writes through scoped edit\"\n result \"heredoc-ok\")\n (check! \"verified-run: heredoc content was written\"\n (slurp target-path) \"heredoc\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([wf (coding-workflow \"true\" \"/tmp\")]\n [tool-results '()]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"run\"\n '((\"bash\" . \"which jerbuild || echo \\\"jerbuild not found\\\"\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"which-ok\")) #f))))]\n [result (run-workflow wf \"probe then verify\" resp\n (list (cons 'max-iterations 8)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results)))))))])\n (check! \"verified-run: which probe still reaches verified done\"\n result \"which-ok\")\n (check-pred! \"verified-run: which probe gets edit/verify guidance\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"Environment probing is unnecessary\")))))\n\n (let* ([wf (coding-workflow \"true\" \"/tmp\")]\n [target \"jcode-verified-read-range.txt\"]\n [target-path (string-append \"/tmp/\" target)]\n [tool-results '()]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"read\"\n (list (cons \"path\" target)\n (cons \"line\" 2)\n (cons \"end\" 3))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"read-range-ok\")) #f))))]\n [result (begin\n (call-with-output-file target-path\n (lambda (o) (display \"one\\ntwo\\nthree\\nfour\\n\" o))\n 'replace)\n (run-workflow wf \"inspect a line range\" resp\n (list (cons 'max-iterations 8)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: read line range reaches verified done\"\n result \"read-range-ok\")\n (check! \"verified-run: read line/end returns selected span\"\n (car (reverse tool-results)) \"two\\nthree\"))\n (guard (e [#t (void)]) (delete-file \"/tmp/jcode-verified-read-range.txt\"))\n\n (let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-edit-file-alias.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"file\" \"alias-content\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"file-alias-ok\")) #f))))]\n [wf (coding-workflow (string-append \"grep -q alias-content \" target) vr-dir)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let ([result (run-workflow wf \"write using file alias\" resp\n (list (cons 'max-iterations 8)))])\n (check! \"verified-run: edit accepts file content alias\"\n result \"file-alias-ok\")\n (check! \"verified-run: file content alias writes bytes\"\n (slurp target-path) \"alias-content\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-def.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(define (keep) \\\"keep\\\")\\n\\n(define (broken x)\\n (+ x 1))\\n\"]\n [replacement \"(define (broken x)\\n (+ x 2))\\n\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q \\\"(+ x 2)\\\" \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"replace_def\"\n (list (cons \"path\" target)\n (cons \"name\" \"broken\")\n (cons \"content\" replacement))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-def-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"replace one function\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace_def reaches verified done\"\n result \"replace-def-ok\")\n (check-pred! \"verified-run: replace_def changed only named function\"\n (slurp target-path)\n (lambda (s)\n (and (str-contains? s \"(define (keep) \\\"keep\\\")\")\n (str-contains? s \"(+ x 2)\")\n (not (str-contains? s \"(+ x 1)\"))))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-range.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(import (jerboa prelude))\\n(define (bad)\\n (displayln \\\"bad\\\")\\n\\n(define (ok) 1)\\n\"]\n [replacement \"(define (bad)\\n (displayln \\\"fixed\\\"))\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q fixed \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"replace_range\"\n (list (cons \"path\" target)\n (cons \"start\" 2)\n (cons \"end\" 4)\n (cons \"content\" replacement))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-range-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"replace unbalanced span\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace_range reaches verified done\"\n result \"replace-range-ok\")\n (check-pred! \"verified-run: replace_range repairs unbalanced span\"\n (slurp target-path)\n (lambda (s)\n (and (str-contains? s \"(displayln \\\"fixed\\\")\")\n (str-contains? s \"(define (ok) 1)\")\n (not (str-contains? s \"(displayln \\\"bad\\\")\"))))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-syntax-guard.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [bad \"(import (jerboa prelude))\\n(define *score* 0)\\n(set!*score* 1)\\n\"]\n [good \"(import (jerboa prelude))\\n(define *score* 0)\\n(set! *score* 1)\\n\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [tool-results '()]\n [wf (coding-workflow (string-append \"test -s \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"content\" bad))\n #f))\n (list\n (make-wtool-call\n \"run\"\n '((\"path\" . \".\"))\n #f))\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"content\" good))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"syntax-guard-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"reject bad generated syntax\" resp\n (list (cons 'max-iterations 8)\n (cons 'max-tool-errors 3)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: syntax guard rejects then accepts repaired write\"\n result \"syntax-guard-ok\")\n (check! \"verified-run: syntax guard accepted corrected set! spacing\"\n (slurp target-path) good)\n\t (check-pred! \"verified-run: syntax guard explains missing whitespace\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (and (pair? xs)\n\t (str-contains? (car xs) \"missing whitespace after set!\"))))\n\t (check-pred! \"verified-run: rejected create redirects run back to edit\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (let loop ([ys xs])\n\t (cond\n\t [(null? ys) #f]\n\t [(and (str-contains? (car ys) \"file still does not exist\")\n\t (str-contains? (car ys) \"Next tool call must be edit\"))\n\t #t]\n\t [else (loop (cdr ys))])))))\n\t (guard (e [#t (void)]) (delete-file target-path)))\n\n\t(let* ([vr-dir \"/tmp\"]\n\t [target \"jcode-verified-snippet-create.ss\"]\n\t [target-path (string-append vr-dir \"/\" target)]\n\t [snippet \"(define (main) 1)\\n\"]\n\t [full \"(import (jerboa prelude))\\n(define (main) 1)\\n\"]\n\t [tool-results '()]\n\t [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n\t (guard (e [#t (void)]) (delete-file target-path))\n\t (let* ([scope (parse-write-scope target)]\n\t [wf (coding-workflow (string-append \"test -s \" target) vr-dir\n\t (list (cons 'write-scope scope)))]\n\t [resp (scripted-responder\n\t (list\n\t (list\n\t (make-wtool-call\n\t \"edit\"\n\t (list (cons \"path\" target)\n\t (cons \"old_str\" \"missing\")\n\t (cons \"new_str\" snippet))\n\t #f))\n\t (list\n\t (make-wtool-call\n\t \"edit\"\n\t (list (cons \"path\" target)\n\t (cons \"content\" full))\n\t #f))\n\t (list (make-wtool-call \"verify\" '() #f))\n\t (list (make-wtool-call \"done\" '((\"summary\" . \"snippet-create-guard\")) #f))))]\n\t [result (parameterize ((current-write-scope scope))\n\t (run-workflow wf \"reject snippet create for ss\" resp\n\t (list (cons 'max-iterations 8)\n\t (cons 'max-tool-errors 3)\n\t (cons 'on-message\n\t (lambda (m)\n\t (when (equal? (message-role m) \"tool\")\n\t (set! tool-results\n\t (cons (message-content m) tool-results))))))))])\n\t (check! \"verified-run: .ss replacement create rejects snippets\"\n\t result \"snippet-create-guard\")\n\t (check! \"verified-run: .ss snippet create eventually writes full file\"\n\t (slurp target-path) full)\n\t (check-pred! \"verified-run: .ss snippet create explains full-file requirement\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (and (pair? xs)\n\t (str-contains? (car xs) \"missing .ss target requires complete file contents\")))))\n\t (guard (e [#t (void)]) (delete-file target-path)))\n\n\t(let* ([vr-dir \"/tmp\"]\n\t [target \"jcode-verified-syntax-guard-replace.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(import (jerboa prelude))\\n(define *window* #f)\\n(define (show) (qt-widget-show! *window*))\\n\"]\n [bad \"(qt-widget-show!*window*)\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [tool-results '()]\n [wf (coding-workflow (string-append \"grep -q \\\"qt-widget-show!\\\" \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"(qt-widget-show! *window*)\")\n (cons \"new_str\" bad))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"syntax-guard-preserved\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"reject bad replacement syntax\" resp\n (list (cons 'max-iterations 8)\n (cons 'max-tool-errors 3)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: syntax guard rejected replacement but workflow recovered\"\n result \"syntax-guard-preserved\")\n (check! \"verified-run: rejected replacement preserved original file\"\n (slurp target-path) initial)\n (check-pred! \"verified-run: syntax guard explains qt missing whitespace\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"missing whitespace after qt-widget-show!\")))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-empty-oldstr-create.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q created \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"\")\n (cons \"new_str\" \"created\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"empty-oldstr-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"create with empty old_str\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: empty old_str on missing file creates scoped file\"\n result \"empty-oldstr-ok\")\n (check! \"verified-run: empty old_str create wrote new_str\"\n (slurp target-path) \"created\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-create.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q replacement-created \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"missing-template\")\n (cons \"new_str\" \"replacement-created\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-create-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"create with replace args\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace args on missing file create scoped file\"\n result \"replace-create-ok\")\n (check! \"verified-run: replace-create wrote new_str\"\n (slurp target-path) \"replacement-created\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n;; ── grok-auth ─────────────────────────────────────────────────────\n;; Hermetic: drive the pure *-from helpers with JSON parsed from strings\n;; (string->json-object yields the same hashtables read-json produces), so no\n;; ~/.grok fixture files are needed.\n\n(section \"=== grok-auth ===\")\n\n;; iso8601->epoch: valid → number, ordering preserved, junk → #f.\n(check-pred! \"iso8601 valid → number\" (iso8601->epoch \"2026-05-28T02:15:10.5Z\") number?)\n(check! \"iso8601 junk → #f\" (iso8601->epoch \"not-a-date\") #f)\n(check! \"iso8601 non-string → #f\" (iso8601->epoch 12345) #f)\n(check! \"iso8601 ordering past<future\"\n (< (iso8601->epoch \"2020-01-01T00:00:00Z\")\n (iso8601->epoch \"2026-01-01T00:00:00Z\"))\n #t)\n\n;; auth.json: single fresh token.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-fresh\\\",\\\"expires_at\\\":\\\"2999-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: single fresh\" (grok-auth-token-from d) \"tok-fresh\")\n (check! \"grok expired?: fresh\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: expired token still returned (proxy will 401), expired? = #t.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-old\\\",\\\"expires_at\\\":\\\"2000-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: expired returned\" (grok-auth-token-from d) \"tok-old\")\n (check! \"grok expired?: expired\" (grok-auth-expired-from? d) #t))\n\n;; auth.json: multiple entries → prefer the non-expired one regardless of order.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::a\\\":{\\\"key\\\":\\\"tok-old\\\",\\\"expires_at\\\":\\\"2000-01-01T00:00:00Z\\\"},\\\"https://auth.x.ai::b\\\":{\\\"key\\\":\\\"tok-new\\\",\\\"expires_at\\\":\\\"2999-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: prefer non-expired\" (grok-auth-token-from d) \"tok-new\")\n (check! \"grok expired?: multi has fresh\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: empty key is unusable; missing file / empty object → #f.\n(check! \"grok token: empty key → #f\"\n (grok-auth-token-from (string->json-object \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"\\\"}}\")) #f)\n(check! \"grok token: #f data → #f\" (grok-auth-token-from #f) #f)\n(check! \"grok token: empty object → #f\" (grok-auth-token-from (string->json-object \"{}\")) #f)\n\n;; auth.json: missing expires_at is conservatively NOT expired.\n(let ([d (string->json-object \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-x\\\"}}\")])\n (check! \"grok token: no expires_at returned\" (grok-auth-token-from d) \"tok-x\")\n (check! \"grok expired?: no expires_at → #f\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: non-prefixed key still usable as a fallback.\n(check! \"grok token: non-prefixed fallback\"\n (grok-auth-token-from (string->json-object \"{\\\"other\\\":{\\\"key\\\":\\\"tok-fb\\\"}}\")) \"tok-fb\")\n\n;; models_cache.json: full grok-build info.\n(let ([info (grok-model-info-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"model\\\":\\\"grok-build\\\",\\\"base_url\\\":\\\"https://cli-chat-proxy.grok.com/v1\\\",\\\"name\\\":\\\"Grok Build\\\",\\\"api_backend\\\":\\\"responses\\\",\\\"auth_scheme\\\":\\\"bearer\\\",\\\"context_window\\\":512000}}}}\")\n \"grok-build\")])\n (check! \"grok info base_url\" (grok-model-info-ref info \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\")\n (check! \"grok info api_backend\" (grok-model-info-ref info \"api_backend\" #f) \"responses\")\n (check! \"grok info auth_scheme\" (grok-model-info-ref info \"auth_scheme\" #f) \"bearer\")\n (check! \"grok info context_window\" (grok-model-info-ref info \"context_window\" #f) 512000)\n (check! \"grok info name\" (grok-model-info-ref info \"name\" #f) \"Grok Build\"))\n\n;; models_cache.json: missing fields fall back to hardcoded defaults.\n(let ([info (grok-model-info-from\n (string->json-object \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{}}}}\") \"grok-build\")])\n (check! \"grok info ctx fallback\" (grok-model-info-ref info \"context_window\" #f) 512000)\n (check! \"grok info backend fallback\" (grok-model-info-ref info \"api_backend\" #f) \"responses\")\n (check! \"grok info base_url fallback\" (grok-model-info-ref info \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\"))\n\n(check! \"grok info: missing model → #f\"\n (grok-model-info-from (string->json-object \"{\\\"models\\\":{}}\") \"grok-build\") #f)\n(check! \"grok info: #f data → #f\" (grok-model-info-from #f \"grok-build\") #f)\n\n;; The hardcoded fallback matches the observed grok-build metadata.\n(let ([fb (grok-fallback-model-info)])\n (check! \"grok fallback base_url\" (grok-model-info-ref fb \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\")\n (check! \"grok fallback api_backend\" (grok-model-info-ref fb \"api_backend\" #f) \"responses\")\n (check! \"grok fallback context_window\" (grok-model-info-ref fb \"context_window\" #f) 512000))\n\n;; models_cache.json → (id . display) list; hidden models excluded; absent → ().\n(check! \"grok models-from list\"\n (grok-models-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"name\\\":\\\"Grok Build\\\"}}}}\"))\n '((\"grok-build\" . \"Grok Build\")))\n(check! \"grok models-from hides hidden\"\n (grok-models-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"name\\\":\\\"Grok Build\\\"}},\\\"sekret\\\":{\\\"info\\\":{\\\"name\\\":\\\"Sekret\\\",\\\"hidden\\\":true}}}}\"))\n '((\"grok-build\" . \"Grok Build\")))\n(check! \"grok models-from #f → ()\" (grok-models-from #f) '())\n\n;; ── config: grok provider-key layers + detect order ──────────────\n;; The live config-get-provider-key reads real env / store / config / ~/.grok,\n;; so we test the *pure* helpers it dispatches through: provider-key-layers\n;; (precedence) and detect-provider-from-list (auto-detect order).\n\n(section \"=== config: grok provider key ===\")\n\n;; *provider-env-vars* maps both grok and xai to XAI_API_KEY (env-key-for-provider\n;; layers GROK_CODE_XAI_API_KEY on top for grok only).\n(check! \"env-vars: grok → XAI_API_KEY\"\n (cdr (assoc \"grok\" *provider-env-vars*)) \"XAI_API_KEY\")\n(check! \"env-vars: xai still → XAI_API_KEY\"\n (cdr (assoc \"xai\" *provider-env-vars*)) \"XAI_API_KEY\")\n\n;; provider-key-layers precedence: env > store > config > grok-fn (grok only).\n(check! \"layers: env wins\"\n (provider-key-layers \"grok\"\n (lambda (p) \"env-k\") (lambda (p) \"store-k\") (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"env-k\")\n(check! \"layers: store wins when env #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) \"store-k\") (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"store-k\")\n(check! \"layers: config wins when env+store #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"cfg-k\")\n(check! \"layers: grok-fn last (only for grok)\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () \"tok\"))\n \"tok\")\n(check! \"layers: grok-fn NOT used for xai\"\n (provider-key-layers \"xai\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () \"tok\"))\n #f)\n(check! \"layers: nothing keyed → #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () #f))\n #f)\n\n;; detect-provider-from-list: grok is last so existing keyed providers win.\n(check! \"detect order: grok at the tail\"\n (car (reverse *detect-provider-order*)) \"grok\")\n(check! \"detect: skip until anthropic keyed\"\n (detect-provider-from-list *detect-provider-order*\n (lambda (p) (equal? p \"anthropic\")))\n \"anthropic\")\n(check! \"detect: grok picked when nothing else keyed\"\n (detect-provider-from-list *detect-provider-order*\n (lambda (p) (equal? p \"grok\")))\n \"grok\")\n(check! \"detect: nothing keyed → #f\"\n (detect-provider-from-list *detect-provider-order* (lambda (p) #f)) #f)\n\n;; ── models: grok metadata ─────────────────────────────────────────\n;; provider-default-models for \"grok\" returns whatever\n;; ~/.grok/models_cache.json holds, falling back to grok-models-fallback.\n;; Tests assert \"grok-build\" is present in both paths without depending on\n;; the user's actual ~/.grok contents.\n\n(section \"=== models: grok metadata ===\")\n\n(check-pred! \"all-providers contains grok\" (all-providers) (lambda (l) (member \"grok\" l)))\n(check-pred! \"all-providers still contains groq\" (all-providers) (lambda (l) (member \"groq\" l)))\n(check-pred! \"all-providers still contains xai\" (all-providers) (lambda (l) (member \"xai\" l)))\n\n(let* ([cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [mlx2 (make-hashtable equal-hash equal?)])\n (hashtable-set! mlx2 \"base_url\" \"http://192.168.6.84:8000/v1\")\n (hashtable-set! providers \"mlx2\" mlx2)\n (hashtable-set! cfg \"providers\" providers)\n (register-configured-providers! cfg)\n (check-pred! \"all-providers includes configured mlx2\"\n (all-providers)\n (lambda (l) (member \"mlx2\" l)))\n (check! \"provider-kind mlx2 = mlx\" (provider-kind \"mlx2\") \"mlx\")\n (check! \"local-provider? mlx2\" (local-provider? \"mlx2\") #t)\n (check! \"display name mlx2 aliases MLX\"\n (provider-display-name \"mlx2\") \"MLX (local) (mlx2)\")\n (register-configured-providers! (make-hashtable equal-hash equal?)))\n\n(let ([models '((\"anthropic/claude-sonnet-4\" . \"Claude Sonnet 4\")\n (\"openai/gpt-4o\" . \"GPT-4o\")\n (\"google/gemini-2.5-flash\" . \"Gemini 2.5 Flash\"))])\n (check! \"filter-models empty query returns all\"\n (filter-models models \"\")\n models)\n (check! \"filter-models matches id/display case-insensitively\"\n (map car (filter-models models \"CLAUDE sonnet\"))\n '(\"anthropic/claude-sonnet-4\"))\n (check! \"filter-models matches provider id\"\n (map car (filter-models models \"google flash\"))\n '(\"google/gemini-2.5-flash\")))\n\n(check! \"display name grok = Grok CLI\" (provider-display-name \"grok\") \"Grok CLI\")\n(check! \"display name xai unchanged\" (provider-display-name \"xai\") \"xAI (Grok)\")\n(check! \"default model grok = grok-build\" (provider-default-model \"grok\") \"grok-build\")\n(check! \"default model xai unchanged\" (provider-default-model \"xai\") \"grok-3-mini\")\n\n(check-pred! \"default models grok includes grok-build\"\n (provider-default-models \"grok\")\n (lambda (ms) (assoc \"grok-build\" ms)))\n\n(check! \"ctx window grok-build = 512000\" (model-context-window \"grok-build\") 512000)\n(check! \"ctx window grok-3 unaffected (no clause)\" (model-context-window \"grok-3\") #f)\n(check! \"ctx window qwen3-coder-next mlx conservative\"\n (model-context-window \"/Users/user/models/qwen3-coder-next-mlx\") 3072)\n(check! \"ctx window generic qwen3 remains 32768\"\n (model-context-window \"qwen3:8b-q4_K_M\") 32768)\n\n;; ── provider: grok Responses adapter ──────────────────────────────\n;; All hermetic — tests drive the pure helpers exported by the provider\n;; module (responses-{headers,body,parse-response}, message->responses-input,\n;; grok-backend-from, grok-list-models). No live HTTP.\n\n(section \"=== provider: grok Responses ===\")\n\n;; grok-backend-from: cache says responses by default; chat_completions when set.\n(check! \"grok-backend-from default → responses\" (grok-backend-from '()) \"responses\")\n(check! \"grok-backend-from chat_completions\"\n (grok-backend-from '((\"api_backend\" . \"chat_completions\"))) \"chat_completions\")\n(check! \"grok-backend-from responses\"\n (grok-backend-from '((\"api_backend\" . \"responses\"))) \"responses\")\n\n;; responses-headers: Bearer token; no secret in the table key/value besides\n;; the Authorization line.\n(let ([h (responses-headers (make-provider \"grok\" \"abc123\" \"grok-build\" \"https://x/v1\"))])\n (check! \"responses-headers content-type\"\n (cdr (assoc \"Content-Type\" h)) \"application/json\")\n (check! \"responses-headers bearer\"\n (cdr (assoc \"Authorization\" h)) \"Bearer abc123\"))\n\n;; message->responses-input: role + content; tool maps to user (no tools yet).\n(let ([u (message->responses-input (make-user-message \"hi\"))])\n (check! \"msg→resp role=user\" (hashtable-ref u \"role\" #f) \"user\")\n (check! \"msg→resp content=hi\" (hashtable-ref u \"content\" #f) \"hi\"))\n(let ([a (message->responses-input (make-assistant-message \"out\"))])\n (check! \"msg→resp role=assistant\" (hashtable-ref a \"role\" #f) \"assistant\")\n (check! \"msg→resp content=out\" (hashtable-ref a \"content\" #f) \"out\"))\n(let ([s (message->responses-input (make-system-message \"sys\"))])\n (check! \"msg→resp role=system\" (hashtable-ref s \"role\" #f) \"system\"))\n(let ([t (message->responses-input (make-tool-result \"cid\" \"result-text\"))])\n (check! \"msg→resp tool→user\" (hashtable-ref t \"role\" #f) \"user\")\n (check! \"msg→resp tool content\" (hashtable-ref t \"content\" #f) \"result-text\"))\n\n;; responses-body: model + input present; tools deliberately NOT serialized\n;; (first-pass scope — Responses tool spec unverified against cli-chat-proxy).\n(let* ([p (make-provider \"grok\" \"k\" \"grok-build\" \"https://x/v1\")]\n [b (responses-body p (list (make-user-message \"hi\")) '())])\n (check! \"responses-body model\" (hashtable-ref b \"model\" #f) \"grok-build\")\n (check-pred! \"responses-body input list\" (hashtable-ref b \"input\" #f) list?)\n (check! \"responses-body no tools (empty tools)\"\n (hashtable-ref b \"tools\" #f) #f))\n(let* ([p (make-provider \"grok\" \"k\" \"grok-build\" \"https://x/v1\")]\n [b (responses-body p '() (list (make-hashtable equal-hash equal?)))])\n (check! \"responses-body no tools (non-empty tools still skipped)\"\n (hashtable-ref b \"tools\" #f) #f))\n\n;; responses-parse-response: plain text → assistant message, no tool calls.\n(let ([m (responses-parse-response\n (string->json-object\n \"{\\\"output\\\":[{\\\"type\\\":\\\"message\\\",\\\"role\\\":\\\"assistant\\\",\\\"content\\\":[{\\\"type\\\":\\\"output_text\\\",\\\"text\\\":\\\"Hello world\\\"}]}]}\"))])\n (check! \"responses-parse text\" (message-content m) \"Hello world\")\n (check! \"responses-parse no tcs\" (message-tool-calls m) #f))\n\n;; responses-parse-response: function_call output items become tool calls.\n(let ([m (responses-parse-response\n (string->json-object\n \"{\\\"output\\\":[{\\\"type\\\":\\\"function_call\\\",\\\"id\\\":\\\"call_1\\\",\\\"name\\\":\\\"search\\\",\\\"arguments\\\":\\\"{\\\\\\\"q\\\\\\\":\\\\\\\"x\\\\\\\"}\\\"}]}\"))])\n (check-pred! \"responses-parse fc → tcs\"\n (message-tool-calls m) (lambda (tcs) (and (pair? tcs) (= 1 (length tcs)))))\n (let ([tc (car (message-tool-calls m))])\n (check! \"responses-parse fc name\" (tool-call-name tc) \"search\")\n (check! \"responses-parse fc id\" (tool-call-id tc) \"call_1\")))\n\n;; responses-parse-response: empty output → empty content, no tcs.\n(let ([m (responses-parse-response (string->json-object \"{\\\"output\\\":[]}\"))])\n (check! \"responses-parse empty text\" (message-content m) \"\")\n (check! \"responses-parse empty no tcs\" (message-tool-calls m) #f))\n\n;; grok-list-models: always includes grok-build (cache or fallback).\n(check-pred! \"grok-list-models has grok-build\"\n (grok-list-models (make-provider \"grok\" \"\" \"grok-build\" \"https://x/v1\"))\n (lambda (ms) (assoc \"grok-build\" ms)))\n\n;; ── provider: Google prompt cache accounting ───────────────────────\n\n(section \"=== provider: Google prompt cache accounting ===\")\n\n(let* ([body (string-append\n \"{\\\"candidates\\\":[{\\\"content\\\":{\\\"parts\\\":[{\\\"text\\\":\\\"hello\\\"}]}}],\"\n \"\\\"usageMetadata\\\":{\\\"promptTokenCount\\\":100,\"\n \"\\\"cachedContentTokenCount\\\":75,\"\n \"\\\"candidatesTokenCount\\\":4,\"\n \"\\\"thoughtsTokenCount\\\":6,\"\n \"\\\"totalTokenCount\\\":110}}\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1beta\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [google (make-hashtable equal-hash equal?)])\n (hashtable-set! google \"cached_content\" \"cachedContents/unit\")\n (hashtable-set! providers \"google\" google)\n (hashtable-set! cfg \"providers\" providers)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-json! srv captured 200 body)\n (let* ([p (make-provider \"google\" \"unit-key\" \"gemini-2.5-flash\" base-url)]\n [result (call-with-values\n (lambda ()\n (parameterize ([*config* cfg])\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f))))\n (lambda (content tcs usage) (list content tcs usage)))]\n [req (vector-ref captured 0)]\n [usage (list-ref result 2)])\n (check! \"google stream cache reply\" (car result) \"hello\")\n (check! \"google explicit cachedContent forwarded\"\n (and req\n (str-contains? req \"\\\"cachedContent\\\"\")\n (str-contains? req \"cachedContents/unit\"))\n #t)\n (check! \"google stream tokens-in\"\n (cdr (assoc 'tokens-in usage)) 100)\n (check! \"google stream tokens-out includes thoughts\"\n (cdr (assoc 'tokens-out usage)) 10)\n (check! \"google stream cache-read\"\n (cdr (assoc 'cache-read usage)) 75)\n (check! \"google stream cache-creation zero\"\n (cdr (assoc 'cache-creation usage)) 0)\n (check-pred! \"google stream cache cost positive\"\n (cdr (assoc 'cost usage))\n (lambda (x) (and (number? x) (> x 0))))))\n (lambda () (tcp-close srv))))\n\n;; ── provider: streaming HTTP error bodies ─────────────────────────\n\n(section \"=== provider: streaming HTTP error bodies ===\")\n\n(let* ([ndjson-body (string-append\n \"{\\\"model\\\":\\\"unit\\\",\\\"message\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"done\\\":false}\\n\"\n \"{\\\"model\\\":\\\"unit\\\",\\\"done\\\":true,\\\"prompt_eval_count\\\":100,\\\"eval_count\\\":2,\"\n \"\\\"prompt_eval_duration\\\":123,\\\"eval_duration\\\":456,\\\"load_duration\\\":7,\"\n \"\\\"total_duration\\\":586}\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [expert (make-hashtable equal-hash equal?)]\n [esc (make-hashtable equal-hash equal?)]\n [tool (make-hashtable equal-hash equal?)]\n [fn (make-hashtable equal-hash equal?)]\n [params (make-hashtable equal-hash equal?)])\n (hashtable-set! esc \"request_logprobs\" #t)\n (hashtable-set! expert \"escalation\" esc)\n (hashtable-set! cfg \"expert\" expert)\n (hashtable-set! params \"type\" \"object\")\n (hashtable-set! fn \"name\" \"lookup\")\n (hashtable-set! fn \"description\" \"lookup\")\n (hashtable-set! fn \"parameters\" params)\n (hashtable-set! tool \"type\" \"function\")\n (hashtable-set! tool \"function\" fn)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-json! srv captured 200 ndjson-body)\n (let* ([p (make-provider \"ollama\" \"\" \"unit-test-model\" base-url)]\n [result (call-with-values\n (lambda ()\n (parameterize ([*config* cfg])\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n (list tool)\n (lambda (token) #f))))\n (lambda (content tcs usage) (list content tcs usage)))]\n [req (vector-ref captured 0)])\n (check! \"ollama native stream tools reply\" (car result) \"ok\")\n (check! \"ollama native stream uses keep_alive\"\n (and req (str-contains? req \"\\\"keep_alive\\\"\")) #t)\n (check! \"ollama native stream uses native stream flag\"\n (and req (str-contains? req \"\\\"stream\\\":true\")) #t)\n (check! \"ollama native stream tools include tools\"\n (and req (str-contains? req \"\\\"tools\\\"\")) #t)\n (check! \"ollama native stream tools omit logprobs\"\n (and req (str-contains? req \"\\\"logprobs\\\"\")) #f)\n (check! \"ollama native stream tools omit top_logprobs\"\n (and req (str-contains? req \"\\\"top_logprobs\\\"\")) #f)\n (check! \"ollama native stream omits OpenAI stream options\"\n (and req (str-contains? req \"\\\"stream_options\\\"\")) #f)\n (check! \"ollama native stream omits unsupported prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #f)\n (check! \"ollama native stream tokens-in\"\n (cdr (assoc 'tokens-in (list-ref result 2))) 100)\n (check! \"ollama native stream tokens-out\"\n (cdr (assoc 'tokens-out (list-ref result 2))) 2)\n (check! \"ollama native stream cache-read unavailable\"\n (cdr (assoc 'cache-read (list-ref result 2))) 0)))\n (lambda () (tcp-close srv))))\n\n(let* ([sse-body (string-append\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"finish_reason\\\":null}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{},\\\"finish_reason\\\":\\\"stop\\\"}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[],\\\"usage\\\":{\\\"prompt_tokens\\\":100,\\\"completion_tokens\\\":2,\\\"prompt_tokens_details\\\":{\\\"cached_tokens\\\":42}}}\\n\\n\"\n \"data: [DONE]\\n\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-sse! srv captured sse-body)\n (let* ([p (make-provider \"mlx\" \"\" \"unit-test-model\" base-url)]\n [result (call-with-values\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f)))\n (lambda (content tcs usage) (cons content usage)))]\n [req (vector-ref captured 0)]\n [usage (cdr result)]\n [cache-hit (assoc 'cache-read usage)])\n (check! \"mlx stream cache reply\" (car result) \"ok\")\n (check! \"mlx stream prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #t)\n (check! \"mlx stream cached token accounting\"\n (and cache-hit (cdr cache-hit)) 42)))\n (lambda () (tcp-close srv))))\n\n(let* ([sse-body (string-append\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"finish_reason\\\":null}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{},\\\"finish_reason\\\":\\\"stop\\\"}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[],\\\"usage\\\":{\\\"prompt_tokens\\\":100,\\\"completion_tokens\\\":2,\\\"prompt_tokens_details\\\":{\\\"cached_tokens\\\":42}}}\\n\\n\"\n \"data: [DONE]\\n\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [mlx2 (make-hashtable equal-hash equal?)])\n (hashtable-set! mlx2 \"base_url\" base-url)\n (hashtable-set! providers \"mlx2\" mlx2)\n (hashtable-set! cfg \"providers\" providers)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-sse! srv captured sse-body)\n (let* ([p (parameterize ([*config* cfg])\n (make-provider \"mlx2\" \"\" \"unit-test-model\"))]\n [result (call-with-values\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f)))\n (lambda (content tcs usage) (cons content usage)))]\n [req (vector-ref captured 0)])\n (check! \"mlx2 configured base_url\"\n (provider-base-url p) base-url)\n (check! \"mlx2 stream keyless alias reply\" (car result) \"ok\")\n (check! \"mlx2 stream prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #t)))\n (lambda () (tcp-close srv))))\n\n(let* ([body \"{\\\"error\\\":{\\\"message\\\":\\\"unexpected EOF while reading stream; context window exhausted while decoding response!!\\\"}}\"]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [chunk-size (number->string (string-length body) 16)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-chunked-500! srv body)\n (let* ([p (make-provider \"ollama\" \"\" \"unit-test-model\" base-url)]\n [err (condition->string\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f))))])\n (check-pred! \"stream chunked 500 raises\" err string?)\n (check-pred! \"stream chunked 500 includes status\"\n err\n (lambda (s) (and (string? s)\n (str-contains? s \"API error 500:\"))))\n (check-pred! \"stream chunked 500 keeps body\"\n err\n (lambda (s) (and (string? s)\n (str-contains? s \"unexpected EOF\"))))\n (check! \"stream chunked 500 strips chunk-size\"\n (and (string? err)\n (str-contains? err\n (string-append \"API error 500: \"\n chunk-size)))\n #f)\n (check! \"stream chunked 500 strips terminator\"\n (and (string? err) (str-contains? err \"\\n0\"))\n #f)))\n (lambda () (tcp-close srv))))\n\n;; ── secrets-import: grok known-providers entry ────────────────────\n;; *known-providers* (secrets-import) is the single-env-var-per-provider\n;; mapping used by import-from-env! / aider import / interactive prompts.\n;; For \"grok\" we pick GROK_CODE_XAI_API_KEY so it does not duplicate xai's\n;; XAI_API_KEY entry; runtime config-get-provider-key accepts BOTH names.\n\n(section \"=== secrets-import: grok ===\")\n\n(check! \"*known-providers* maps grok → GROK_CODE_XAI_API_KEY\"\n (cdr (assoc \"grok\" *known-providers*)) \"GROK_CODE_XAI_API_KEY\")\n(check! \"*known-providers* still maps xai → XAI_API_KEY\"\n (cdr (assoc \"xai\" *known-providers*)) \"XAI_API_KEY\")\n(check-pred! \"*known-providers* still contains anthropic\"\n *known-providers* (lambda (l) (assoc \"anthropic\" l)))\n\n;; ── external-llm: /ask-grok + sandbox paths ───────────────────────\n;; The Grok CLI integration adds:\n;; - grok to (external-llm-providers)\n;; - ~/.grok writable for the grok provider; denied for every other one\n;; - parse-grok-json reads text + sessionId out of `grok -p ... --json` output\n;; Tests do NOT spawn the CLI (it may not be installed); they drive the pure\n;; helpers we exported for this purpose.\n\n(section \"=== external-llm: grok ===\")\n\n(check-pred! \"external-llm-providers includes grok\"\n (external-llm-providers) (lambda (l) (memq 'grok l)))\n(check-pred! \"external-llm-providers still includes claude\"\n (external-llm-providers) (lambda (l) (memq 'claude l)))\n\n;; macOS sandbox-exec wraps commands after Jerboa's normal PATH search, so the\n;; external runner must resolve provider argv[0] to an absolute path first.\n(let ([argv (resolve-external-argv '(\"sh\" \"-c\" \"true\"))])\n (check! \"external argv resolution preserves args\" (cdr argv) '(\"-c\" \"true\"))\n (check-pred! \"external argv resolution makes argv0 absolute\"\n (car argv)\n (lambda (s) (and (string? s) (str-prefix? \"/\" s))))\n (check-pred! \"external support paths include resolved argv0\"\n (external-command-support-paths '(\"sh\" \"-c\" \"true\"))\n (lambda (ps) (and (member (car argv) ps) #t))))\n\n(check! \"external argv resolution leaves missing command unchanged\"\n (resolve-external-argv '(\"jcode-definitely-missing-provider-cli\"))\n '(\"jcode-definitely-missing-provider-cli\"))\n\n(check-pred! \"external launch env includes PATH\"\n (external-launch-env '())\n (lambda (env) (and (assoc \"PATH\" env) #t)))\n(check! \"external launch env omits ambient OpenAI key\"\n (assoc \"OPENAI_API_KEY\" (external-launch-env '()))\n #f)\n(check! \"external launch env omits ambient Anthropic key\"\n (assoc \"ANTHROPIC_API_KEY\" (external-launch-env '()))\n #f)\n\n;; Sandbox: grok's own auth paths cover ~/.grok.\n(check-pred! \"grok auth paths include ~/.grok\"\n (provider-auth-paths 'grok)\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \".grok\") #t]\n [else (lp (cdr p))]))))\n\n;; Sandbox: when grok is the chosen CLI, its own ~/.grok is NOT denied,\n;; but every other CLI's auth dir IS.\n(define grok-deny (sensitive-deny-paths 'grok))\n(check-pred! \"grok sandbox denies ~/.claude\"\n grok-deny\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \".claude\") #t]\n [else (lp (cdr p))]))))\n(check! \"grok sandbox does NOT deny its own ~/.grok\"\n (let lp ([p grok-deny])\n (cond [(null? p) #f]\n [(str-contains? (car p) \"/.grok\") #t]\n [else (lp (cdr p))]))\n #f)\n\n;; Sandbox: when claude is the chosen CLI, ~/.grok IS denied (cross-CLI\n;; auth isolation — a malicious or compromised claude CLI cannot lift the\n;; Grok bearer token).\n(define claude-deny (sensitive-deny-paths 'claude))\n(check-pred! \"claude sandbox denies ~/.grok\"\n claude-deny\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \"/.grok\") #t]\n [else (lp (cdr p))]))))\n\n;; parse-grok-json: extracts text + sessionId; fallback session-id when missing.\n(let ([r (parse-grok-json\n \"{\\\"text\\\":\\\"Hello!\\\",\\\"sessionId\\\":\\\"sid-1\\\",\\\"stopReason\\\":\\\"end_turn\\\"}\"\n \"fallback-sid\")])\n (check! \"parse-grok-json text\" (ext-result-text r) \"Hello!\")\n (check! \"parse-grok-json sessionId\" (ext-result-session-id r) \"sid-1\")\n (check! \"parse-grok-json no error\" (ext-result-error? r) #f))\n(let ([r (parse-grok-json \"{\\\"text\\\":\\\"Hi\\\"}\" \"fallback-sid\")])\n (check! \"parse-grok-json fallback sid\" (ext-result-session-id r) \"fallback-sid\"))\n(let ([r (parse-grok-json \"not json\" \"sid-x\")])\n (check! \"parse-grok-json non-json → raw\" (ext-result-text r) \"not json\")\n (check! \"parse-grok-json non-json sid\" (ext-result-session-id r) \"sid-x\"))\n\n;; ── Agent definitions (core/agent-defs.ss) ────────────────────────\n\n(printf \"~nagent-defs:~n\")\n\n;; Built-ins resolve; unknown doesn't.\n(check! \"builtin agent names\"\n (map agent-def-name (builtin-agent-defs))\n '(\"delegate\" \"doc-explorer\" \"implementer\"))\n(check-pred! \"agent-def-lookup delegate\" (agent-def-lookup \"delegate\") agent-def?)\n(check! \"agent-def-lookup unknown\" (agent-def-lookup \"nope\") #f)\n(check! \"agent-def-lookup non-string\" (agent-def-lookup 42) #f)\n(check! \"delegate scope is none\"\n (agent-def-write-scope (agent-def-lookup \"delegate\")) 'none)\n(check! \"doc-explorer scope\"\n (agent-def-write-scope (agent-def-lookup \"doc-explorer\"))\n '(\"docs/\" \"plans/\"))\n(check! \"implementer scope unrestricted\"\n (agent-def-write-scope (agent-def-lookup \"implementer\")) #f)\n\n;; parse-write-scope normalization.\n(check! \"parse-write-scope none\" (parse-write-scope \"none\") 'none)\n(check! \"parse-write-scope all\" (parse-write-scope \"all\") #f)\n(check! \"parse-write-scope list\" (parse-write-scope '(\"docs/\")) '(\"docs/\"))\n(check! \"parse-write-scope comma string\"\n (parse-write-scope \"src/tetris/, tests/tetris/\")\n '(\"src/tetris/\" \"tests/tetris/\"))\n(check! \"parse-write-scope junk\" (parse-write-scope 17) #f)\n\n;; parse-agent-def: extends-style inheritance + overrides.\n(let* ([spec (let ([h (make-hashtable equal-hash equal?)])\n (hashtable-set! h \"model\" \"test-model\")\n h)]\n [d (parse-agent-def \"delegate-strong\" spec (agent-def-lookup \"delegate\"))])\n (check! \"variant inherits scope\" (agent-def-write-scope d) 'none)\n (check! \"variant overrides model\" (agent-def-model d) \"test-model\")\n (check-pred! \"variant inherits prompt\" (agent-def-prompt d)\n (lambda (p) (and (string? p) (> (string-length p) 0)))))\n(let* ([spec (let ([h (make-hashtable equal-hash equal?)])\n (hashtable-set! h \"write_scope\" \"all\")\n h)]\n [d (parse-agent-def \"doc-all\" spec (agent-def-lookup \"doc-explorer\"))])\n (check! \"write_scope all overrides base\" (agent-def-write-scope d) #f))\n(let ([d (parse-agent-def \"bare\" (make-hashtable equal-hash equal?) #f)])\n (check! \"bare def gets default description\" (agent-def-description d)\n \"user-defined agent\")\n (check! \"bare def unrestricted\" (agent-def-write-scope d) #f))\n\n;; write-scope-allows? matching.\n(check! \"scope #f allows\" (write-scope-allows? #f \"src/x.ss\") #t)\n(check! \"scope none refuses\" (write-scope-allows? 'none \"docs/x.md\") #f)\n(check! \"scope match\" (write-scope-allows? '(\"docs/\" \"plans/\") \"docs/a.md\") #t)\n(check! \"scope exact file match\" (write-scope-allows? '(\"Makefile\") \"Makefile\") #t)\n(check! \"scope boundary blocks sibling prefix\"\n (write-scope-allows? '(\"src/app\") \"src/application/x.ss\") #f)\n(check! \"scope directory without slash allows children\"\n (write-scope-allows? '(\"src/app\") \"src/app/main.ss\") #t)\n(check! \"scope ./ normalized\" (write-scope-allows? '(\"docs/\") \"./docs/a.md\") #t)\n(check! \"scope miss\" (write-scope-allows? '(\"docs/\") \"src/a.ss\") #f)\n(check! \"scope abs path under cwd\"\n (write-scope-allows? '(\"docs/\")\n (string-append (current-directory) \"/docs/a.md\"))\n #t)\n(check! \"scope intersect keeps bounded child\"\n (write-scope-intersect '(\"src\") '(\"src/app\"))\n '(\"src/app\"))\n(check! \"scope intersect rejects sibling prefix\"\n (write-scope-intersect '(\"src/app\") '(\"src/application\"))\n 'none)\n(check-pred! \"strict-ladder builtin skill available\"\n (builtin-skill \"strict-ladder\")\n (lambda (s) (and (string? s) (> (string-length s) 0))))\n(check! \"scope abs path outside cwd\"\n (write-scope-allows? '(\"docs/\") \"/tmp/docs/a.md\") #f)\n(check! \"scope non-string path\" (write-scope-allows? '(\"docs/\") 42) #f)\n\n;; write-scope-intersect: nesting can only narrow.\n(check! \"intersect parent #f\" (write-scope-intersect #f '(\"docs/\")) '(\"docs/\"))\n(check! \"intersect child #f\" (write-scope-intersect '(\"docs/\") #f) '(\"docs/\"))\n(check! \"intersect none wins\" (write-scope-intersect 'none #f) 'none)\n(check! \"intersect narrows\"\n (write-scope-intersect '(\"docs/\" \"plans/\") '(\"docs/modules/\"))\n '(\"docs/modules/\"))\n(check! \"intersect disjoint -> none\"\n (write-scope-intersect '(\"docs/\") '(\"src/\")) 'none)\n\n;; write-scope-error honors the current-write-scope parameter.\n(check! \"scope-error unrestricted\" (write-scope-error \"write\" \"src/x.ss\") #f)\n(parameterize ([current-write-scope '(\"docs/\")])\n (check! \"scope-error inside scope\" (write-scope-error \"write\" \"docs/x.md\") #f)\n (check-pred! \"scope-error outside scope\"\n (write-scope-error \"write\" \"src/x.ss\")\n (lambda (s) (and (string? s) (str-contains? s \"write scope\")))))\n\n;; Context-disabled tools: sub-agents use this to hide task from prompts,\n;; structured schemas, text-tool recovery, and direct execution.\n(init-task-tool)\n(define (schema-by-name schemas wanted)\n (let loop ([xs schemas])\n (cond [(null? xs) #f]\n [else\n (let* ([fn (hashtable-ref (car xs) \"function\" #f)]\n [name (and fn (hashtable-ref fn \"name\" #f))])\n (if (equal? name wanted) (car xs) (loop (cdr xs))))])))\n\n(parameterize ([current-disabled-tools '(\"task\")])\n (check! \"disabled task hidden from list-tools\"\n (and (member \"task\" (list-tools)) #t) #f)\n (check! \"disabled task hidden from tool-exists?\"\n (tool-exists? \"task\") #f)\n (check! \"disabled task hidden from schemas\"\n (let loop ([schemas (get-tool-schemas)])\n (cond [(null? schemas) #f]\n [else\n (let* ([fn (hashtable-ref (car schemas) \"function\" #f)]\n [name (and fn (hashtable-ref fn \"name\" #f))])\n (if (equal? name \"task\") #t (loop (cdr schemas))))]))\n #f)\n (check-pred! \"disabled task execution rejected\"\n (tool-execute \"task\" (args \"description\" \"x\" \"prompt\" \"x\"))\n (lambda (s) (str-contains? s \"unavailable in this context\"))))\n\n(parameterize ([current-tool-allowlist '(\"read\")])\n (check! \"allowlist hides task from list-tools\"\n (and (member \"task\" (list-tools)) #t) #f)\n (check! \"allowlist hides task from tool-exists?\"\n (tool-exists? \"task\") #f)\n (check-pred! \"allowlist execution rejected\"\n (tool-execute \"task\" (args \"description\" \"x\" \"prompt\" \"x\"))\n (lambda (s) (str-contains? s \"unavailable in this context\"))))\n\n(parameterize ([current-compact-tool-schemas #t]\n [current-tool-allowlist '(\"task\")])\n (let* ([schema (schema-by-name (get-tool-schemas) \"task\")]\n [fn (and schema (hashtable-ref schema \"function\" #f))]\n [params (and fn (hashtable-ref fn \"parameters\" #f))]\n [props (and params (hashtable-ref params \"properties\" #f))]\n [desc-prop (and props (hashtable-ref props \"description\" #f))])\n (check! \"compact schema keeps task visible\" (and schema #t) #t)\n (check! \"compact schema omits function description\"\n (hashtable-ref fn \"description\" #f) \"\")\n (check! \"compact schema keeps required args\"\n (hashtable-ref params \"required\" #f)\n '(\"description\" \"prompt\"))\n (check! \"compact schema omits property description\"\n (hashtable-ref desc-prop \"description\" #f) #f)))\n\n(parameterize ([current-compact-agent-context #t])\n (check-pred! \"compact system prompt uses structured schema note\"\n (system-prompt)\n (lambda (s) (str-contains? s \"Structured function tools are available\"))))\n\n;; Task session store: put / resume-shape / eviction cap.\n(task-session-clear!)\n(task-session-put! \"t1\" \"delegate\" '(m1 m2))\n(check-pred! \"task session stored\"\n (hashtable-ref (task-session-store) \"t1\" #f)\n (lambda (v) (and (vector? v)\n (equal? (vector-ref v 1) \"delegate\")\n (equal? (vector-ref v 2) '(m1 m2)))))\n(do ([i 0 (+ i 1)]) ((= i 40))\n (task-session-put! (format \"evict-~a\" i) #f '()))\n(check! \"task session cap evicts oldest\"\n (hashtable-ref (task-session-store) \"t1\" #f) #f)\n(check-pred! \"task session newest survives\"\n (hashtable-ref (task-session-store) \"evict-39\" #f) vector?)\n(task-session-put! \"scoped\" \"implementer\" '(m1) '(\"src/\"))\n(check! \"task session stores write scope\"\n (vector-ref (hashtable-ref (task-session-store) \"scoped\" #f) 3)\n '(\"src/\"))\n(task-session-clear!)\n\n;; Plan-lifecycle builtin skills present.\n(check! \"plan skills builtin\"\n (builtin-skill-list)\n '(\"create-plan\" \"execute-work-package\" \"generate-handover\"\n \"resume-plan\" \"review-plan\" \"save-discoveries\" \"strict-ladder\"))\n(check-pred! \"create-plan prompt mentions plans/\"\n (builtin-skill \"create-plan\")\n (lambda (s) (str-contains? s \"plans/\")))\n\n;; ── Slash-command completion coverage ─────────────────────────────\n;; Every command the TUI dispatcher (handle-slash-command! in tui.ss)\n;; accepts must appear in the completion popup (*slash-commands* in\n;; tui-input.ss). Scans the SOURCE text so adding a new\n;; (equal? cmd \"...\") / (string-prefix? \"... \" cmd) clause without a\n;; completion entry fails the suite.\n\n(define (slurp-file path)\n (call-with-input-file path (lambda (p) (get-string-all p))))\n\n(define (str-find src needle start)\n (let ([nl (string-length needle)] [sl (string-length src)])\n (let loop ([i start])\n (cond\n [(> (+ i nl) sl) #f]\n [(string=? (substring src i (+ i nl)) needle) i]\n [else (loop (+ i 1))]))))\n\n(define (collect-quoted src marker require-cmd-after?)\n ;; For each MARKER occurrence, the text up to the next double-quote.\n ;; With require-cmd-after?, keep only matches whose quote is followed\n ;; by \" cmd)\" -- filters dispatcher clauses from unrelated\n ;; string-prefix? calls.\n (let ([mlen (string-length marker)])\n (let loop ([i 0] [acc '()])\n (let ([hit (str-find src marker i)])\n (if (not hit)\n (reverse acc)\n (let* ([s (+ hit mlen)]\n [q (str-find src \"\\\"\" s)])\n (if (not q)\n (reverse acc)\n (let ([keep? (or (not require-cmd-after?)\n (and (<= (+ q 6) (string-length src))\n (string=? (substring src (+ q 1) (+ q 6))\n \" cmd)\")))])\n (loop (+ q 1)\n (if keep? (cons (substring src s q) acc) acc))))))))))\n\n(define (strip-trailing-space s)\n (let ([n (string-length s)])\n (if (and (> n 0) (char=? (string-ref s (- n 1)) #\\space))\n (substring s 0 (- n 1))\n s)))\n\n(define (dedupe lst)\n (let loop ([l lst] [acc '()])\n (cond\n [(null? l) (reverse acc)]\n [(member (car l) acc) (loop (cdr l) acc)]\n [else (loop (cdr l) (cons (car l) acc))])))\n\n(let* ([tui-src (slurp-file \"src/jcode/ui/tui.ss\")]\n [input-src (slurp-file \"src/jcode/ui/tui-input.ss\")]\n [dispatcher (dedupe\n (map strip-trailing-space\n (append\n (collect-quoted tui-src \"(equal? cmd \\\"\" #f)\n (collect-quoted tui-src \"(string-prefix? \\\"\" #t))))]\n [completions (collect-quoted input-src \"(\\\"/\" #f)])\n (check-pred! \"dispatcher commands found by source scan\"\n dispatcher\n (lambda (d) (> (length d) 30)))\n (for-each\n (lambda (cmd)\n (check-pred! (format \"completion popup has /~a\" cmd)\n completions\n (lambda (cs) (and (member cmd cs) #t))))\n dispatcher))\n\n;; ── Results ───────────────────────────────────────────────────────\n\n(printf \"~n~a passed, ~a failed~n\" pass-count fail-count)\n(when (> fail-count 0) (exit 1))\n"} --- a/cpt_corpus_v6_suggestions.jsonl +++ b/cpt_corpus_v6_suggestions.jsonl @@ -121,7 +121,7 @@ {"text":";; FILE: jerboa-coreutils/src/jerboa-coreutils/common/io.ss\n;;; common/io.ss -- File and line processing utilities\n;;;\n;;; Security: Uses audit logging for file access when available.\n;;; Validates paths against NUL injection and path traversal.\n\n(export\n process-files\n for-each-line\n read-line/delim\n write-line/delim\n safe-open-input-file)\n\n(import :jerboa-coreutils/common\n :jerboa-coreutils/common/security\n :std/sugar)\n\n\n;; Validate that a path contains no NUL bytes (injection prevention)\n(define (validate-path! path who)\n (let loop ((i 0))\n (when (< i (string-length path))\n (when (char=? (string-ref path i) #\\nul)\n (die \"~a: path contains NUL byte\" who))\n (loop (+ i 1)))))\n\n;; Open a file with error handling and audit; returns port or calls die\n(define (safe-open-input-file path)\n (validate-path! path path)\n (audit-file-access! path)\n (with-catch\n (lambda (e)\n (die \"~a: No such file or directory\" path))\n (lambda ()\n (open-input-file path))))\n\n;; Process a list of files (or stdin if empty/\"-\")\n;; proc is called with an input port for each file\n(define (process-files files proc)\n (if (or (null? files) (equal? files '(\"-\")))\n (proc (current-input-port))\n (for-each\n (lambda (f)\n (if (equal? f \"-\")\n (proc (current-input-port))\n (let ((port (safe-open-input-file f)))\n (dynamic-wind\n (lambda () (void))\n (lambda () (proc port))\n (lambda () (close-input-port port))))))\n files)))\n\n;; Call proc on each line read from port\n(define (for-each-line port proc)\n (let loop ()\n (let ((line (get-line port)))\n (unless (eof-object? line)\n (proc line)\n (loop)))))\n\n;; Read until delimiter character (for NUL support)\n(define (read-line/delim port delim)\n (if (char=? delim #\\newline)\n (get-line port)\n (let ((out (open-output-string)))\n (let loop ()\n (let ((c (read-char port)))\n (cond\n ((eof-object? c)\n (let ((s (get-output-string out)))\n (if (string=? s \"\") c s)))\n ((char=? c delim)\n (get-output-string out))\n (else\n (write-char c out)\n (loop))))))))\n\n;; Write line with delimiter\n(define (write-line/delim line delim)\n (display line)\n (write-char delim))\n"} {"text":";; FILE: jerboa-coreutils/src/jerboa-coreutils/common/security.ss\n;;; common/security.ss -- Shared security infrastructure for jerboa-coreutils\n;;;\n;;; Centralizes security integration so individual commands can opt-in\n;;; to Landlock, seccomp, capabilities, audit logging, and taint tracking\n;;; with minimal boilerplate.\n\n(export\n ;; Seccomp profiles (pre-built for coreutils use cases)\n install-readonly-seccomp!\n install-io-seccomp!\n install-process-seccomp!\n\n ;; Landlock presets\n install-proc-only-landlock!\n install-readonly-landlock!\n install-readwrite-landlock!\n\n ;; Capability enforcement\n with-fs-read-capability\n with-fs-write-capability\n with-process-capability\n check-fs-read!\n check-fs-write!\n\n ;; Audit logging\n coreutils-audit-logger\n audit-file-access!\n audit-file-modify!\n audit-file-delete!\n audit-process-spawn!\n audit-process-signal!\n\n ;; Taint helpers\n taint-argv-path\n untaint-after-sanitize\n\n ;; Path sanitization (re-export from std)\n sanitize-path\n safe-path-join/checked\n\n ;; Secret wiping\n with-sensitive-buffer\n\n ;; Combined security initialization\n init-security!\n security-available?)\n\n(import (only-in :std/sugar with-catch)\n (only-in :std/format eprintf))\n\n\n;; ========== Feature Detection ==========\n;; Gracefully degrade when security modules aren't available or\n;; when the kernel doesn't support the feature.\n\n(define *seccomp-available* #f)\n(define *landlock-available* #f)\n(define *audit-logger* #f)\n\n(define (security-available?)\n (or *seccomp-available* *landlock-available*))\n\n;; ========== Lazy Loading ==========\n;; We use dynamic loading so the security modules are optional.\n;; If jerboa stdlib isn't available, security features silently degrade.\n\n;; --- Seccomp ---\n\n(define seccomp-install-proc #f)\n(define seccomp-make-filter-proc #f)\n(define seccomp-kill-action #f)\n\n(define (load-seccomp!)\n (with-catch\n (lambda (e) (set! *seccomp-available* #f))\n (lambda ()\n (let ((env (environment '(std security seccomp))))\n (set! seccomp-install-proc (eval 'seccomp-install! env))\n (set! seccomp-make-filter-proc (eval 'make-seccomp-filter env))\n (set! seccomp-kill-action (eval 'seccomp-kill env))\n (set! *seccomp-available*\n ((eval 'seccomp-available? env)))))))\n\n;; Syscall lists for different profiles\n(define readonly-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group))\n\n(define io-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group\n ;; File modification\n rename mkdir rmdir creat link unlink\n ftruncate))\n\n(define process-syscalls\n '(read write close fstat mmap mprotect munmap brk\n rt_sigaction rt_sigprocmask rt_sigreturn\n futex nanosleep getrandom arch_prctl set_tid_address\n set_robust_list sched_yield sigaltstack\n clock_gettime prctl prlimit64 rseq close_range\n openat newfstatat getdents access getcwd fcntl\n ioctl exit_group\n ;; Process management\n clone fork execve wait4 kill getpid getppid))\n\n(define (install-readonly-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n readonly-syscalls))))))\n\n(define (install-io-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n io-syscalls))))))\n\n(define (install-process-seccomp!)\n (when *seccomp-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: seccomp install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (seccomp-install-proc\n (apply seccomp-make-filter-proc seccomp-kill-action\n process-syscalls))))))\n\n;; --- Landlock ---\n\n(define landlock-make-ruleset-proc #f)\n(define landlock-add-read-only-proc #f)\n(define landlock-add-read-write-proc #f)\n(define landlock-add-execute-proc #f)\n(define landlock-install-proc #f)\n\n(define (load-landlock!)\n (with-catch\n (lambda (e) (set! *landlock-available* #f))\n (lambda ()\n (let ((env (environment '(std security landlock))))\n (set! landlock-make-ruleset-proc (eval 'make-landlock-ruleset env))\n (set! landlock-add-read-only-proc (eval 'landlock-add-read-only! env))\n (set! landlock-add-read-write-proc (eval 'landlock-add-read-write! env))\n (set! landlock-add-execute-proc (eval 'landlock-add-execute! env))\n (set! landlock-install-proc (eval 'landlock-install! env))\n (set! *landlock-available*\n ((eval 'landlock-available? env)))))))\n\n(define (install-proc-only-landlock!)\n ;; Restrict to /proc, /sys, /dev/null, /dev/tty (for top, uptime, etc.)\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (landlock-add-read-only-proc rs \"/proc\" \"/sys\" \"/dev\" \"/etc\"\n \"/usr/lib\" \"/lib\")\n (landlock-install-proc rs))))))\n\n(define (install-readonly-landlock! . paths)\n ;; Restrict to reading only the specified paths + /proc, /dev, /etc, system libs\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (apply landlock-add-read-only-proc rs\n \"/proc\" \"/sys\" \"/dev\" \"/etc\" \"/usr/lib\" \"/lib\"\n paths)\n (landlock-install-proc rs))))))\n\n(define (install-readwrite-landlock! read-paths write-paths)\n ;; Read access to read-paths, read+write to write-paths\n (when *landlock-available*\n (with-catch\n (lambda (e)\n (eprintf \"warning: landlock install failed: ~a~n\"\n (if (message-condition? e) (condition-message e) e)))\n (lambda ()\n (let ((rs (landlock-make-ruleset-proc)))\n (apply landlock-add-read-only-proc rs\n \"/proc\" \"/sys\" \"/dev\" \"/etc\" \"/usr/lib\" \"/lib\"\n read-paths)\n (apply landlock-add-read-write-proc rs write-paths)\n (landlock-install-proc rs))))))\n\n;; --- Capabilities ---\n\n(define *current-capabilities* (make-parameter '()))\n\n(define-syntax with-fs-read-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'fs-read (*current-capabilities*))])\n body ...)]))\n\n(define-syntax with-fs-write-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'fs-write (*current-capabilities*))])\n body ...)]))\n\n(define-syntax with-process-capability\n (syntax-rules ()\n [(_ body ...)\n (parameterize ([*current-capabilities*\n (cons 'process (*current-capabilities*))])\n body ...)]))\n\n(define (check-fs-read!)\n (unless (memq 'fs-read (*current-capabilities*))\n (error 'check-fs-read! \"filesystem read capability not granted\")))\n\n(define (check-fs-write!)\n (unless (memq 'fs-write (*current-capabilities*))\n (error 'check-fs-write! \"filesystem write capability not granted\")))\n\n;; --- Audit Logging ---\n\n(define audit-make-logger-proc #f)\n(define audit-log-proc #f)\n\n(define (load-audit!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security audit))))\n (set! audit-make-logger-proc (eval 'make-audit-logger env))\n (set! audit-log-proc (eval 'audit-log! env))\n ;; Initialize logger if env var is set\n (let ((log-path (getenv \"COREUTILS_AUDIT_LOG\")))\n (when (and log-path (> (string-length log-path) 0))\n (set! *audit-logger*\n (audit-make-logger-proc log-path))))))))\n\n(define (coreutils-audit-logger)\n *audit-logger*)\n\n(define (audit-file-access! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-access\n 'resource: path)))))\n\n(define (audit-file-modify! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-modify\n 'resource: path)))))\n\n(define (audit-file-delete! path)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'file-delete\n 'resource: path)))))\n\n(define (audit-process-spawn! cmd)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'process-spawn\n 'command: cmd)))))\n\n(define (audit-process-signal! pid sig)\n (when (and *audit-logger* audit-log-proc)\n (with-catch (lambda (e) (void))\n (lambda ()\n (audit-log-proc *audit-logger* 'process-signal\n 'pid: (number->string pid)\n 'signal: (number->string sig))))))\n\n;; --- Taint Tracking ---\n\n(define taint-file-proc #f)\n(define untaint-proc #f)\n(define check-untainted-proc #f)\n\n(define (load-taint!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security taint))))\n (set! taint-file-proc (eval 'taint-file env))\n (set! untaint-proc (eval 'untaint env))\n (set! check-untainted-proc (eval 'check-untainted! env))))))\n\n(define (taint-argv-path path)\n ;; Mark a path from command-line arguments as file-input tainted\n (if taint-file-proc\n (taint-file-proc path)\n path))\n\n(define (untaint-after-sanitize value)\n ;; Remove taint after validation/sanitization\n (if untaint-proc\n (untaint-proc value)\n value))\n\n;; --- Path Sanitization ---\n\n(define sanitize-path-proc #f)\n\n(define (load-sanitize!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security sanitize))))\n (set! sanitize-path-proc (eval 'sanitize-path env))))))\n\n(define (sanitize-path path)\n ;; Canonicalize path and reject traversal attempts\n (if sanitize-path-proc\n (sanitize-path-proc path)\n path))\n\n(define (safe-path-join/checked base relative)\n ;; Join paths with traversal protection\n (let ((joined (string-append base \"/\" relative)))\n ;; Validate no NUL bytes\n (let check ((i 0))\n (when (< i (string-length relative))\n (when (char=? (string-ref relative i) #\\nul)\n (error 'safe-path-join/checked \"NUL byte in path\"))\n (check (+ i 1))))\n ;; Validate no escape via ..\n (let ((sanitized (sanitize-path joined)))\n (let ((blen (string-length base)))\n (if (and (>= (string-length sanitized) blen)\n (string=? (substring sanitized 0 blen) base))\n sanitized\n (error 'safe-path-join/checked\n \"path traversal detected\" relative))))))\n\n;; --- Secret Wiping ---\n\n(define wipe-bv-proc #f)\n\n(define (load-secret!)\n (with-catch\n (lambda (e) (void))\n (lambda ()\n (let ((env (environment '(std security secret))))\n (set! wipe-bv-proc (eval 'wipe-bytevector! env))))))\n\n(define-syntax with-sensitive-buffer\n (syntax-rules ()\n [(_ ([name size]) body ...)\n (let ([name (make-bytevector size 0)])\n (dynamic-wind\n (lambda () (void))\n (lambda () body ...)\n (lambda ()\n ;; Zero the buffer on scope exit\n (let loop ([i 0])\n (when (< i (bytevector-length name))\n (bytevector-u8-set! name i 0)\n (loop (+ i 1)))))))]))\n\n;; --- Combined Initialization ---\n\n(define (init-security!)\n ;; Load all security modules. Call once at startup.\n ;; Failures are silently ignored — security degrades gracefully.\n (load-seccomp!)\n (load-landlock!)\n (load-audit!)\n (load-taint!)\n (load-sanitize!)\n (load-secret!))\n"} {"text":";; FILE: jerboa-sed/main.ss\n#!chezscheme\n;;; Sed main entry point and file processing\n\n(import (except (chezscheme) compile-program) (sed ast) (sed parser) (sed engine))\n\n(define (main args)\n (guard (e [else\n (display \"sed: \" (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n (exit 1)])\n (run-sed args)))\n\n(define (run-sed args)\n (let-values ([(scripts files suppress? extended? in-place-suffix\n sandbox? null-data? separate?)\n (parse-args args)])\n (when (null? scripts)\n (display \"sed: no script\\nTry 'jsed --help' for more information.\\n\"\n (current-error-port))\n (exit 1))\n (let* ([full-script (string-join-sep scripts \"\\n\")]\n [parsed-cmds (parse-sed-script full-script extended?)]\n [prog (compile-program parsed-cmds)]\n [state (make-initial-sed-state suppress? extended?\n sandbox? null-data? separate?)])\n (if in-place-suffix\n (process-in-place state prog files in-place-suffix)\n (process-files state prog files (current-output-port))))))\n\n;;; Argument parsing\n\n(define (parse-args args)\n (let loop ([args args]\n [scripts '()]\n [files '()]\n [suppress? #f]\n [extended? #f]\n [in-place #f]\n [sandbox? #f]\n [null-data? #f]\n [separate? #f])\n (if (null? args)\n (values (reverse scripts) (reverse files)\n suppress? extended? in-place sandbox? null-data? separate?)\n (let ([arg (car args)] [rest (cdr args)])\n (cond\n [(string=? arg \"--\")\n (loop '() scripts (append (reverse rest) files)\n suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--quiet\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--silent\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(or (string=? arg \"--regexp-extended\") (string=? arg \"-E\") (string=? arg \"-r\"))\n (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)]\n [(string=? arg \"--sandbox\")\n (loop rest scripts files suppress? extended? in-place #t null-data? separate?)]\n [(or (string=? arg \"--null-data\") (string=? arg \"-z\"))\n (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)]\n [(or (string=? arg \"--separate\") (string=? arg \"-s\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)]\n [(or (string=? arg \"--posix\") (string=? arg \"--follow-symlinks\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--in-place\")\n (loop rest scripts files suppress? extended? \"\" sandbox? null-data? separate?)]\n [(string-prefix? \"--in-place=\" arg)\n (loop rest scripts files suppress? extended?\n (substring arg 11 (string-length arg))\n sandbox? null-data? separate?)]\n [(string-prefix? \"--expression=\" arg)\n (loop rest (cons (substring arg 13 (string-length arg)) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string-prefix? \"--file=\" arg)\n (loop rest (cons (read-script-file (substring arg 7 (string-length arg))) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--help\")\n (display-help)\n (exit 0)]\n [(string=? arg \"--version\")\n (display \"jsed (jerboa-sed) 0.1.0\\n\")\n (exit 0)]\n [(and (fx> (string-length arg) 1) (char=? (string-ref arg 0) #\\-))\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?\n (substring arg 1 (string-length arg)))]\n [(null? scripts)\n (loop rest (list arg) files suppress? extended? in-place sandbox? null-data? separate?)]\n [else\n (loop rest scripts (cons arg files)\n suppress? extended? in-place sandbox? null-data? separate?)])))))\n\n(define (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? opts)\n (if (string=? opts \"\")\n (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? separate? \"\")\n (let ([c (string-ref opts 0)]\n [tail (substring opts 1 (string-length opts))])\n (case c\n [(#\\n)\n (re-parse rest scripts files #t extended? in-place sandbox? null-data? separate? tail)]\n [(#\\E #\\r)\n (re-parse rest scripts files suppress? #t in-place sandbox? null-data? separate? tail)]\n [(#\\s)\n (re-parse rest scripts files suppress? extended? in-place sandbox? null-data? #t tail)]\n [(#\\z)\n (re-parse rest scripts files suppress? extended? in-place sandbox? #t separate? tail)]\n [(#\\e)\n (if (string=? tail \"\")\n (if (null? rest)\n (begin\n (display \"sed: option requires an argument -- 'e'\\n\" (current-error-port))\n (exit 1))\n (re-parse (cdr rest) (cons (car rest) scripts) files suppress? extended? in-place\n sandbox? null-data? separate? \"\"))\n (re-parse rest (cons tail scripts) files suppress? extended? in-place\n sandbox? null-data? separate? \"\"))]\n [(#\\f)\n (if (string=? tail \"\")\n (if (null? rest)\n (begin\n (display \"sed: option requires an argument -- 'f'\\n\" (current-error-port))\n (exit 1))\n (re-parse (cdr rest) (cons (read-script-file (car rest)) scripts) files\n suppress? extended? in-place sandbox? null-data? separate? \"\"))\n (re-parse rest (cons (read-script-file tail) scripts) files\n suppress? extended? in-place sandbox? null-data? separate? \"\"))]\n [(#\\i)\n (re-parse rest scripts files suppress? extended? tail\n sandbox? null-data? separate? \"\")]\n [else\n (display (string-append \"sed: invalid option -- '\" (string c) \"'\\n\")\n (current-error-port))\n (exit 1)]))))\n\n(define (re-parse rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? remaining-opts)\n (if (string=? remaining-opts \"\")\n (parse-args-continue rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?)\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate? remaining-opts)))\n\n(define (parse-args-continue rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?)\n (let loop ([args rest]\n [scripts scripts]\n [files files]\n [suppress? suppress?]\n [extended? extended?]\n [in-place in-place]\n [sandbox? sandbox?]\n [null-data? null-data?]\n [separate? separate?])\n (if (null? args)\n (values (reverse scripts) (reverse files)\n suppress? extended? in-place sandbox? null-data? separate?)\n (let ([arg (car args)] [rest (cdr args)])\n (cond\n [(string=? arg \"--\")\n (loop '() scripts (append (reverse rest) files)\n suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--quiet\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--silent\")\n (loop rest scripts files #t extended? in-place sandbox? null-data? separate?)]\n [(or (string=? arg \"--regexp-extended\") (string=? arg \"-E\") (string=? arg \"-r\"))\n (loop rest scripts files suppress? #t in-place sandbox? null-data? separate?)]\n [(string=? arg \"--sandbox\")\n (loop rest scripts files suppress? extended? in-place #t null-data? separate?)]\n [(or (string=? arg \"--null-data\") (string=? arg \"-z\"))\n (loop rest scripts files suppress? extended? in-place sandbox? #t separate?)]\n [(or (string=? arg \"--separate\") (string=? arg \"-s\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? #t)]\n [(or (string=? arg \"--posix\") (string=? arg \"--follow-symlinks\"))\n (loop rest scripts files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--in-place\")\n (loop rest scripts files suppress? extended? \"\" sandbox? null-data? separate?)]\n [(string-prefix? \"--in-place=\" arg)\n (loop rest scripts files suppress? extended?\n (substring arg 11 (string-length arg)) sandbox? null-data? separate?)]\n [(string-prefix? \"--expression=\" arg)\n (loop rest (cons (substring arg 13 (string-length arg)) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string-prefix? \"--file=\" arg)\n (loop rest (cons (read-script-file (substring arg 7 (string-length arg))) scripts)\n files suppress? extended? in-place sandbox? null-data? separate?)]\n [(string=? arg \"--help\") (display-help) (exit 0)]\n [(string=? arg \"--version\") (display \"jsed (jerboa-sed) 0.1.0\\n\") (exit 0)]\n [(and (fx> (string-length arg) 1) (char=? (string-ref arg 0) #\\-))\n (parse-short rest scripts files suppress? extended? in-place\n sandbox? null-data? separate?\n (substring arg 1 (string-length arg)))]\n [(null? scripts)\n (loop rest (list arg) files suppress? extended? in-place sandbox? null-data? separate?)]\n [else\n (loop rest scripts (cons arg files)\n suppress? extended? in-place sandbox? null-data? separate?)])))))\n\n(define (read-script-file filename)\n (guard (e [else\n (display (string-append \"sed: can't read \" filename \"\\n\")\n (current-error-port))\n (exit 1)])\n (call-with-input-file filename\n (lambda (port)\n (let loop ([lines '()])\n (let ([line (get-line port)])\n (if (eof-object? line)\n (string-join-sep (reverse lines) \"\\n\")\n (loop (cons line lines)))))))))\n\n(define (display-help)\n (display \"Usage: jsed [OPTION]... {script-only-if-no-other-script} [input-file]...\n\n -n, --quiet, --silent\n suppress automatic printing of pattern space\n -e script, --expression=script\n add the script to the commands to be executed\n -f script-file, --file=script-file\n add the contents of script-file to the commands to be executed\n -E, -r, --regexp-extended\n use extended regular expressions in the script\n -i[SUFFIX], --in-place[=SUFFIX]\n edit files in-place (makes backup if SUFFIX supplied)\n -s, --separate\n consider files as separate rather than as a single continuous stream\n -z, --null-data\n separate lines by NUL characters\n --sandbox operate in sandbox mode\n --help display this help and exit\n --version output version information and exit\n\n\"))\n\n;;; File processing\n\n(define (read-line-or-eof port)\n (let ([line (get-line port)])\n (if (eof-object? line) 'eof line)))\n\n(define (open-file-or-stdin filename)\n (if (string=? filename \"-\")\n (current-input-port)\n (guard (e [else\n (display (string-append \"sed: \" filename \": \")\n (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n #f])\n (open-input-file filename))))\n\n(define (process-files state prog files out-port)\n (let* ([file-list (if (null? files) '(\"-\") files)]\n [n (length file-list)])\n (if (sed-state-separate? state)\n (let loop ([lst file-list])\n (unless (null? lst)\n (sed-state-line-num-set! state 0)\n (sed-state-sub-succeeded?-set! state #f)\n (process-one-file! state prog (car lst) #t out-port)\n (loop (cdr lst))))\n (let loop ([lst file-list] [i 0])\n (unless (null? lst)\n (process-one-file! state prog (car lst) (fx= i (fx- n 1)) out-port)\n (loop (cdr lst) (fx+ i 1)))))))\n\n(define (process-one-file! state prog filename is-last-file? out-port)\n (sed-state-filename-set! state filename)\n (let ([port (open-file-or-stdin filename)])\n (when port\n (let ([first (read-line-or-eof port)])\n (unless (eq? first 'eof)\n (let ([nxt (box (read-line-or-eof port))])\n (let main-loop ([cur first])\n (unless (eq? cur 'eof)\n (sed-state-line-num-set! state (fx+ (sed-state-line-num state) 1))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state cur)\n (sed-state-sub-succeeded?-set! state #f)\n (let cycle-loop ([start-pc 0])\n (let ([sig (run-sed-cycle-from! state prog out-port start-pc)])\n (cond\n [(eq? sig 'next)\n (let ([new-cur (unbox nxt)])\n (unless (eq? new-cur 'eof)\n (set-box! nxt (read-line-or-eof port)))\n (main-loop new-cur))]\n [(eq? sig 'restart)\n (cycle-loop 0)]\n [(and (pair? sig) (eq? (car sig) 'append-next))\n (let ([resume-pc (fx+ (cdr sig) 1)]\n [next-line (unbox nxt)])\n (if (eq? next-line 'eof)\n (begin\n (unless (sed-state-suppress? state)\n (put-string out-port (sed-state-pattern-space state))\n (newline out-port))\n (flush-append-queue! state out-port))\n (begin\n (sed-state-line-num-set! state\n (fx+ (sed-state-line-num state) 1))\n (set-box! nxt (read-line-or-eof port))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state\n (string-append (sed-state-pattern-space state)\n \"\\n\" next-line))\n (cycle-loop resume-pc))))]\n [(and (pair? sig) (eq? (car sig) 'read-next))\n (let ([resume-pc (fx+ (cdr sig) 1)]\n [next-line (unbox nxt)])\n (unless (eq? next-line 'eof)\n (sed-state-line-num-set! state\n (fx+ (sed-state-line-num state) 1))\n (set-box! nxt (read-line-or-eof port))\n (sed-state-last-line?-set! state\n (and (eq? (unbox nxt) 'eof) is-last-file?))\n (sed-state-pattern-space-set! state next-line)\n (sed-state-sub-succeeded?-set! state #f)\n (cycle-loop resume-pc)))]\n [(and (pair? sig) (eq? (car sig) 'quit))\n (unless (string=? filename \"-\")\n (close-input-port port))\n (exit (cdr sig))]\n [else\n (let ([new-cur (unbox nxt)])\n (unless (eq? new-cur 'eof)\n (set-box! nxt (read-line-or-eof port)))\n (main-loop new-cur))]))))))))\n (when (and port (not (string=? filename \"-\")))\n (close-input-port port)))))\n\n;;; In-place editing\n\n(define (process-in-place state prog files suffix)\n (when (null? files)\n (display \"sed: no input files for in-place editing\\n\" (current-error-port))\n (exit 1))\n (for-each\n (lambda (filename)\n (unless (string=? filename \"-\")\n (let ([tmp (string-append filename \".jsed-tmp\")])\n (guard (e [else\n (display (string-append \"sed: \" filename \": \")\n (current-error-port))\n (display-condition e (current-error-port))\n (newline (current-error-port))\n (when (file-exists? tmp) (delete-file tmp))])\n (let ([out-port (open-file-output-port tmp\n (file-options no-fail)\n (buffer-mode block)\n (make-transcoder (utf-8-codec)))])\n (process-one-file! state prog filename #t out-port)\n (close-port out-port))\n (when (and suffix (not (string=? suffix \"\")))\n (rename-file filename (string-append filename suffix)))\n (rename-file tmp filename)))))\n files))\n\n;;; Utilities\n\n(define (string-prefix? prefix str)\n (let ([plen (string-length prefix)])\n (and (fx<= plen (string-length str))\n (string=? prefix (substring str 0 plen)))))\n\n(define (string-join-sep strs sep)\n (if (null? strs) \"\"\n (let loop ([rest (cdr strs)] [acc (car strs)])\n (if (null? rest) acc\n (loop (cdr rest) (string-append acc sep (car rest)))))))\n\n;;; Entry point\n\n(main (cdr (command-line)))\n"} -{"text":";; FILE: jerboa-sed/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-sed/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-sed/.jerboa/security.json\n{\n \"version\": 1,\n \"repo\": \"jerboa-sed\",\n \"extends\": [\"jerboa:cli\", \"jerboa:parser\"],\n \"paths\": {\n \"production\": [\"*.ss\", \"*.sls\", \"lib/**/*.ss\", \"lib/**/*.sls\", \"src/**/*.ss\", \"src/**/*.sls\", \"bin/**\", \"Makefile\"],\n \"tests\": [\"test/**\", \"tests/**\", \"**/*-test.ss\"],\n \"generated\": [\"build/**\", \"dist/**\", \"target/**\"],\n \"vendor\": [\"vendor/**\", \"third_party/**\"],\n \"docs\": [\"README.md\", \"docs/**\", \"*.md\", \"AGENTS.md\"]\n },\n \"policy\": {\n \"failOn\": [\"critical\", \"high\"],\n \"imports\": { \"directChezscheme\": \"deny\" },\n \"ffi\": { \"allowed\": false },\n \"process\": { \"shellInterpolation\": \"deny\" },\n \"network\": { \"requireTimeouts\": false },\n \"eval\": { \"stringEval\": \"deny\", \"bareRead\": \"deny\", \"allowReadEval\": false },\n \"parser\": { \"requireLimits\": true }\n },\n \"suppressions\": []\n}\n"} {"text":";; FILE: jerboa-awk/AGENTS.md\n# AGENTS.md for jerboa-$app Repositories\n\nThese instructions apply to agents working in this repository.\n\n## Language: Jerboa ONLY\n\nAll code in any `jerboa-*` directory or repository must be written in **Jerboa**\n— `.ss` files using `(jerboa prelude)`, `def`, `defstruct`, the Jerboa reader\nextras (`[...]` lists, `{...}` method dispatch, `keyword:` args), and\n`(std ...)` modules. The Jerboa toolchain compiles `.ss` → `.sls`.\n\nNever write raw Chez `.sls` files with `#!chezscheme` + R6RS\n`define`/`define-record-type`/`(library ...)` forms, and never write the\napplication logic in another language (shell, Python, Rust, etc.) — that\nbypasses Jerboa entirely and defeats the purpose of these repos.\n\n## Build Contract\n\nThe Makefile must provide these targets:\n\n- `make` prints the available targets. It must not build, install, test, or mutate artifacts.\n- `make binary` builds the application binary for the local host OS and architecture.\n- `make linux-amd64` cross-builds the Linux amd64 binary from the current host.\n- `make linux-arm64` cross-builds the Linux arm64 binary from the current host.\n- `make freebsd-amd64` cross-builds the FreeBSD amd64 binary from the current host.\n\nThe cross-build targets must use the local cross toolchains and Jerboa/Chez\ncross-build setup. Never use Docker or Podman for building, testing, smoke\ntesting, packaging, or verifying these targets.\n\n## Required Verification\n\nBefore committing or pushing any code, all required build targets must succeed:\n\n```sh\nmake\nmake binary\nmake linux-amd64\nmake linux-arm64\nmake freebsd-amd64\n```\n\nDo not commit or push if any target fails. If a cross-build cannot run because\nthe host is missing a required toolchain or sysroot, stop and report the missing\ndependency instead of committing or pushing partially verified code.\n\n## Working Rules\n\n- Keep changes inside the current repository unless the user explicitly names another path.\n- Preserve the target semantics above when editing the Makefile.\n- Treat the cross-build targets as release-critical, not optional follow-up work.\n- Do not add Dockerfiles, container scripts, Podman invocations, or container-based verification paths.\n"} {"text":";; FILE: jerboa-awk/bin/jawk-program.ss\n#!chezscheme\n;;;; jawk — AWK interpreter entry point (for binary compilation).\n;;;;\n;;;; jerbuild's main.c runs this file as a program: the top-level forms\n;;;; execute and (command-line-arguments) holds argv[1..]. (No scheme-start\n;;;; hook fires under jerbuild, so call main directly.)\n\n(import (chezscheme) (jerboa-awk main))\n\n(suppress-greeting #t)\n\n(main (command-line-arguments))\n"} @@ -277,7 +277,7 @@ {"text":";; FILE: jerboa-shell/lineedit.ss\n;;; lineedit.ss — Terminal line editor for gsh\n;;; Custom line editor with emacs/vi modes, history, search, kill ring.\n\n(export #t)\n(import :std/sugar\n :std/format\n (only (std misc string) string-contains)\n :jsh/util\n :jsh/history\n :jsh/ffi\n (only (compat gambit) tty-mode-set!))\n\n;;; --- fzf callback hooks (set by fzf.ss at startup) ---\n;;; These are set to actual functions after fzf.ss loads.\n;;; Initialized to make-parameter so the compiler sees them as procedures.\n(def *fzf-history-fn* (make-parameter #f)) ;; parameter: (lambda (commands) -> string or #f) or #f\n(def *fzf-files-fn* (make-parameter #f)) ;; parameter: (lambda () -> string or #f) or #f\n(def *fzf-dirs-fn* (make-parameter #f)) ;; parameter: (lambda () -> string or #f) or #f\n\n;;; --- Constants ---\n\n(def ESC #\\escape)\n(def ESC-BYTE 27)\n(def CTRL-A 1)\n(def CTRL-B 2)\n(def CTRL-C 3)\n(def CTRL-D 4)\n(def CTRL-E 5)\n(def CTRL-F 6)\n(def CTRL-G 7)\n(def CTRL-H 8)\n(def CTRL-K 11)\n(def CTRL-L 12)\n(def CTRL-N 14)\n(def CTRL-P 16)\n(def CTRL-R 18)\n(def CTRL-S 19)\n(def CTRL-T 20)\n(def CTRL-U 21)\n(def CTRL-W 23)\n(def CTRL-Y 25)\n(def CTRL-Z 26)\n(def CTRL-UNDERSCORE 31)\n(def TAB-KEY 9)\n(def ENTER-KEY 13)\n(def NEWLINE-KEY 10)\n\n(def (enter-key? key)\n (and (char? key)\n (let ([code (char->integer key)])\n (or (= code ENTER-KEY) (= code NEWLINE-KEY)))))\n(def BACKSPACE 127)\n\n;;; --- Editor state ---\n\n(defstruct line-state\n (buffer ;; string: current line content\n cursor ;; integer: cursor position in buffer\n prompt ;; string: display prompt\n prompt-width ;; integer: visible width of last line of prompt\n prompt-lines ;; integer: number of newlines in prompt (cached)\n history-index ;; integer or #f: current history position\n saved-line ;; string: saved current line before history nav\n kill-ring ;; list of strings\n undo-stack ;; list of (buffer . cursor) pairs\n search-mode ;; #f, 'reverse, or 'forward\n search-string ;; string: current search query\n search-result ;; string or #f: matched history entry\n columns ;; integer: terminal width\n multiline? ;; boolean: whether to support multiline\n mode ;; 'emacs or 'vi\n vi-mode ;; 'insert or 'command (only for vi mode)\n complete-fn ;; completion callback or #f\n done? ;; boolean: editing complete\n result ;; string or 'eof: final result\n )\n transparent: #t)\n\n;;; --- Terminal I/O ---\n\n(def (term-raw! port)\n ;; Set terminal to raw mode: char-at-a-time, no echo, no signal processing\n ;; Args: port input-allow-special input-echo input-raw output-raw speed\n ;; Must use Gambit's tty-mode-set! exclusively — calling tcsetattr via FFI\n ;; desynchronizes Gambit's cached terminal state and breaks read-char.\n (tty-mode-set! port #f #f #t #t 0))\n\n(def (term-cooked! port)\n ;; Restore terminal to cooked mode: canonical, echo\n (tty-mode-set! port #t #t #f #f 0))\n\n;; Write ANSI escape sequences\n(def ESC-STR (string #\\escape))\n\n;; Cursor hide/show — used to prevent visible flicker during line redraws\n(def CURSOR-HIDE (string-append ESC-STR \"[?25l\"))\n(def CURSOR-SHOW (string-append ESC-STR \"[?25h\"))\n\n(def (term-move-cursor-col col port)\n (fprintf port \"\\r~a[~aC\" ESC-STR (+ col 1)))\n\n(def (term-clear-to-eol port)\n (display (string-append ESC-STR \"[K\") port))\n\n(def (term-clear-line port)\n (display (string-append \"\\r\" ESC-STR \"[K\") port))\n\n(def (term-clear-screen port)\n (display (string-append ESC-STR \"[H\" ESC-STR \"[2J\") port))\n\n(def (term-move-up n port)\n (when (> n 0)\n (fprintf port \"~a[~aA\" ESC-STR n)))\n\n(def (term-move-down n port)\n (when (> n 0)\n (fprintf port \"~a[~aB\" ESC-STR n)))\n\n(def (term-cursor-forward n port)\n (when (> n 0)\n (fprintf port \"~a[~aC\" ESC-STR n)))\n\n(def (term-cursor-back n port)\n (when (> n 0)\n (fprintf port \"~a[~aD\" ESC-STR n)))\n\n;;; --- Terminal size ---\n\n(def *terminal-columns* 80)\n\n(def (get-terminal-columns)\n *terminal-columns*)\n\n(def (set-terminal-columns! cols)\n (set! *terminal-columns* cols))\n\n(def (detect-terminal-columns)\n (let ([cols (ffi-terminal-columns 0)])\n ;; Fallback to 80 if detection fails\n (if (or (not cols) (= cols 0))\n 80\n cols)))\n\n;;; --- Read input bytes ---\n\n(def (read-key port)\n ;; Read a key from the terminal. Returns:\n ;; - A character for regular keys\n ;; - A symbol for special keys: 'up, 'down, 'left, 'right, 'home, 'end,\n ;; 'delete, 'page-up, 'page-down\n ;; - A list '(alt char) for Alt-X keys\n ;; - 'eof for end of input\n (let ([ch (read-char port)])\n (cond\n ((eof-object? ch) 'eof)\n ;; Escape sequence\n ((char=? ch ESC)\n (if (char-ready? port)\n (let ([ch2 (read-char port)])\n (cond\n ((eof-object? ch2) 'escape)\n ;; CSI sequence: ESC [\n ((char=? ch2 #\\[)\n (let ([ch3 (read-char port)])\n (cond\n ((eof-object? ch3) 'escape)\n ((char=? ch3 #\\A) 'up)\n ((char=? ch3 #\\B) 'down)\n ((char=? ch3 #\\C) 'right)\n ((char=? ch3 #\\D) 'left)\n ((char=? ch3 #\\H) 'home)\n ((char=? ch3 #\\F) 'end)\n ;; Extended sequences: ESC [ N ~\n ((and (char>=? ch3 #\\0) (char<=? ch3 #\\9))\n (let ([num (- (char->integer ch3) (char->integer #\\0))])\n (let ([ch4 (read-char port)])\n (cond\n ((eof-object? ch4) 'escape)\n ((char=? ch4 #\\~)\n (case num\n ((1) 'home)\n ((3) 'delete)\n ((4) 'end)\n ((5) 'page-up)\n ((6) 'page-down)\n ((7) 'home)\n ((8) 'end)\n (else 'unknown)))\n ;; Two-digit sequences\n ((and (char>=? ch4 #\\0) (char<=? ch4 #\\9))\n ;; Read until ~\n (let loop ()\n (let ([c (read-char port)])\n (if (or (eof-object? c) (char=? c #\\~))\n 'unknown\n (loop))))\n 'unknown)\n (else 'unknown)))))\n (else 'unknown))))\n ;; SS3 sequence: ESC O\n ((char=? ch2 #\\O)\n (let ([ch3 (read-char port)])\n (cond\n ((eof-object? ch3) 'escape)\n ((char=? ch3 #\\A) 'up)\n ((char=? ch3 #\\B) 'down)\n ((char=? ch3 #\\C) 'right)\n ((char=? ch3 #\\D) 'left)\n ((char=? ch3 #\\H) 'home)\n ((char=? ch3 #\\F) 'end)\n (else 'unknown))))\n ;; Alt-key: ESC followed by printable char\n (else (list 'alt ch2))))\n ;; Bare escape (no following chars ready)\n 'escape))\n ;; Regular character (possibly ctrl)\n (else ch))))\n\n;;; --- Rendering ---\n\n(def (refresh-line state port)\n (let* ([prompt (line-state-prompt state)]\n [buf (line-state-buffer state)]\n [cursor (line-state-cursor state)]\n [pwidth (line-state-prompt-width state)]\n [cols (line-state-columns state)]\n ;; Count newlines in prompt to handle multi-line prompts\n [prompt-lines (count-newlines prompt)]\n ;; Calculate the width of the LAST line of the prompt\n ;; This is what we need for cursor positioning on multi-line prompts\n [last-line-width (visible-width-last-line prompt)])\n ;; Move to start of prompt (handle multi-line prompts)\n ;; Move up by number of newlines in prompt, then carriage return\n (when (> prompt-lines 0)\n (term-move-up prompt-lines port))\n (display \"\\r\" port)\n ;; Display prompt with explicit \\r after each \\n\n ;; This ensures cursor returns to column 0 on each new line\n (let ([len (string-length prompt)])\n (let loop ([i 0])\n (when (< i len)\n (let ([ch (string-ref prompt i)])\n (display (string ch) port)\n (when (char=? ch #\\newline)\n (display \"\\r\" port)))\n (loop (+ i 1)))))\n (display buf port)\n (term-clear-to-eol port)\n ;; Position cursor - use last-line-width instead of pwidth for multi-line prompts\n (let ([cursor-col (+ last-line-width cursor)])\n ;; Move cursor back from end of line to cursor position\n (let ([end-col (+ last-line-width (string-length buf))])\n (when (> end-col cursor-col)\n (term-cursor-back (- end-col cursor-col) port))))\n (force-output port)))\n\n(def (refresh-search state port)\n (let* ([search-str (line-state-search-string state)]\n [result (or (line-state-search-result state) \"\")]\n [mode-str (if (eq? (line-state-search-mode state) 'reverse)\n \"(reverse-i-search)\" \"(i-search)\")])\n (display \"\\r\" port)\n (term-clear-to-eol port)\n (fprintf port \"~a`~a': ~a\" mode-str search-str result)\n (force-output port)))\n\n(def (refresh-cursor-move delta port)\n ;; Fix #3: Fast path for pure cursor movement (left/right/Ctrl-B/Ctrl-F).\n ;; Emits a single cursor escape instead of redrawing the entire line.\n ;; Delta > 0 = move right, delta < 0 = move left.\n (cond\n ((> delta 0) (term-cursor-forward delta port))\n ((< delta 0) (term-cursor-back (- delta) port)))\n (force-output port))\n\n;;; --- Line buffer operations ---\n\n(def (buf-insert state ch)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)]\n [new (make-string (+ len 1))])\n (save-undo! state)\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (string-set! new pos ch)\n (let loop ((i pos))\n (when (< i len)\n (string-set! new (+ i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (+ pos 1))))\n\n(def (buf-insert-string state str)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [blen (string-length buf)]\n [slen (string-length str)]\n [new (make-string (+ blen slen))])\n (save-undo! state)\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i 0))\n (when (< i slen)\n (string-set! new (+ pos i) (string-ref str i))\n (loop (+ i 1))))\n (let loop ((i pos))\n (when (< i blen)\n (string-set! new (+ i slen) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (+ pos slen))))\n\n(def (buf-delete-char state)\n ;; Delete character at cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (< pos len)\n (save-undo! state)\n (let ((new (make-string (- len 1))))\n (let loop ((i 0))\n (when (< i pos)\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i (+ pos 1)))\n (when (< i len)\n (string-set! new (- i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)))))\n\n(def (buf-backspace state)\n ;; Delete character before cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (> pos 0)\n (save-undo! state)\n (let ((new (make-string (- len 1))))\n (let loop ((i 0))\n (when (< i (- pos 1))\n (string-set! new i (string-ref buf i))\n (loop (+ i 1))))\n (let loop ((i pos))\n (when (< i len)\n (string-set! new (- i 1) (string-ref buf i))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new)\n (set! (line-state-cursor state) (- pos 1))))))\n\n(def (buf-kill-to-end state)\n ;; Kill from cursor to end of line\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [killed (substring buf pos (string-length buf))])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state) (substring buf 0 pos)))))\n\n(def (buf-kill-to-start state)\n ;; Kill from start to cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [killed (substring buf 0 pos)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state) (substring buf pos (string-length buf)))\n (set! (line-state-cursor state) 0))))\n\n(def (buf-kill-word-back state)\n ;; Kill word backward (Ctrl-W)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n ;; Skip trailing whitespace\n [start (let loop ([i (- pos 1)])\n (if (and (>= i 0) (char-whitespace? (string-ref buf i)))\n (loop (- i 1))\n (+ i 1)))]\n ;; Find word start\n [word-start (let loop ([i (- start 1)])\n (if (and (>= i 0) (not (char-whitespace? (string-ref buf i))))\n (loop (- i 1))\n (+ i 1)))]\n [killed (substring buf word-start pos)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state)\n (string-append (substring buf 0 word-start)\n (substring buf pos (string-length buf))))\n (set! (line-state-cursor state) word-start))))\n\n(def (buf-kill-word-forward state)\n ;; Kill word forward (Alt-D)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)]\n ;; Skip whitespace\n [start (let loop ([i pos])\n (if (and (< i len) (char-whitespace? (string-ref buf i)))\n (loop (+ i 1))\n i))]\n ;; Find word end\n [word-end (let loop ([i start])\n (if (and (< i len) (not (char-whitespace? (string-ref buf i))))\n (loop (+ i 1))\n i))]\n [killed (substring buf pos word-end)])\n (when (> (string-length killed) 0)\n (save-undo! state)\n (kill-ring-push! state killed)\n (set! (line-state-buffer state)\n (string-append (substring buf 0 pos)\n (substring buf word-end len))))))\n\n(def (buf-transpose-chars state)\n ;; Transpose the two characters before cursor\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [len (string-length buf)])\n (when (and (> pos 0) (> len 1))\n (save-undo! state)\n (let* ([p (if (= pos len) (- pos 1) pos)]\n [c1 (string-ref buf (- p 1))]\n [c2 (string-ref buf p)]\n [new-buf (string-copy buf)])\n (string-set! new-buf (- p 1) c2)\n (string-set! new-buf p c1)\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state)\n (min (+ p 1) len))))))\n\n;;; --- Word movement ---\n\n(def (word-forward-pos buf pos)\n ;; Find position after next word\n (let ([len (string-length buf)])\n ;; Skip non-word chars\n (let loop ([i pos])\n (if (and (< i len) (not (char-alphanumeric? (string-ref buf i))))\n (loop (+ i 1))\n ;; Skip word chars\n (let loop2 ([i i])\n (if (and (< i len) (char-alphanumeric? (string-ref buf i)))\n (loop2 (+ i 1))\n i))))))\n\n(def (word-backward-pos buf pos)\n ;; Find position before previous word\n (if (<= pos 0) 0\n ;; Skip non-word chars\n (let loop ([i (- pos 1)])\n (if (and (> i 0) (not (char-alphanumeric? (string-ref buf i))))\n (loop (- i 1))\n ;; Skip word chars\n (let loop2 ([i i])\n (if (and (> i 0) (char-alphanumeric? (string-ref buf (- i 1))))\n (loop2 (- i 1))\n i))))))\n\n(def (char-alphanumeric? ch)\n (or (char-alphabetic? ch) (char-numeric? ch) (char=? ch #\\_)))\n\n;;; --- Kill ring ---\n\n(def (kill-ring-push! state text)\n (set! (line-state-kill-ring state)\n (cons text (take-at-most (line-state-kill-ring state) 31))))\n\n(def (kill-ring-top state)\n (let ([kr (line-state-kill-ring state)])\n (if (null? kr) #f (car kr))))\n\n(def (take-at-most lst n)\n (if (or (null? lst) (<= n 0)) (list)\n (cons (car lst) (take-at-most (cdr lst) (- n 1)))))\n\n;;; --- Undo ---\n\n(def (save-undo! state)\n (set! (line-state-undo-stack state)\n (cons (cons (string-copy (line-state-buffer state))\n (line-state-cursor state))\n (take-at-most (line-state-undo-stack state) 99))))\n\n(def (undo! state)\n (let ([stack (line-state-undo-stack state)])\n (when (pair? stack)\n (let ([entry (car stack)])\n (set! (line-state-buffer state) (car entry))\n (set! (line-state-cursor state) (cdr entry))\n (set! (line-state-undo-stack state) (cdr stack))))))\n\n;;; --- History navigation ---\n\n(def (history-prev state)\n (let ([idx (or (line-state-history-index state) 0)])\n (let ([entry (history-get-relative idx)])\n (when entry\n ;; Save current line if first navigation\n (unless (line-state-history-index state)\n (set! (line-state-saved-line state)\n (string-copy (line-state-buffer state))))\n (set! (line-state-history-index state) (+ idx 1))\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry))))))\n\n(def (history-next state)\n (let ([idx (line-state-history-index state)])\n (when (and idx (> idx 0))\n (let ([new-idx (- idx 1)])\n (if (= new-idx 0)\n ;; Back to current line\n (begin\n (set! (line-state-history-index state) #f)\n (set! (line-state-buffer state)\n (string-copy (or (line-state-saved-line state) \"\")))\n (set! (line-state-cursor state)\n (string-length (line-state-buffer state))))\n ;; Navigate to history entry\n (let ([entry (history-get-relative (- new-idx 1))])\n (when entry\n (set! (line-state-history-index state) new-idx)\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry)))))))))\n\n;;; --- Incremental search ---\n;;; Fix #9: Maintain a filtered candidate list.\n;;; When the user types another character (query grows), filter the existing\n;;; candidates instead of rescanning the full history.\n;;; When the query shrinks (backspace), rebuild from full history (unavoidable).\n\n(def *search-candidates* (list)) ;; All matching history entries for current query\n(def *search-query-cache* \"\") ;; Query string that produced *search-candidates*\n\n(def (search-all-matching substr)\n ;; Return all history entries containing substr, most recent first.\n (filter (lambda (cmd) (string-contains cmd substr))\n (history-list)))\n\n(def (search-start state mode)\n (set! (line-state-search-mode state) mode)\n (set! (line-state-search-string state) \"\")\n (set! (line-state-search-result state) #f)\n (set! *search-candidates* (list))\n (set! *search-query-cache* \"\"))\n\n(def (search-update state)\n ;; Update search results based on current search string\n (let ([query (line-state-search-string state)])\n (when (> (string-length query) 0)\n (let ([result (history-search-reverse query)])\n (set! (line-state-search-result state) result)))))\n\n(def (search-accept state)\n ;; Accept search result and exit search mode\n (let ([result (line-state-search-result state)])\n (set! (line-state-search-mode state) #f)\n (when result\n (set! (line-state-buffer state) (string-copy result))\n (set! (line-state-cursor state) (string-length result)))))\n\n(def (search-cancel state)\n ;; Cancel search and restore previous line\n (set! (line-state-search-mode state) #f)\n (set! (line-state-search-string state) \"\")\n (set! (line-state-search-result state) #f))\n\n;;; --- Emacs mode key handling ---\n\n(def (handle-emacs-key state key out-port)\n (cond\n ;; Search mode handling\n ((line-state-search-mode state)\n (handle-search-key state key out-port))\n ;; Character input (exclude DEL/backspace = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (buf-insert state key)\n (refresh-line state out-port))\n ;; Ctrl keys\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ((and (char? key) (= (char->integer key) CTRL-A))\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-E))\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-B))\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((and (char? key) (= (char->integer key) CTRL-F))\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((and (char? key) (= (char->integer key) CTRL-D))\n (if (= (string-length (line-state-buffer state)) 0)\n ;; EOF on empty line\n (begin\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof))\n ;; Delete char at cursor\n (begin\n (buf-delete-char state)\n (refresh-line state out-port))))\n ((and (char? key) (= (char->integer key) BACKSPACE))\n (buf-backspace state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-H))\n (buf-backspace state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-K))\n (buf-kill-to-end state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-U))\n (buf-kill-to-start state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-W))\n (buf-kill-word-back state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-Y))\n ;; Yank from kill ring\n (let ([text (kill-ring-top state)])\n (when text\n (buf-insert-string state text)\n (refresh-line state out-port))))\n ((and (char? key) (= (char->integer key) CTRL-T))\n ;; Fuzzy file finder via fzf (if available), else transpose chars\n (let ([fn (*fzf-files-fn*)])\n (if fn\n (begin\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn)))])\n (term-raw! (current-input-port))\n (when result\n (buf-insert-string state result))))\n (buf-transpose-chars state)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-L))\n ;; Clear screen\n (term-clear-screen out-port)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-P))\n (history-prev state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-N))\n (history-next state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-R))\n ;; Fuzzy history search via fzf (if available), else fallback to substring search\n (let ([fn (*fzf-history-fn*)])\n (if fn\n (let ([commands (history-unique-commands)])\n (when (pair? commands)\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn commands)))])\n (term-raw! (current-input-port))\n (when result\n (save-undo! state)\n (set! (line-state-buffer state) (string-copy result))\n (set! (line-state-cursor state) (string-length result))))))\n ;; Fallback: legacy substring search\n (search-start state 'reverse)))\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-S))\n (search-start state 'forward)\n (refresh-search state out-port))\n ((and (char? key) (= (char->integer key) CTRL-G))\n ;; Cancel\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-UNDERSCORE))\n ;; Undo\n (undo! state)\n (refresh-line state out-port))\n ((and (char? key) (= (char->integer key) CTRL-C))\n ;; Abort line\n (display \"^C\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) \"\"))\n ((and (char? key) (= (char->integer key) TAB-KEY))\n ;; Tab completion\n (handle-tab-completion state out-port))\n ;; Arrow keys\n ((eq? key 'up)\n (history-prev state)\n (refresh-line state out-port))\n ((eq? key 'down)\n (history-next state)\n (refresh-line state out-port))\n ((eq? key 'left)\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((eq? key 'right)\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((eq? key 'home)\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((eq? key 'end)\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (refresh-line state out-port))\n ((eq? key 'delete)\n (buf-delete-char state)\n (refresh-line state out-port))\n ;; Alt-key combinations\n ((and (list? key) (eq? (car key) 'alt))\n (handle-alt-key state (cadr key) out-port))\n (else #!void)))\n\n;;; --- Alt-key handling ---\n\n(def (handle-alt-key state ch out-port)\n (cond\n ;; Alt-B: backward word\n ((or (char=? ch #\\b) (char=? ch #\\B))\n (set! (line-state-cursor state)\n (word-backward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ;; Alt-F: forward word\n ((or (char=? ch #\\f) (char=? ch #\\F))\n (set! (line-state-cursor state)\n (word-forward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ;; Alt-D: kill word forward\n ((or (char=? ch #\\d) (char=? ch #\\D))\n (buf-kill-word-forward state)\n (refresh-line state out-port))\n ;; Alt-U: uppercase word\n ((or (char=? ch #\\u) (char=? ch #\\U))\n (word-transform! state char-upcase)\n (refresh-line state out-port))\n ;; Alt-L: lowercase word\n ((or (char=? ch #\\l) (char=? ch #\\L))\n (word-transform! state char-downcase)\n (refresh-line state out-port))\n ;; Alt-C: fuzzy directory jump via fzf (if available), else capitalize word\n ((or (char=? ch #\\c) (char=? ch #\\C))\n (let ([fn (*fzf-dirs-fn*)])\n (if fn\n (begin\n (term-cooked! (current-input-port))\n (let ([result (with-catch (lambda (e) #f) (lambda () (fn)))])\n (term-raw! (current-input-port))\n (when result\n (save-undo! state)\n (set! (line-state-buffer state) (string-append \"cd \" result))\n (set! (line-state-cursor state) (+ 3 (string-length result))))))\n (word-capitalize! state)))\n (refresh-line state out-port))\n ;; Alt-<: beginning of history\n ((char=? ch #\\<)\n ;; Navigate to oldest history entry\n (let ([count (history-count)])\n (when (> count 0)\n (unless (line-state-history-index state)\n (set! (line-state-saved-line state)\n (string-copy (line-state-buffer state))))\n (let ([entry (history-get 1)])\n (when entry\n (set! (line-state-history-index state) count)\n (set! (line-state-buffer state) (string-copy entry))\n (set! (line-state-cursor state) (string-length entry))\n (refresh-line state out-port))))))\n ;; Alt->: end of history (current line)\n ((char=? ch #\\>)\n (when (line-state-history-index state)\n (set! (line-state-history-index state) #f)\n (set! (line-state-buffer state)\n (string-copy (or (line-state-saved-line state) \"\")))\n (set! (line-state-cursor state)\n (string-length (line-state-buffer state)))\n (refresh-line state out-port)))\n ;; Alt-.: insert last argument of previous command\n ((char=? ch #\\.)\n (let ([prev (history-get-relative 0)])\n (when prev\n (let ([words (simple-split prev)])\n (when (pair? words)\n (let ([last-word (car (last-pair words))])\n (buf-insert-string state last-word)\n (refresh-line state out-port)))))))\n (else #!void)))\n\n;;; --- Word transformations ---\n\n(def (word-transform! state transform-fn)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [end (word-forward-pos buf pos)]\n [new-buf (string-copy buf)])\n (save-undo! state)\n (let loop ([i pos])\n (when (< i end)\n (string-set! new-buf i (transform-fn (string-ref new-buf i)))\n (loop (+ i 1))))\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state) end)))\n\n(def (word-capitalize! state)\n (let* ([buf (line-state-buffer state)]\n [pos (line-state-cursor state)]\n [end (word-forward-pos buf pos)]\n [new-buf (string-copy buf)])\n (save-undo! state)\n ;; Skip non-alpha\n (let loop ([i pos] [first? #t])\n (when (< i end)\n (let ([ch (string-ref new-buf i)])\n (cond\n ((char-alphabetic? ch)\n (string-set! new-buf i\n (if first? (char-upcase ch) (char-downcase ch)))\n (loop (+ i 1) #f))\n (else\n (loop (+ i 1) first?))))))\n (set! (line-state-buffer state) new-buf)\n (set! (line-state-cursor state) end)))\n\n;;; --- Search mode key handling ---\n\n(def (handle-search-key state key out-port)\n (cond\n ;; Ctrl-R / Ctrl-S: keep searching\n ((and (char? key) (= (char->integer key) CTRL-R))\n ;; TODO: search backwards more\n (refresh-search state out-port))\n ((and (char? key) (= (char->integer key) CTRL-S))\n ;; TODO: search forwards\n (refresh-search state out-port))\n ;; Ctrl-G: cancel search\n ((and (char? key) (= (char->integer key) CTRL-G))\n (search-cancel state)\n (refresh-line state out-port))\n ;; Enter: accept search\n ((enter-key? key)\n (search-accept state)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ;; Backspace: remove last search char\n ((and (char? key)\n (or (= (char->integer key) BACKSPACE) (= (char->integer key) CTRL-H)))\n (let ([s (line-state-search-string state)])\n (when (> (string-length s) 0)\n (set! (line-state-search-string state)\n (substring s 0 (- (string-length s) 1)))\n (search-update state)))\n (refresh-search state out-port))\n ;; Escape or any arrow/special: accept and handle as normal\n ((or (eq? key 'escape) (symbol? key))\n (search-accept state)\n (refresh-line state out-port))\n ;; Printable char: add to search string (exclude DEL = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (set! (line-state-search-string state)\n (string-append (line-state-search-string state) (string key)))\n (search-update state)\n (refresh-search state out-port))\n ;; Anything else: accept search and re-handle key\n (else\n (search-accept state)\n (handle-emacs-key state key out-port))))\n\n;;; --- Tab completion ---\n\n(def (handle-tab-completion state out-port)\n (let ([fn (line-state-complete-fn state)])\n (when fn\n (let ([completions (fn (line-state-buffer state)\n (line-state-cursor state))])\n (cond\n ((null? completions) #!void) ;; No completions — beep?\n ((= (length completions) 1)\n ;; Single completion: insert it\n ;; Don't append space after directory completions (ending with /)\n ;; so the user can keep tabbing into subdirectories\n (let* ([completion (car completions)]\n [is-dir? (and (> (string-length completion) 0)\n (char=? (string-ref completion\n (- (string-length completion) 1))\n #\\/))]\n [suffix (if is-dir? \"\" \" \")]\n [word-start (find-word-start-for-completion\n (line-state-buffer state)\n (line-state-cursor state))])\n (save-undo! state)\n (set! (line-state-buffer state)\n (string-append\n (substring (line-state-buffer state) 0 word-start)\n completion\n suffix\n (substring (line-state-buffer state)\n (line-state-cursor state)\n (string-length (line-state-buffer state)))))\n (set! (line-state-cursor state)\n (+ word-start (string-length completion) (string-length suffix)))\n (refresh-line state out-port)))\n (else\n ;; Multiple completions: insert common prefix, display list\n (let* ([prefix (common-prefix completions)]\n [word-start (find-word-start-for-completion\n (line-state-buffer state)\n (line-state-cursor state))])\n (when (> (string-length prefix) (- (line-state-cursor state) word-start))\n (save-undo! state)\n (set! (line-state-buffer state)\n (string-append\n (substring (line-state-buffer state) 0 word-start)\n prefix\n (substring (line-state-buffer state)\n (line-state-cursor state)\n (string-length (line-state-buffer state)))))\n (set! (line-state-cursor state) (+ word-start (string-length prefix))))\n ;; Display completions\n (display \"\\r\\n\" out-port)\n (display-completions completions out-port (line-state-columns state))\n (refresh-line state out-port))))))))\n\n(def (find-word-start-for-completion buf cursor)\n ;; Find start of the word being completed.\n ;; Do NOT treat / as a boundary — it's part of file paths.\n ;; The completion functions handle path splitting internally.\n (let loop ([i (- cursor 1)])\n (if (or (< i 0)\n (char-whitespace? (string-ref buf i))\n (char=? (string-ref buf i) #\\=))\n (+ i 1)\n (loop (- i 1)))))\n\n(def (common-prefix strings)\n ;; Find longest common prefix of a list of strings\n (if (null? strings) \"\"\n (let ([first (car strings)])\n (let loop ([len (string-length first)])\n (if (<= len 0) \"\"\n (let ([prefix (substring first 0 len)])\n (if (every? (lambda (s)\n (and (>= (string-length s) len)\n (string=? (substring s 0 len) prefix)))\n strings)\n prefix\n (loop (- len 1)))))))))\n\n(def (every? pred lst)\n (cond\n ((null? lst) #t)\n ((pred (car lst)) (every? pred (cdr lst)))\n (else #f)))\n\n(def (display-completions completions port columns)\n ;; Display completions in columns\n ;; Use \\r\\n because terminal is in raw output mode (no LF→CRLF conversion)\n (let* ([max-len (apply max (map string-length completions))]\n [col-width (+ max-len 2)]\n [ncols (max 1 (quotient columns col-width))])\n (let loop ([items completions] [col 0])\n (unless (null? items)\n (let ([item (car items)])\n (display item port)\n (if (= (+ col 1) ncols)\n (begin (display \"\\r\\n\" port) (loop (cdr items) 0))\n (begin\n (display (make-string (- col-width (string-length item)) #\\space) port)\n (loop (cdr items) (+ col 1)))))))\n (when (and (pair? completions)\n (not (= 0 (modulo (length completions) ncols))))\n (display \"\\r\\n\" port))\n (force-output port)))\n\n;;; --- Vi mode (basic) ---\n\n(def (handle-vi-key state key out-port)\n (if (eq? (line-state-vi-mode state) 'insert)\n (handle-vi-insert state key out-port)\n (handle-vi-command state key out-port)))\n\n(def (handle-vi-insert state key out-port)\n (cond\n ;; Escape -> command mode\n ((eq? key 'escape)\n (set! (line-state-vi-mode state) 'command)\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1)))\n (refresh-line state out-port))\n ;; Enter\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n ;; Backspace\n ((and (char? key) (or (= (char->integer key) BACKSPACE)\n (= (char->integer key) CTRL-H)))\n (buf-backspace state)\n (refresh-line state out-port))\n ;; Ctrl-C\n ((and (char? key) (= (char->integer key) CTRL-C))\n (display \"^C\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-buffer state) \"\")\n (set! (line-state-cursor state) 0)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) \"\"))\n ;; Tab\n ((and (char? key) (= (char->integer key) TAB-KEY))\n (handle-tab-completion state out-port))\n ;; Ctrl-D\n ((and (char? key) (= (char->integer key) CTRL-D))\n (if (= (string-length (line-state-buffer state)) 0)\n (begin\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof))\n (begin\n (buf-delete-char state)\n (refresh-line state out-port))))\n ;; Regular printable character (exclude DEL = 127)\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (buf-insert state key)\n (refresh-line state out-port))\n (else #!void)))\n\n(def (handle-vi-command state key out-port)\n (cond\n ;; Movement\n ((and (char? key) (char=? key #\\h))\n (when (> (line-state-cursor state) 0)\n (set! (line-state-cursor state) (- (line-state-cursor state) 1))\n (refresh-cursor-move -1 out-port)))\n ((and (char? key) (char=? key #\\l))\n (when (< (line-state-cursor state)\n (- (string-length (line-state-buffer state)) 1))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1))\n (refresh-cursor-move 1 out-port)))\n ((and (char? key) (char=? key #\\w))\n (set! (line-state-cursor state)\n (word-forward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\b))\n (set! (line-state-cursor state)\n (word-backward-pos (line-state-buffer state) (line-state-cursor state)))\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\0))\n (set! (line-state-cursor state) 0)\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\$))\n (let ([len (string-length (line-state-buffer state))])\n (set! (line-state-cursor state) (max 0 (- len 1)))\n (refresh-line state out-port)))\n ;; Insert modes\n ((and (char? key) (char=? key #\\i))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\a))\n (when (< (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-cursor state) (+ (line-state-cursor state) 1)))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\A))\n (set! (line-state-cursor state) (string-length (line-state-buffer state)))\n (set! (line-state-vi-mode state) 'insert))\n ((and (char? key) (char=? key #\\I))\n (set! (line-state-cursor state) 0)\n (set! (line-state-vi-mode state) 'insert))\n ;; Delete char\n ((and (char? key) (char=? key #\\x))\n (buf-delete-char state)\n (refresh-line state out-port))\n ;; Delete to end\n ((and (char? key) (char=? key #\\D))\n (buf-kill-to-end state)\n (refresh-line state out-port))\n ;; Change to end\n ((and (char? key) (char=? key #\\C))\n (buf-kill-to-end state)\n (set! (line-state-vi-mode state) 'insert)\n (refresh-line state out-port))\n ;; History\n ((and (char? key) (char=? key #\\k))\n (history-prev state)\n (refresh-line state out-port))\n ((and (char? key) (char=? key #\\j))\n (history-next state)\n (refresh-line state out-port))\n ((eq? key 'up)\n (history-prev state)\n (refresh-line state out-port))\n ((eq? key 'down)\n (history-next state)\n (refresh-line state out-port))\n ;; Enter\n ((enter-key? key)\n (display \"\\r\\n\" out-port)\n (force-output out-port)\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) (line-state-buffer state)))\n (else #!void)))\n\n;;; --- Helpers ---\n\n(def (simple-split str)\n ;; Split string on whitespace\n (string-split-chars str #\\space))\n\n;;; --- Public interface ---\n\n;; Read a line of input with editing.\n;; prompt: string to display\n;; complete-fn: (lambda (line cursor) -> list-of-strings) or #f\n;; mode: 'emacs or 'vi\n;; Returns: string (the line), or 'eof\n(def (line-edit prompt\n (complete-fn #f)\n (mode 'emacs))\n (let ([in-port (current-input-port)]\n [out-port (current-error-port)])\n ;; If not a tty, just read a line\n (if (not (with-catch (lambda (e) #f)\n (lambda () (tty? in-port))))\n ;; Non-interactive: just read a line\n (begin\n (display prompt out-port)\n (force-output out-port)\n (let ([line (read-line in-port)])\n (if (eof-object? line) 'eof line)))\n ;; Interactive: use line editor\n (let* ([cols (detect-terminal-columns)]\n [pw (visible-width-last-line prompt)])\n (set-terminal-columns! cols)\n (let ([state (make-line-state\n \"\" ;; buffer\n 0 ;; cursor\n prompt ;; prompt\n pw ;; prompt-width\n (count-newlines prompt) ;; prompt-lines\n #f ;; history-index\n \"\" ;; saved-line\n (list) ;; kill-ring\n (list) ;; undo-stack\n #f ;; search-mode\n \"\" ;; search-string\n #f ;; search-result\n cols ;; columns\n #f ;; multiline?\n mode ;; mode\n 'insert ;; vi-mode\n complete-fn ;; complete-fn\n #f ;; done?\n #f)]) ;; result\n (dynamic-wind\n (lambda () (term-raw! in-port))\n (lambda ()\n ;; Ensure we're on a fresh line before showing prompt\n ;; If previous command didn't end with newline, this prevents bleed-over\n (display \"\\n\" out-port)\n (force-output out-port)\n ;; Show initial prompt\n (refresh-line state out-port)\n ;; Main editing loop\n (let loop ()\n (let ([key (read-key in-port)])\n (if (eq? key 'eof)\n (begin\n (set! (line-state-done? state) #t)\n (set! (line-state-result state) 'eof)\n 'eof)\n (begin\n (if (eq? mode 'vi)\n (handle-vi-key state key out-port)\n (handle-emacs-key state key out-port))\n (if (line-state-done? state)\n (line-state-result state)\n (loop)))))))\n (lambda () (term-cooked! in-port))))))))\n\n;; Check if a port is a terminal\n(def (tty? port)\n (with-catch (lambda (e) #f)\n (lambda () (tty-mode-set! port #t #t #f #f 0) #t)))\n\n;; Calculate visible width (ignoring ANSI escapes)\n(def (visible-width str)\n (let ([len (string-length str)])\n (let loop ([i 0] [width 0] [in-escape? #f])\n (cond\n ((>= i len) width)\n ((and (not in-escape?)\n (char=? (string-ref str i) #\\escape))\n (loop (+ i 1) width #t))\n (in-escape?\n (if (char-alphabetic? (string-ref str i))\n (loop (+ i 1) width #f)\n (loop (+ i 1) width #t)))\n (else\n (loop (+ i 1) (+ width 1) #f))))))\n\n(def (visible-width-last-line str)\n ;; For multi-line prompts, return width of only the last line\n ;; Find the last newline and measure from there\n (let* ([len (string-length str)]\n [last-newline (let loop ([i (- len 1)])\n (cond\n ((< i 0) -1)\n ((char=? (string-ref str i) #\\newline) i)\n (else (loop (- i 1)))))]\n [start (+ last-newline 1)])\n ;; Calculate visible width from start to end\n (let loop ([i start] [width 0] [in-escape? #f])\n (cond\n ((>= i len) width)\n ((and (not in-escape?)\n (char=? (string-ref str i) #\\escape))\n (loop (+ i 1) width #t))\n (in-escape?\n (if (char-alphabetic? (string-ref str i))\n (loop (+ i 1) width #f)\n (loop (+ i 1) width #t)))\n (else\n (loop (+ i 1) (+ width 1) #f))))))\n\n(def (count-newlines str)\n ;; Count number of newline characters in string\n (let ([len (string-length str)])\n (let loop ([i 0] [count 0])\n (cond\n ((>= i len) count)\n ((char=? (string-ref str i) #\\newline)\n (loop (+ i 1) (+ count 1)))\n (else\n (loop (+ i 1) count))))))\n"} {"text":";; FILE: jerboa-shell/bench-smp.ss\n(import (jerboa prelude) (std misc thread))\n\n;; --- Timing ---\n\n(def (now-seconds)\n (/ (real-time) 1000.0))\n\n(def (fmt-secs s)\n (let ([ms (inexact->exact (round (* s 1000)))])\n (string-append (number->string ms) \"ms\")))\n\n(def (log! msg)\n (display msg (current-error-port))\n (force-output (current-error-port)))\n\n;; --- Benchmarks ---\n;; Pure-CPU benchmarks that parallelize well on SMP.\n;; Allocation-heavy benchmarks (hash, list, string) don't scale due to\n;; Gambit's stop-the-world GC, so we focus on compute-bound workloads.\n\n;; 1. Fibonacci — pure function calls\n(def (fib n)\n (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))\n\n;; 2. Ackermann — deep recursion + stack pressure\n(def (ack m n)\n (cond ((= m 0) (+ n 1))\n ((= n 0) (ack (- m 1) 1))\n (else (ack (- m 1) (ack m (- n 1))))))\n\n;; 3. Tak — Takeuchi function, another classic CPU benchmark\n(def (tak x y z)\n (if (<= x y) z\n (tak (tak (- x 1) y z)\n (tak (- y 1) z x)\n (tak (- z 1) x y))))\n\n;; 4. Sum of collatz sequence lengths — compute + branching\n(def (collatz-len n)\n (let loop ([n n] [len 0])\n (if (<= n 1) len\n (loop (if (even? n) (quotient n 2) (+ (* 3 n) 1))\n (+ len 1)))))\n\n(def (collatz-sum limit)\n (let loop ([i 1] [sum 0])\n (if (> i limit) sum\n (loop (+ i 1) (+ sum (collatz-len i))))))\n\n;; 5. Matrix multiply (vectors) — nested loops, arithmetic\n(def (matmul-bench size)\n (let ([a (make-vector (* size size) 1.0)]\n [b (make-vector (* size size) 2.0)]\n [c (make-vector (* size size) 0.0)])\n (let loopi ([i 0])\n (when (< i size)\n (let loopj ([j 0])\n (when (< j size)\n (let loopk ([k 0] [sum 0.0])\n (if (< k size)\n (loopk (+ k 1)\n (+ sum (* (vector-ref a (+ (* i size) k))\n (vector-ref b (+ (* k size) j)))))\n (vector-set! c (+ (* i size) j) sum)))\n (loopj (+ j 1))))\n (loopi (+ i 1))))\n (vector-ref c 0)))\n\n;; --- Runner ---\n\n(def num-cores 8)\n\n(def (run-benchmarks-smp)\n ;; Chez threads are real OS threads — no SMP bootstrap needed.\n (thread-sleep! 0.1)\n\n (log! (format \"\\n=== bench-smp (~a cores, ~a processors) ===\\n\"\n num-cores (cpu-count)))\n\n (let ([benchmarks\n (list\n (cons \"fib(38) \" (lambda () (fib 38)))\n (cons \"ack(3,10) \" (lambda () (ack 3 10)))\n (cons \"tak(30,20,10)\" (lambda () (tak 30 20 10)))\n (cons \"collatz 500k \" (lambda () (collatz-sum 500000)))\n (cons \"matmul 150 \" (lambda () (matmul-bench 150))))])\n\n ;; Sequential baseline: run each benchmark num-cores times\n (log! \"\\n--- sequential (8x each) ---\\n\")\n (let ([seq-times\n (map (lambda (b)\n (let ([start (now-seconds)])\n (let loop ([i 0])\n (when (< i num-cores)\n ((cdr b))\n (loop (+ i 1))))\n (let* ([end (now-seconds)]\n [wall (- end start)])\n (log! (format \" ~a ~a wall\\n\" (car b) (fmt-secs wall)))\n (cons (car b) wall))))\n benchmarks)])\n\n ;; Parallel: 8 threads simultaneously\n (log! \"\\n--- parallel (8 threads) ---\\n\")\n (let ([par-times\n (map (lambda (b)\n (let* ([start (now-seconds)]\n [threads (map (lambda (i)\n (thread-start!\n (make-thread (cdr b))))\n (iota num-cores))]\n [_ (for-each thread-join! threads)]\n [end (now-seconds)]\n [wall (- end start)])\n (log! (format \" ~a ~a wall\\n\" (car b) (fmt-secs wall)))\n (cons (car b) wall)))\n benchmarks)])\n\n ;; Summary\n (log! \"\\n--- speedup ---\\n\")\n (for-each\n (lambda (seq par)\n (let* ([s (cdr seq)]\n [p (cdr par)]\n [speedup (if (> p 0) (/ s p) 0.0)])\n (log! (format \" ~a ~ax\\n\" (car seq)\n (/ (round (* speedup 10)) 10.0)))))\n seq-times par-times))))\n\n (log! \"=== done ===\\n\"))\n\n;; Auto-run on load\n(run-benchmarks-smp)\n"} {"text":";; FILE: jerboa-shell/fzf.ss\n;;; fzf.ss — Interactive fuzzy finder TUI for gsh\n;;;\n;;; Full-screen terminal UI with live filtering, match highlighting,\n;;; and scrollable candidate list. Bottom-up layout like fzf.\n;;;\n;;; Usage:\n;;; (fzf-select candidates prompt: \"> \" multi?: #f)\n;;; Returns selected string, or #f on cancel.\n\n(export fzf-select\n fzf-history-search\n fzf-find-files\n fzf-find-directories\n fzf-init!\n collect-files\n collect-files-git\n collect-directories)\n(import :std/sugar\n :std/format\n :std/sort\n :std/srfi/1\n :jsh/util\n :jsh/fuzzy\n :jsh/lineedit ;; for read-key, term-raw!, term-cooked!, *fzf-*-fn* callbacks\n :jsh/ffi)\n\n;;;============================================================================\n;;; State\n;;;============================================================================\n\n(defstruct fzf-state\n (candidates ;; vector of all candidate strings\n filtered ;; list of (score . string) — current filtered results\n query ;; string: current search query\n cursor ;; integer: cursor position in query\n selected ;; integer: selected index in filtered list (0 = top visible)\n scroll-offset ;; integer: how many items scrolled past\n total ;; integer: total number of candidates\n match-count ;; integer: number of matching candidates\n height ;; integer: terminal rows available for candidates\n columns ;; integer: terminal width\n prompt ;; string: prompt string\n multi? ;; boolean: multi-select mode\n marked ;; list of strings: marked candidates (multi-select)\n done? ;; boolean: selection complete\n result) ;; string, list, or #f: final result\n transparent: #t)\n\n;;;============================================================================\n;;; ANSI escape helpers\n;;;============================================================================\n\n;; ESC-STR is imported from (jsh lineedit)\n\n(def (ansi-clear-screen port)\n (fprintf port \"~a[2J~a[H\" ESC-STR ESC-STR))\n\n(def (ansi-move-to row col port)\n (fprintf port \"~a[~a;~aH\" ESC-STR row col))\n\n(def (ansi-clear-line port)\n (fprintf port \"~a[2K\" ESC-STR))\n\n(def (ansi-bold port)\n (fprintf port \"~a[1m\" ESC-STR))\n\n(def (ansi-underline port)\n (fprintf port \"~a[4m\" ESC-STR))\n\n(def (ansi-fg-green port)\n (fprintf port \"~a[32m\" ESC-STR))\n\n(def (ansi-fg-yellow port)\n (fprintf port \"~a[33m\" ESC-STR))\n\n(def (ansi-fg-cyan port)\n (fprintf port \"~a[36m\" ESC-STR))\n\n(def (ansi-reset port)\n (fprintf port \"~a[0m\" ESC-STR))\n\n(def (ansi-hide-cursor port)\n (fprintf port \"~a[?25l\" ESC-STR))\n\n(def (ansi-show-cursor port)\n (fprintf port \"~a[?25h\" ESC-STR))\n\n(def (ansi-save-cursor port)\n (fprintf port \"~a7\" ESC-STR))\n\n(def (ansi-restore-cursor port)\n (fprintf port \"~a8\" ESC-STR))\n\n;; Enable alternate screen buffer (preserves main screen)\n(def (ansi-alt-screen-on port)\n (fprintf port \"~a[?1049h\" ESC-STR))\n\n(def (ansi-alt-screen-off port)\n (fprintf port \"~a[?1049l\" ESC-STR))\n\n;;;============================================================================\n;;; Terminal size\n;;;============================================================================\n\n(def (get-terminal-size)\n \"Returns (values rows cols).\"\n (let ((cols (ffi-terminal-columns 0)))\n (let ((rows (ffi-terminal-rows 0)))\n (values (if (or (not rows) (<= rows 0)) 24 rows)\n (if (or (not cols) (<= cols 0)) 80 cols)))))\n\n;;;============================================================================\n;;; Rendering\n;;;============================================================================\n\n(def (render-fzf state port)\n \"Render the full fzf interface.\"\n (let* ((height (fzf-state-height state))\n (cols (fzf-state-columns state))\n (filtered (fzf-state-filtered state))\n (query (fzf-state-query state))\n (selected (fzf-state-selected state))\n (scroll (fzf-state-scroll-offset state))\n (match-count (fzf-state-match-count state))\n (total (fzf-state-total state))\n (prompt-str (fzf-state-prompt state))\n (marked (fzf-state-marked state))\n ;; Reserve: 1 line for prompt, 1 line for status\n (avail-lines (- height 2))\n ;; Candidate window\n (visible (fzf-take (fzf-drop filtered scroll) avail-lines)))\n\n ;; Clear screen and draw from top\n (ansi-move-to 1 1 port)\n\n ;; Status line at top\n (ansi-clear-line port)\n (ansi-fg-cyan port)\n (fprintf port \" ~a/~a\" match-count total)\n (when (pair? marked)\n (fprintf port \" [~a selected]\" (length marked)))\n (ansi-reset port)\n (display \"\\r\\n\" port)\n\n ;; Candidate lines (top-down: best match at top)\n (let loop ((items visible) (idx 0))\n (when (< idx avail-lines)\n (ansi-clear-line port)\n (if (pair? items)\n (let* ((item (car items))\n (score (car item))\n (text (cdr item))\n (is-selected? (= idx selected))\n (is-marked? (member text marked)))\n ;; Indicator\n (if is-selected?\n (begin (ansi-fg-green port) (display \"> \" port) (ansi-reset port))\n (display \" \" port))\n ;; Mark indicator\n (when is-marked?\n (ansi-fg-yellow port)\n (display \"* \" port)\n (ansi-reset port))\n ;; Candidate text with match highlighting\n (render-highlighted-candidate text query is-selected? cols port)\n (display \"\\r\\n\" port))\n ;; Empty line\n (display \"\\r\\n\" port))\n (loop (if (pair? items) (cdr items) []) (+ idx 1))))\n\n ;; Prompt line at bottom\n (ansi-clear-line port)\n (ansi-fg-green port)\n (display prompt-str port)\n (ansi-reset port)\n (display query port)\n (force-output port)))\n\n(def (render-highlighted-candidate text query is-selected? cols port)\n \"Render a candidate with fuzzy-matched characters highlighted.\"\n (let* ((positions (if (> (string-length query) 0)\n (fuzzy-match-positions query text)\n []))\n (pos-set (list->hash-set positions))\n (max-width (- cols 4)) ;; account for prefix \" \" or \"> \"\n (display-len (min (string-length text) max-width)))\n (when is-selected?\n (ansi-bold port))\n (let loop ((i 0))\n (when (< i display-len)\n (let ((ch (string-ref text i)))\n (if (hash-get pos-set i)\n (begin\n (ansi-fg-green port)\n (ansi-underline port)\n (display ch port)\n (ansi-reset port)\n (when is-selected? (ansi-bold port)))\n (display ch port)))\n (loop (+ i 1))))\n (ansi-reset port)))\n\n(def (list->hash-set lst)\n \"Convert a list to a hash set for O(1) membership testing.\"\n (let ((ht (make-hash-table)))\n (for-each (lambda (x) (hash-put! ht x #t)) lst)\n ht))\n\n;;;============================================================================\n;;; Filtering\n;;;============================================================================\n\n(def (update-filter! state)\n \"Re-filter candidates based on current query.\"\n (let* ((query (fzf-state-query state))\n (candidates (fzf-state-candidates state))\n (len (vector-length candidates))\n (filtered (if (string=? query \"\")\n ;; No query: show all candidates in order\n (let loop ((i 0) (acc []))\n (if (>= i len) (reverse acc)\n (loop (+ i 1) (cons (cons 1 (vector-ref candidates i)) acc))))\n ;; Score and filter\n (let loop ((i 0) (acc []))\n (if (>= i len)\n (begin (sort! acc (lambda (a b) (> (car a) (car b)))) acc)\n (let* ((cand (vector-ref candidates i))\n (score (fzf-score query cand)))\n (loop (+ i 1)\n (if (> score 0)\n (cons (cons score cand) acc)\n acc))))))))\n (set! (fzf-state-filtered state) filtered)\n (set! (fzf-state-match-count state) (length filtered))\n ;; Always reset selection to top when query changes\n (set! (fzf-state-selected state) 0)\n (set! (fzf-state-scroll-offset state) 0)))\n\n;;;============================================================================\n;;; Input handling\n;;;============================================================================\n\n(def (handle-fzf-key state key)\n \"Handle a keypress in fzf mode. Returns #t if state changed.\"\n (let ((filtered (fzf-state-filtered state))\n (selected (fzf-state-selected state))\n (avail (- (fzf-state-height state) 2)))\n (cond\n ;; Enter / Ctrl-J: accept selection\n ((or (and (char? key) (or (= (char->integer key) 13)\n (= (char->integer key) 10)))\n (and (char? key) (= (char->integer key) 10))) ;; Ctrl-J\n (if (pair? filtered)\n (let ((item (fzf-list-ref filtered selected)))\n (if item\n (begin\n (set! (fzf-state-result state)\n (if (fzf-state-multi? state)\n (let ((marked (fzf-state-marked state)))\n (if (null? marked)\n (list (cdr item))\n marked))\n (cdr item)))\n (set! (fzf-state-done? state) #t))\n (set! (fzf-state-done? state) #t)))\n (begin\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t)))\n #t)\n\n ;; Ctrl-C / Escape: cancel\n ((or (and (char? key) (= (char->integer key) 3)) ;; Ctrl-C\n (eq? key 'escape))\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t)\n #t)\n\n ;; Up / Ctrl-P: move selection up (toward top of list)\n ((or (eq? key 'up)\n (and (char? key) (= (char->integer key) 16))) ;; Ctrl-P\n (when (> selected 0)\n (set! (fzf-state-selected state) (- selected 1))\n ;; Scroll if needed\n (when (< (fzf-state-selected state) (fzf-state-scroll-offset state))\n (set! (fzf-state-scroll-offset state) (fzf-state-selected state))))\n #t)\n\n ;; Down / Ctrl-N: move selection down\n ((or (eq? key 'down)\n (and (char? key) (= (char->integer key) 14))) ;; Ctrl-N\n (when (< selected (- (length filtered) 1))\n (set! (fzf-state-selected state) (+ selected 1))\n ;; Scroll if needed\n (when (>= (- (fzf-state-selected state) (fzf-state-scroll-offset state)) avail)\n (set! (fzf-state-scroll-offset state)\n (- (fzf-state-selected state) avail -1))))\n #t)\n\n ;; Tab: toggle mark (multi-select mode)\n ((and (char? key) (= (char->integer key) 9) (fzf-state-multi? state))\n (when (pair? filtered)\n (let* ((item (fzf-list-ref filtered selected))\n (text (and item (cdr item)))\n (marked (fzf-state-marked state)))\n (when text\n (if (member text marked)\n (set! (fzf-state-marked state)\n (filter (lambda (m) (not (string=? m text))) marked))\n (set! (fzf-state-marked state)\n (cons text marked))))))\n ;; Move down after marking\n (when (< selected (- (length filtered) 1))\n (set! (fzf-state-selected state) (+ selected 1)))\n #t)\n\n ;; Ctrl-U: clear query\n ((and (char? key) (= (char->integer key) 21))\n (set! (fzf-state-query state) \"\")\n (set! (fzf-state-cursor state) 0)\n (update-filter! state)\n #t)\n\n ;; Ctrl-W: delete word backward\n ((and (char? key) (= (char->integer key) 23))\n (let* ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (when (> pos 0)\n ;; Skip trailing spaces\n (let skip-sp ((i (- pos 1)))\n (let ((start (if (and (>= i 0) (char=? (string-ref query i) #\\space))\n (skip-sp (- i 1))\n (+ i 1))))\n ;; Skip word chars\n (let skip-word ((i (- start 1)))\n (let ((word-start (if (and (>= i 0)\n (not (char=? (string-ref query i) #\\space)))\n (skip-word (- i 1))\n (+ i 1))))\n (set! (fzf-state-query state)\n (string-append (substring query 0 word-start)\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) word-start)))))))\n (update-filter! state)\n #t)\n\n ;; Backspace: delete char before cursor\n ((and (char? key) (or (= (char->integer key) 127) (= (char->integer key) 8)))\n (let ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (when (> pos 0)\n (set! (fzf-state-query state)\n (string-append (substring query 0 (- pos 1))\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) (- pos 1))\n (update-filter! state)))\n #t)\n\n ;; Ctrl-A: beginning of query\n ((and (char? key) (= (char->integer key) 1))\n (set! (fzf-state-cursor state) 0)\n #t)\n\n ;; Ctrl-E: end of query\n ((and (char? key) (= (char->integer key) 5))\n (set! (fzf-state-cursor state) (string-length (fzf-state-query state)))\n #t)\n\n ;; Page-Up\n ((eq? key 'page-up)\n (set! (fzf-state-selected state) (max 0 (- selected avail)))\n (set! (fzf-state-scroll-offset state)\n (max 0 (- (fzf-state-scroll-offset state) avail)))\n #t)\n\n ;; Page-Down\n ((eq? key 'page-down)\n (let ((max-sel (- (length filtered) 1)))\n (set! (fzf-state-selected state) (min max-sel (+ selected avail)))\n (set! (fzf-state-scroll-offset state)\n (max 0 (- (fzf-state-selected state) avail -1))))\n #t)\n\n ;; Printable character: insert into query\n ((and (char? key) (>= (char->integer key) 32) (not (= (char->integer key) 127)))\n (let ((query (fzf-state-query state))\n (pos (fzf-state-cursor state)))\n (set! (fzf-state-query state)\n (string-append (substring query 0 pos)\n (string key)\n (substring query pos (string-length query))))\n (set! (fzf-state-cursor state) (+ pos 1))\n (update-filter! state))\n #t)\n\n (else #f))))\n\n;;;============================================================================\n;;; Helpers\n;;;============================================================================\n\n(def (fzf-take lst n)\n (if (or (null? lst) (<= n 0)) []\n (cons (car lst) (fzf-take (cdr lst) (- n 1)))))\n\n(def (fzf-drop lst n)\n (if (or (null? lst) (<= n 0)) lst\n (fzf-drop (cdr lst) (- n 1))))\n\n(def (fzf-list-ref lst idx)\n (if (or (null? lst) (< idx 0)) #f\n (if (= idx 0) (car lst)\n (fzf-list-ref (cdr lst) (- idx 1)))))\n\n;;;============================================================================\n;;; Public interface\n;;;============================================================================\n\n(def (fzf-select candidates\n prompt: (prompt \"> \")\n multi?: (multi? #f)\n initial-query: (initial-query \"\"))\n \"Run interactive fuzzy finder on a list of strings.\n Returns: selected string (single mode), list of strings (multi mode), or #f on cancel.\"\n (let ((in-port (current-input-port))\n (out-port (current-error-port)))\n (let-values (((rows cols) (get-terminal-size)))\n (let* ((cand-vec (list->vector candidates))\n (state (make-fzf-state\n cand-vec ;; candidates\n [] ;; filtered\n initial-query ;; query\n (string-length initial-query) ;; cursor\n 0 ;; selected\n 0 ;; scroll-offset\n (vector-length cand-vec) ;; total\n 0 ;; match-count\n rows ;; height\n cols ;; columns\n prompt ;; prompt\n multi? ;; multi?\n [] ;; marked\n #f ;; done?\n #f))) ;; result\n ;; Initial filter\n (update-filter! state)\n ;; Run TUI\n (dynamic-wind\n (lambda ()\n (term-raw! in-port)\n (ansi-alt-screen-on out-port)\n (ansi-hide-cursor out-port)\n (force-output out-port))\n (lambda ()\n (render-fzf state out-port)\n (let loop ()\n (let ((key (read-key in-port)))\n (cond\n ((eq? key 'eof)\n (set! (fzf-state-result state) #f)\n (set! (fzf-state-done? state) #t))\n (else\n (handle-fzf-key state key)))\n (unless (fzf-state-done? state)\n (render-fzf state out-port)\n (loop))))\n (fzf-state-result state))\n (lambda ()\n (ansi-show-cursor out-port)\n (ansi-alt-screen-off out-port)\n (force-output out-port)\n (term-cooked! in-port)))))))\n\n;;;============================================================================\n;;; Convenience: history search via fzf\n;;;============================================================================\n\n(def (fzf-history-search history-commands)\n \"Run fzf on history commands (newest first). Returns selected command or #f.\"\n (fzf-select history-commands prompt: \"(history)> \"))\n\n;;;============================================================================\n;;; Convenience: file finder via fzf\n;;;============================================================================\n\n(def (fzf-find-files (dir \".\") (max-files 50000))\n \"Recursively list files under dir for fzf selection.\n Uses git ls-files in git repos, falls back to filesystem walk.\n Returns selected file path or #f.\"\n (let ((files (collect-files-git dir max-files)))\n (fzf-select files prompt: \"(files)> \")))\n\n(def (collect-files-git dir max-files)\n \"Collect files using git ls-files if in a git repo, else fall back to collect-files.\"\n (with-catch\n (lambda (e) (collect-files dir max-files))\n (lambda ()\n (let* ((proc (open-process (list path: \"git\"\n arguments: (list \"ls-files\" \"--cached\" \"--others\"\n \"--exclude-standard\")\n directory: dir\n stdin-redirection: #f\n stderr-redirection: #f)))\n (files (let loop ((acc []))\n (let ((line (read-line proc)))\n (if (or (eof-object? line) (>= (length acc) max-files))\n (reverse acc)\n (loop (cons line acc))))))\n (status (process-status proc)))\n (if (= status 0)\n files\n (collect-files dir max-files))))))\n\n(def *skip-dirs* '(\".git\" \"node_modules\" \"__pycache__\" \".jerboa\" \".cache\"\n \"venv\" \".venv\" \"target\" \"dist\" \".hg\" \".svn\"))\n\n(def (collect-files dir max-files)\n \"Recursively collect file paths under dir, up to max-files.\"\n (let ((result [])\n (count 0))\n (let walk ((d dir) (prefix \"\"))\n (when (< count max-files)\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let ((entries (directory-files d)))\n (for-each\n (lambda (name)\n (when (and (< count max-files)\n (not (string=? name \".\"))\n (not (string=? name \"..\"))\n ;; Skip hidden files/dirs at all levels\n (not (and (> (string-length name) 0)\n (char=? (string-ref name 0) #\\.)))\n ;; Skip known large directories\n (not (member name *skip-dirs*)))\n (let* ((rel (if (string=? prefix \"\")\n name\n (string-append prefix \"/\" name)))\n (full (string-append d \"/\" name)))\n (if (file-directory? full)\n (walk full rel)\n (begin\n (set! result (cons rel result))\n (set! count (+ count 1)))))))\n entries))))))\n (reverse result)))\n\n;;;============================================================================\n;;; Convenience: directory jump via fzf\n;;;============================================================================\n\n(def (fzf-find-directories (dir \".\") (max-dirs 10000))\n \"Recursively list directories under dir for fzf selection.\n Returns selected directory path or #f.\"\n (let ((dirs (collect-directories dir max-dirs)))\n (fzf-select dirs prompt: \"(dirs)> \")))\n\n(def (collect-directories dir max-dirs)\n \"Recursively collect directory paths under dir.\"\n (let ((result [])\n (count 0))\n (let walk ((d dir) (prefix \"\"))\n (when (< count max-dirs)\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let ((entries (directory-files d)))\n (for-each\n (lambda (name)\n (when (and (< count max-dirs)\n (not (string=? name \".\"))\n (not (string=? name \"..\"))\n ;; Skip hidden dirs at all levels\n (not (and (> (string-length name) 0)\n (char=? (string-ref name 0) #\\.)))\n ;; Skip known large directories\n (not (member name *skip-dirs*)))\n (let* ((rel (if (string=? prefix \"\")\n name\n (string-append prefix \"/\" name)))\n (full (string-append d \"/\" name)))\n (when (file-directory? full)\n (set! result (cons rel result))\n (set! count (+ count 1))\n (walk full rel)))))\n entries))))))\n (reverse result)))\n\n;;;============================================================================\n;;; Register fzf callbacks in lineedit\n;;;============================================================================\n\n(def (fzf-init!)\n \"Register fzf handlers as lineedit callbacks.\"\n (*fzf-history-fn* fzf-history-search)\n (*fzf-files-fn* fzf-find-files)\n (*fzf-dirs-fn* fzf-find-directories))\n"} -{"text":";; FILE: jerboa-shell/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It has legacy shell ancestry but is its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — colon-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from other Scheme implementations, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — non-Jerboa. No direct Chez equivalent\n\n#### Non-Jerboa Scheme-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — non-Jerboa. Use `(std misc process)` API in Jerboa\n- `user-info-home` — non-Jerboa. Use `(getenv \"HOME\")`\n- `the-environment` — non-Jerboa. Use `(interaction-environment)` in Chez\n- `condition/report-string` — non-Jerboa. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — non-Jerboa. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — non-Jerboa. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)`\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)`; use `path-join` for 2-arg\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)`\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/jerboa-orig` — Read-only legacy upstream reference. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port legacy Scheme code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port legacy Scheme**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-shell/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It has legacy shell ancestry but is its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — colon-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from other Scheme implementations, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — non-Jerboa. No direct Chez equivalent\n\n#### Non-Jerboa Scheme-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — non-Jerboa. Use `(std misc process)` API in Jerboa\n- `user-info-home` — non-Jerboa. Use `(getenv \"HOME\")`\n- `the-environment` — non-Jerboa. Use `(interaction-environment)` in Chez\n- `condition/report-string` — non-Jerboa. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — non-Jerboa. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — non-Jerboa. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)`\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)`; use `path-join` for 2-arg\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)`\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/jerboa-orig` — Read-only legacy upstream reference. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port legacy Scheme code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port legacy Scheme**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-shell/redirect.ss\n;;; redirect.ss — File descriptor redirection for gsh\n;;;\n;;; Key insight: external commands launched via open-process with\n;;; stdin/stdout/stderr-redirection: #f inherit REAL file descriptors (0,1,2),\n;;; not Gambit port parameters. So we must manipulate both:\n;;; 1. Real fds via ffi-dup/ffi-dup2/ffi-open-raw\n;;; 2. Gambit port parameters for builtins\n\n(export #t)\n(import :std/sugar\n :std/format\n :jsh/ast\n :jsh/ffi\n :jsh/environment\n :jsh/expander\n :jsh/util)\n\n;;; --- O_* flags for ffi-open-raw ---\n;;; Imported from :jsh/ffi — values are read from libc at runtime, not\n;;; hardcoded, since they differ between Linux/macOS/FreeBSD.\n\n;;; --- Saved state structure ---\n;;; Each entry: (fd saved-real-fd saved-port)\n;;; fd — which fd we redirected (0, 1, 2)\n;;; saved-real-fd — dup'd copy of the original real fd (for restore)\n;;; saved-port — original Gambit port parameter value (for restore)\n\n;;; --- Public interface ---\n\n;; M-4: cap file-creation mode at rw-r--r--. Bash passes #o666 to\n;; open(2) and lets umask do the rest; with a typical umask of 0022\n;; the result is #o644 in either case. Capping at #o644 means a\n;; loose umask (0000, 0002) cannot make a redirect target\n;; world-writable. POSIX/bash behaviour is preserved for every\n;; sane umask value.\n(def redir-default-mode #o644)\n\n;; M-6: when `set -o nofollow` is on, OR O_NOFOLLOW into the open\n;; flags so opening a symlink target fails with ELOOP. Protects\n;; against an attacker pre-placing a symlink at the redirect\n;; target (e.g. ln -s /etc/passwd /tmp/log before the victim runs\n;; \"echo data > /tmp/log\").\n(def (apply-redir-flags env base-flags)\n (if (env-option? env \"nofollow\")\n (bitwise-ior base-flags O_NOFOLLOW)\n base-flags))\n\n;; Apply a list of redirections, return saved state for restoration\n;; Saved state is a flat list of (fd saved-real-fd saved-port) entries\n(def (apply-redirections redirs env)\n (let loop ((redirs redirs) (saved []))\n (if (null? redirs)\n (let ((result (reverse saved)))\n ;; Track which fds are active redirects so ffi-fork-exec can preserve them\n (*active-redirect-fds*\n (append (map car result) (*active-redirect-fds*)))\n result)\n (let* ((redir (car redirs))\n (result (with-catch\n (lambda (e)\n ;; Redirect failed — restore already-applied redirections\n (restore-redirections (reverse saved))\n (raise e))\n (lambda ()\n (apply-single-redirect! redir env)))))\n (cond\n ((not result) (loop (cdr redirs) saved))\n ;; Multi-save: &> and &>> return a list of save entries\n ;; A save entry starts with an integer fd, a list-of-saves\n ;; starts with a list. Distinguish by checking (car result).\n ((integer? (car result))\n ;; Single save entry: (fd saved-real-fd saved-port)\n (loop (cdr redirs) (cons result saved)))\n (else\n ;; List of save entries: ((fd1 ...) (fd2 ...))\n (loop (cdr redirs) (append (reverse result) saved))))))))\n\n;; Restore redirections from saved state\n;; Each entry: (fd saved-real-fd saved-port) or (fd saved-real-fd saved-port new-port)\n(def (restore-redirections saved)\n ;; Remove these fds from the active-redirect tracking\n (let ((restored-fds (map car saved)))\n (*active-redirect-fds*\n (filter (lambda (fd) (not (member fd restored-fds)))\n (*active-redirect-fds*))))\n (for-each\n (lambda (entry)\n (let ((fd (car entry))\n (saved-real-fd (cadr entry))\n (saved-port (caddr entry))\n (new-port (and (> (length entry) 3) (cadddr entry))))\n ;; Flush and close any new port we created (before restoring fd)\n (when new-port\n (with-catch (lambda (e) #!void) (lambda () (force-output new-port)))\n (with-catch (lambda (e) #!void) (lambda () (close-port new-port))))\n ;; Restore the real fd\n (if (>= saved-real-fd 0)\n (begin\n (ffi-dup2 saved-real-fd fd)\n (ffi-close-fd saved-real-fd))\n ;; saved-real-fd is -1: fd wasn't open before, close it to restore\n ;; Only close non-standard fds (never close 0/1/2)\n (when (> fd 2)\n (ffi-close-fd fd)))\n ;; Restore the Gambit port parameter\n (when saved-port\n (case fd\n ((0) (current-input-port saved-port))\n ((1) (current-output-port saved-port))\n ((2) (current-error-port saved-port))))))\n (reverse saved)))\n\n;; Apply redirections permanently (for exec without command)\n;; Does not save original fds — changes are permanent\n(def (apply-redirections-permanent! redirs env)\n (for-each\n (lambda (redir) (apply-single-redirect-permanent! redir env))\n redirs))\n\n;;; --- Single redirection ---\n\n(def (expand-redir-target-nosplit target env)\n (if (word-process-sub? target)\n (expand-process-sub target env)\n (expand-word-nosplit target env)))\n\n(def (expand-redir-target target env)\n (if (word-process-sub? target)\n (list (expand-process-sub target env))\n (expand-word target env)))\n\n(def (apply-process-sub-input-redirect! fd psub env)\n (let ((exec-fn (*execute-input*)))\n (unless exec-fn\n (error #f \"process substitution unavailable during redirect\"))\n (let ((save (save-fd fd)))\n (let-values (((read-fd write-fd) (ffi-pipe-raw)))\n (let* ((thread-write-fd (ffi-dup write-fd))\n (cmd-text (word-process-sub-command psub))\n (th\n (spawn\n (lambda ()\n (with-catch\n (lambda (e) #!void)\n (lambda ()\n (let* ((port-fd (ffi-dup thread-write-fd))\n (port (open-fd-output-port port-fd\n (buffer-mode block)\n (native-transcoder)))\n (sub-env (env-clone env)))\n (unwind-protect\n (parameterize ((*in-subshell* #t)\n (*pipeline-stdin-fd* #f)\n (*pipeline-stdout-fd* thread-write-fd))\n (parameterize ((current-output-port port))\n (exec-fn cmd-text sub-env)\n (force-output port)))\n (begin\n (with-catch (lambda (e) #!void)\n (lambda () (force-output port)))\n (with-catch (lambda (e) #!void)\n (lambda () (close-port port)))\n (with-catch (lambda (e) #!void)\n (lambda () (ffi-close-fd thread-write-fd))))))))))))\n (ffi-close-fd write-fd)\n (unless (= read-fd fd)\n (ffi-dup2 read-fd fd)\n (ffi-close-fd read-fd))\n (when (= fd 0)\n (current-input-port\n (transcoded-port\n (open-fd-input-port (ffi-dup fd) (buffer-mode block) #f)\n (make-transcoder (utf-8-codec)))))\n (*procsub-cleanups*\n (cons (lambda ()\n (with-catch (lambda (e) #!void)\n (lambda () (thread-join! th))))\n (*procsub-cleanups*)))\n save)))))\n\n(def (apply-single-redirect! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir)))\n ;; Named fd {varname}> handled separately (except {varname}>&- which is close)\n (if (and fd-var\n (not (and (memq op '(>& <&))\n (string=? (redir-target redir) \"-\"))))\n (apply-named-fd-redirect! redir env)\n ;; Normal redirect (or named fd close)\n (let* ((fd (cond\n ;; Named fd close: {varname}>&- — resolve variable\n (fd-var\n (let ((val (env-get env fd-var)))\n (or (and val (string->number val))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: Bad file descriptor~n\" fd-var)\n (error #f (string-append fd-var \": Bad file descriptor\"))))))\n ;; Explicit numeric fd\n ((redir-fd redir) => values)\n ;; Default fd for the operator\n (else (default-fd-for-op op)))))\n (if (and (eq? op '<)\n (word-process-sub? (redir-target redir))\n (eq? (word-process-sub-direction (redir-target redir)) 'in))\n (apply-process-sub-input-redirect! fd (redir-target redir) env)\n (let ((target-str (cond\n ((memq op '(<< <<- <<< <<q <<-q))\n ;; Heredocs/herestrings: expand but no word splitting validation\n (cond\n ((memq op '(<<q <<-q)) (redir-target redir))\n ((eq? op '<<<)\n (expand-redir-target-nosplit (redir-target redir) env))\n (else (expand-heredoc-body (redir-target redir) env))))\n ;; Fd dup targets (&> / <&): don't validate as file\n ((memq op '(>& <&))\n (expand-redir-target-nosplit (redir-target redir) env))\n (else\n ;; File redirect: validate target\n (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w))))))))\n (case op\n ;; < file — input from file\n ((<)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str O_RDONLY 0)\n ;; Create Gambit port for builtins\n (when (= fd 0)\n (current-input-port (open-input-file target-str)))\n save))\n ;; > file — output to file (truncate)\n ;;\n ;; noclobber semantics: refuse to overwrite an existing regular\n ;; file. The pre-2026 implementation did a separate file-regular?\n ;; check then opened with O_TRUNC, so a concurrent process could\n ;; create the file between the check and the open and we'd\n ;; obliterate it anyway. With O_CREAT|O_EXCL|O_WRONLY the kernel\n ;; atomically fails the open with EEXIST and there is no race.\n ;; Without noclobber we use the classic O_TRUNC which clobbers.\n ((>)\n (let* ((save (save-fd fd))\n (noclobber? (env-option? env \"noclobber\"))\n (flags (apply-redir-flags env\n (if noclobber?\n (bitwise-ior O_WRONLY O_CREAT O_EXCL)\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n (let ((raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n ;; POSIX noclobber applies only to regular files: > /dev/null and\n ;; other non-regular paths must succeed. If O_EXCL refused the open\n ;; and the path is a non-regular file, retry without O_EXCL.\n (when (and (< raw-fd 0) noclobber?)\n (let ((ftype (ffi-file-type target-str 1)))\n (when (and (> ftype 0) (not (= ftype 2)))\n (let ((retry-flags (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))))\n (set! raw-fd (ffi-open-raw target-str retry-flags redir-default-mode))))))\n (when (< raw-fd 0)\n (restore-single! save)\n (if noclobber?\n (fprintf (current-error-port)\n \"jsh: ~a: cannot overwrite existing file~n\" target-str)\n (fprintf (current-error-port)\n \"jsh: ~a: cannot open file~n\" target-str))\n (error #f\n (if noclobber? \"cannot overwrite existing file\" \"cannot open file\")\n target-str))\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd)))\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'truncate)))\n (append save (list new-port)))\n save)))\n ;; >> file — output to file (append)\n ((>>)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'append)))\n (append save (list new-port)))\n save)))\n ;; clobber (>|) — output to file ignoring noclobber\n ((clobber)\n (let ((save (save-fd fd)))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (if (or (= fd 1) (= fd 2))\n (let ((new-port (set-port-for-fd! fd target-str 'truncate)))\n (append save (list new-port)))\n save)))\n ;; &> file — stdout+stderr to file\n ((&>)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n ;; stderr → same as stdout\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port))\n ;; Return both saves\n (list save1 save2)))\n ;; &>> file — stdout+stderr append\n ((&>>)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'append)))\n (current-output-port port)\n (current-error-port port))\n (list save1 save2)))\n ;; << heredoc — here-document\n ;;\n ;; We back the heredoc body with memfd_create (anonymous in-memory\n ;; file) rather than a pipe. The original pipe-based design wrote\n ;; the entire body to the pipe's write end before letting the\n ;; reader consume it — fine for short bodies, but the kernel pipe\n ;; buffer is 64 KiB on Linux and the writer is the same process\n ;; that's supposed to read it, so any body that fills the buffer\n ;; deadlocks. memfd has no such ceiling and ffi_memfd_create\n ;; already lseeks back to 0, so the consumer reads cleanly.\n ;; macOS / FreeBSD fall back to an anonymized mkstemp inside\n ;; ffi_memfd_create, so the same code path works everywhere.\n ((<< <<- <<q <<-q)\n (let ((save (save-fd fd)))\n (let ((mfd (ffi-memfd-create \"jsh-heredoc\" (string->utf8 target-str))))\n (when (< mfd 0)\n (error #f \"heredoc: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd)))\n (when (= fd 0)\n (current-input-port (open-input-string target-str)))\n save))\n ;; <<< word — here-string\n ((<<<)\n (let ((save (save-fd fd)))\n (let ((mfd (ffi-memfd-create \"jsh-herestring\"\n (string->utf8 (string-append target-str \"\\n\")))))\n (when (< mfd 0)\n (error #f \"here-string: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd)))\n (current-input-port (open-input-string (string-append target-str \"\\n\")))\n save))\n ;; >& n — dup fd (or close with >& -)\n ;; >& word — when word is not a number or -, redirect both stdout+stderr to file\n ((>&)\n (cond\n ((string=? target-str \"-\")\n ;; Close fd\n (let ((save (save-fd fd)))\n (ffi-close-fd fd)\n save))\n (else\n ;; Check for fd move: N- means dup N then close N\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (cond\n (target-fd\n (let ((save (save-fd fd)))\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (restore-single! save)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n ;; Close source fd if this is a move operation (N-)\n (when close-source?\n (ffi-close-fd target-fd))\n ;; Update Gambit port: if the source fd is not a standard\n ;; Gambit port (0/1/2), create a fresh port via /dev/fd/N\n ;; to avoid sendto-on-non-socket errors when Gambit cached\n ;; the fd type at startup. Track the new port in save for cleanup.\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; High fd → standard fd: try to create fresh Gambit port\n ;; If /dev/fd/N fails (e.g., socket), keep existing port\n (let ((new-port (make-port-for-fd fd)))\n (if new-port\n (begin\n (set-current-port-for-fd! fd new-port)\n (append save (list new-port)))\n save))\n ;; Standard fd → standard fd: copy existing Gambit port\n (begin (dup-gambit-port! target-fd fd)\n save)))))\n ;; Only treat as &> if fd was NOT explicitly specified\n ;; 1>&file → error (bad file descriptor)\n ;; >&file → equivalent to &>file\n ((redir-fd redir)\n (error #f (string-append target-str \": Bad file descriptor\")))\n (else\n ;; Not a number, no explicit fd → treat as &> (redirect stdout+stderr to file)\n (let ((save1 (save-fd 1))\n (save2 (save-fd 2)))\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port))\n (list save1 save2)))))))))\n ;; <& n — dup fd for input\n ((<&)\n (cond\n ((string=? target-str \"-\")\n (let ((save (save-fd fd)))\n (ffi-close-fd fd)\n save))\n (else\n ;; Check for fd move: N- means dup N then close N\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (if target-fd\n (let ((save (save-fd fd)))\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (restore-single! save)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (if new-port\n (begin\n (set-current-port-for-fd! fd new-port)\n (append save (list new-port)))\n save))\n (begin (dup-gambit-port! target-fd fd)\n save))))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: bad file descriptor~n\" target-str)\n #f)))))))\n ;; <> file — open read-write on fd\n ;; For FIFOs, use O_NONBLOCK to avoid blocking, then clear it\n ((<>)\n (let ((save (save-fd fd)))\n ;; Open with O_NONBLOCK to prevent blocking on FIFO\n (let ((raw-fd (ffi-open-raw target-str (bitwise-ior O_RDWR O_NONBLOCK) redir-default-mode)))\n (when (< raw-fd 0)\n (restore-single! save)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Clear O_NONBLOCK flag after successful open\n (let ((flags (ffi-fcntl-getfl raw-fd)))\n (when (>= flags 0)\n (ffi-fcntl-setfl raw-fd (bitwise-and flags (bitwise-not O_NONBLOCK)))))\n ;; dup2 onto target fd and close original\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd)))\n save))\n (else\n (fprintf (current-error-port) \"jsh: unsupported redirect operator ~a~n\" op)\n #f))))))))\n\n;; Apply named fd redirect: {varname}>file — auto-allocate fd >= 10\n(def (apply-named-fd-redirect! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir))\n (target-str (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w)))))\n ;; Determine open flags based on operator\n (flags (apply-redir-flags env\n (case op\n ((<) O_RDONLY)\n ((>) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((>>) (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n ((clobber) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((<>) O_RDWR)\n (else (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n ;; Open the file to get a raw fd\n (raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Allocate fd >= 10, skipping any Gambit-internal fds\n ;; ffi-dup-above calls fcntl(F_DUPFD, min) which skips occupied fds\n (let ((high-fd (ffi-dup-above raw-fd 10)))\n (ffi-close-fd raw-fd)\n ;; Store the fd number in the variable\n (env-set! env fd-var (number->string high-fd))\n ;; Named fds stay open after the command (bash behavior).\n ;; They are only closed explicitly with {varname}>&-\n ;; Return #f so apply-redirections doesn't track this for restore.\n #f)))\n\n;; Apply a single redirect permanently (for exec)\n;; Same logic but no save/restore\n(def (apply-single-redirect-permanent! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir)))\n ;; Named fd {varname}> handled separately (except close)\n (if (and fd-var\n (not (and (memq op '(>& <&))\n (string=? (redir-target redir) \"-\"))))\n (apply-named-fd-redirect-permanent! redir env)\n (let* ((fd (cond\n (fd-var\n (let ((val (env-get env fd-var)))\n (or (and val (string->number val))\n (begin\n (fprintf (current-error-port) \"jsh: ~a: Bad file descriptor~n\" fd-var)\n (error #f (string-append fd-var \": Bad file descriptor\"))))))\n ((redir-fd redir) => values)\n (else (default-fd-for-op op))))\n (target-str (cond\n ((memq op '(<< <<- <<< <<q <<-q))\n (cond\n ((memq op '(<<q <<-q)) (redir-target redir))\n ((eq? op '<<<)\n (expand-redir-target-nosplit (redir-target redir) env))\n (else (expand-heredoc-body (redir-target redir) env))))\n ((memq op '(>& <&))\n (expand-redir-target-nosplit (redir-target redir) env))\n (else\n (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w))))))))\n (case op\n ((<) (redirect-fd-to-file! fd target-str O_RDONLY 0)\n (when (= fd 0)\n (current-input-port (open-input-file target-str))))\n ((>) (let* ((noclobber? (env-option? env \"noclobber\"))\n (flags (apply-redir-flags env\n (if noclobber?\n (bitwise-ior O_WRONLY O_CREAT O_EXCL)\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n ;; noclobber: O_EXCL atomically refuses if the file exists.\n ;; Retry without O_EXCL if target is a non-regular file (POSIX:\n ;; noclobber applies only to regular files, so > /dev/null etc.\n ;; must succeed).\n (if (and noclobber?\n (let ((ftype (ffi-file-type target-str 1)))\n (and (> ftype 0) (not (= ftype 2)))))\n (redirect-fd-to-file! fd target-str\n (apply-redir-flags env (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (redirect-fd-to-file! fd target-str flags redir-default-mode)))\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'truncate)))\n ((>>) (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'append)))\n ((clobber) (redirect-fd-to-file! fd target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (when (or (= fd 1) (= fd 2))\n (set-port-for-fd! fd target-str 'truncate)))\n ((&>) (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port)))\n ((&>>) (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'append)))\n (current-output-port port)\n (current-error-port port)))\n ((>&)\n (cond\n ((string=? target-str \"-\")\n (ffi-close-fd fd))\n (else\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (cond\n (target-fd\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (when new-port\n (set-current-port-for-fd! fd new-port)))\n (dup-gambit-port! target-fd fd))))\n ((redir-fd redir)\n (error #f (string-append target-str \": Bad file descriptor\")))\n (else\n ;; >&word → redirect both stdout+stderr to file\n (redirect-fd-to-file! 1 target-str\n (apply-redir-flags env\n (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n redir-default-mode)\n (ffi-dup2 1 2)\n (let ((port (open-output-file target-str 'truncate)))\n (current-output-port port)\n (current-error-port port)))))))))\n ((<&)\n (cond\n ((string=? target-str \"-\")\n (ffi-close-fd fd))\n (else\n (let-values (((actual-target close-source?)\n (if (and (> (string-length target-str) 1)\n (char=? (string-ref target-str (- (string-length target-str) 1)) #\\-)\n (string->number (substring target-str 0 (- (string-length target-str) 1))))\n (values (substring target-str 0 (- (string-length target-str) 1)) #t)\n (values target-str #f))))\n (let ((target-fd (string->number actual-target)))\n (if target-fd\n (let ((r (ffi-dup2 target-fd fd)))\n (when (< r 0)\n (error #f (string-append (number->string target-fd) \": Bad file descriptor\")))\n (when close-source?\n (ffi-close-fd target-fd))\n (if (and (<= 0 fd 2) (not (<= 0 target-fd 2)))\n ;; Try to create fresh port; keep existing if it fails\n (let ((new-port (make-port-for-fd fd)))\n (when new-port\n (set-current-port-for-fd! fd new-port)))\n (dup-gambit-port! target-fd fd)))\n (fprintf (current-error-port) \"jsh: ~a: bad file descriptor~n\" target-str)))))))\n ;; <> file — open read-write (permanent)\n ;; For FIFOs, use O_NONBLOCK to avoid blocking, then clear it\n ((<>)\n ;; Open with O_NONBLOCK to prevent blocking on FIFO\n (let ((raw-fd (ffi-open-raw target-str (bitwise-ior O_RDWR O_NONBLOCK) redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n ;; Clear O_NONBLOCK flag after successful open\n (let ((flags (ffi-fcntl-getfl raw-fd)))\n (when (>= flags 0)\n (ffi-fcntl-setfl raw-fd (bitwise-and flags (bitwise-not O_NONBLOCK)))))\n ;; dup2 onto target fd and close original\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd))))\n ;; << heredoc (permanent) — same memfd approach as the saved-fd\n ;; version above; avoids pipe-buffer deadlock on bodies >64 KiB.\n ((<< <<- <<q <<-q)\n (let ((mfd (ffi-memfd-create \"jsh-heredoc\" (string->utf8 target-str))))\n (when (< mfd 0)\n (error #f \"heredoc: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd))\n (when (= fd 0)\n (current-input-port (open-input-string target-str)))))\n ;; <<< here-string (permanent)\n ((<<<)\n (let ((mfd (ffi-memfd-create \"jsh-herestring\"\n (string->utf8 (string-append target-str \"\\n\")))))\n (when (< mfd 0)\n (error #f \"here-string: memfd_create failed\"))\n (ffi-dup2 mfd fd)\n (unless (= mfd fd)\n (ffi-close-fd mfd))\n (current-input-port (open-input-string (string-append target-str \"\\n\")))))\n (else (fprintf (current-error-port) \"jsh: unsupported redirect operator ~a~n\" op)))))))\n\n;; Apply named fd redirect permanently: {varname}>file\n(def (apply-named-fd-redirect-permanent! redir env)\n (let* ((op (redir-op redir))\n (fd-var (redir-fd-var redir))\n (target-str (let ((words (expand-redir-target (redir-target redir) env)))\n (cond\n ((or (null? words) (> (length words) 1))\n (error #f \"ambiguous redirect\"))\n (else\n (let ((w (car words)))\n (when (string=? w \"\")\n (error #f \": No such file or directory\"))\n w)))))\n (flags (apply-redir-flags env\n (case op\n ((<) O_RDONLY)\n ((>) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((>>) (bitwise-ior O_WRONLY O_CREAT O_APPEND))\n ((clobber) (bitwise-ior O_WRONLY O_CREAT O_TRUNC))\n ((<>) O_RDWR)\n (else (bitwise-ior O_WRONLY O_CREAT O_TRUNC)))))\n (raw-fd (ffi-open-raw target-str flags redir-default-mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" target-str)\n (error #f \"cannot open file\" target-str))\n (let ((high-fd (ffi-dup-above raw-fd 10)))\n (ffi-close-fd raw-fd)\n (env-set! env fd-var (number->string high-fd)))))\n\n;;; --- Helpers ---\n\n(def (default-fd-for-op op)\n (case op\n ((< << <<- <<q <<-q <<< <& <>) 0)\n ((> >> clobber >& &> &>>) 1)\n (else 0)))\n\n;; Minimum fd for save-fd — must be above any user-visible fd range\n;; Named fds start at 10, bash tests use up to ~100, Gambit internal ~255\n(def SAVE-FD-MIN 200)\n\n;; Save the real fd + Gambit port for later restoration\n;; Returns (fd saved-real-fd saved-port)\n;; Uses ffi-dup-above to save to fd >= SAVE-FD-MIN\n(def (save-fd fd)\n (let ((saved-real-fd (ffi-dup-above fd SAVE-FD-MIN))\n (saved-port (case fd\n ((0) (current-input-port))\n ((1) (current-output-port))\n ((2) (current-error-port))\n (else #f))))\n (list fd saved-real-fd saved-port)))\n\n;; Restore a single save entry\n(def (restore-single! save)\n (let ((fd (car save))\n (saved-real-fd (cadr save))\n (saved-port (caddr save)))\n (when (>= saved-real-fd 0)\n (ffi-dup2 saved-real-fd fd)\n (ffi-close-fd saved-real-fd))\n (when saved-port\n (case fd\n ((0) (current-input-port saved-port))\n ((1) (current-output-port saved-port))\n ((2) (current-error-port saved-port))))))\n\n;; Open a file and dup2 onto target fd\n(def (redirect-fd-to-file! fd filename flags mode)\n (let ((raw-fd (ffi-open-raw filename flags mode)))\n (when (< raw-fd 0)\n (fprintf (current-error-port) \"jsh: ~a: No such file or directory~n\" filename)\n (error #f \"cannot open file\" filename))\n (unless (= raw-fd fd)\n (ffi-dup2 raw-fd fd)\n (ffi-close-fd raw-fd))))\n\n;; Set Gambit port parameter for an output fd. Returns the new port.\n;; Opens the file directly to create a character port for builtins.\n;; Note: this creates an independent file description with its own offset.\n;; External commands writing to fd 1 may have a different offset — the caller\n;; must sync offsets before forking (see execute-external's ffi-lseek-end).\n(def (set-port-for-fd! fd filename mode)\n (let ((port (case mode\n ((truncate) (open-output-file filename 'truncate))\n ((append) (open-output-file filename 'append)))))\n (case fd\n ((1) (current-output-port port))\n ((2) (current-error-port port)))\n port))\n\n;; Create a fresh Gambit port for a standard fd (0/1/2) after dup2\n;; Uses /dev/fd/N so Gambit creates a proper port with write() not sendto()\n;; Returns #f if /dev/fd/N cannot be opened (e.g., fd points to a socket)\n(def (make-port-for-fd fd)\n (with-catch\n (lambda (e) #f) ;; Return #f if open fails (e.g., socket, ENXIO)\n (lambda ()\n (case fd\n ((0) (open-input-file (string-append \"/dev/fd/\" (number->string fd))))\n ((1 2) (open-output-file (string-append \"/dev/fd/\" (number->string fd))\n 'append))))))\n\n;; Set current-input/output/error-port for a standard fd\n(def (set-current-port-for-fd! fd port)\n (case fd\n ((0) (current-input-port port))\n ((1) (current-output-port port))\n ((2) (current-error-port port))))\n\n;; Duplicate Gambit port from source-fd to dest-fd\n(def (dup-gambit-port! source-fd dest-fd)\n (let ((source-port (case source-fd\n ((0) (current-input-port))\n ((1) (current-output-port))\n ((2) (current-error-port))\n (else #f))))\n (when source-port\n (case dest-fd\n ((0) (current-input-port source-port))\n ((1) (current-output-port source-port))\n ((2) (current-error-port source-port))))))\n\n;; Convert redirections to open-process settings (kept for compatibility)\n(def (redirections->process-settings redirs env)\n ;; With real fd redirection, we always use #f for stdin/stdout/stderr-redirection\n ;; to let the child inherit real fds. This function is kept for cases\n ;; where we need to know if redirections exist.\n [])\n"} {"text":";; FILE: jerboa-shell/registry.ss\n;;; registry.ss — Built-in command registry for jsh\n;;;\n;;; Separated from builtins.ss to avoid circular dependency with macros.ss\n\n(export #t)\n(import :std/sort)\n\n;;; --- Build tier ---\n;; Set by stage.ss at module init time. Controls feature availability.\n;; Values: \"tiny\" (shell only), \"small\" (+eval), \"medium\" (+compiler), \"large\" (+coreutils)\n(def *jsh-tier* (make-parameter \"tiny\"))\n\n;;; --- Built-in registry ---\n\n(def *builtins* (make-hash-table))\n\n;; Register a built-in command\n(def (builtin-register! name handler)\n (hash-put! *builtins* name handler))\n\n;; Look up a built-in by name\n(def (builtin-lookup name)\n (hash-get *builtins* name))\n\n;; List all built-in names\n(def (builtin-list)\n (sort! (hash-keys *builtins*) string<?))\n\n;; Check if a name is a built-in\n(def (builtin? name)\n (and (builtin-lookup name) #t))\n\n;;; --- Programmable completion registry ---\n\n(def *complete-specs* (make-hash-table))\n\n(def (complete-register! command spec)\n (hash-put! *complete-specs* command spec))\n\n(def (complete-unregister! command)\n (hash-remove! *complete-specs* command))\n\n(def (complete-get-spec command)\n (hash-get *complete-specs* command))\n\n(def (complete-list-specs)\n (sort! (hash-keys *complete-specs*) string<?))\n\n;;; --- Meta-command registry (,commands) ---\n;;; Packages register handlers here at module load time.\n;;; Handler signature: (lambda (args-string) => (cons output-string exit-code))\n;;; Completion handler signature:\n;;; (lambda (current-word words word-index line cursor env) => list-of-strings)\n\n(def *meta-commands* (make-hash-table))\n(def *meta-complete-handlers* (make-hash-table))\n\n(def (meta-register! name handler description)\n (hash-put! *meta-commands* name (cons handler description)))\n\n(def (meta-complete-register! name handler)\n (hash-put! *meta-complete-handlers* name handler))\n\n(def (meta-lookup name)\n (let ([entry (hash-get *meta-commands* name)])\n (and entry (car entry))))\n\n(def (meta-complete-lookup name)\n (hash-get *meta-complete-handlers* name))\n\n(def (meta-list)\n (sort! (hash-keys *meta-commands*) string<?))\n\n(def (meta-description name)\n (let ([entry (hash-get *meta-commands* name)])\n (if entry (cdr entry) \"\")))\n"} {"text":";; FILE: jerboa-shell/util.ss\n;;; util.ss — Shared utilities for gsh\n\n(export #t file-regular? file-directory?)\n(import (except-in :std/misc/string string-join string-index string-contains)\n (prefix (std misc string) std-string:)\n (except-in :std/misc/path path-normalize)\n ./pregexp-compat\n :std/format\n :std/sugar\n :std/iter\n (except-in :std/error error-message error-irritants error-trace)\n :jsh/ffi)\n\n;;; --- open-process string encoding ---\n\n;; Encode a Scheme string to C-safe Latin-1 for Gambit's open-process.\n;; Gambit can't convert chars > 127 to C char-strings.\n;; Converts unicode chars to their UTF-8 byte representation as Latin-1 chars.\n(def (string->c-safe s)\n (let ((len (string-length s)))\n (let check ((i 0))\n (cond ((>= i len) s)\n ((< (char->integer (string-ref s i)) 128) (check (+ i 1)))\n (else\n (let* ((u8 (string->bytes s))\n (u8len (u8vector-length u8))\n (out (make-string u8len)))\n (let loop ((j 0))\n (if (>= j u8len) out\n (begin (string-set! out j (integer->char (u8vector-ref u8 j)))\n (loop (+ j 1)))))))))))\n\n;;; --- waitpid status decoders (shell-level) ---\n\n;; Decode raw waitpid status to a shell exit code (0-255)\n(def (status->exit-code raw-status)\n (cond\n ((WIFEXITED raw-status)\n (WEXITSTATUS raw-status))\n ((WIFSIGNALED raw-status)\n (+ 128 (WTERMSIG raw-status)))\n ((WIFSTOPPED raw-status)\n (+ 128 (WSTOPSIG raw-status)))\n (else 255)))\n\n;;; --- Process launching ---\n\n;; Launch an external command via open-process, ensuring SIGPIPE is\n;; unblocked for the child. Gambit blocks SIGPIPE (sigprocmask),\n;; which children inherit through fork+exec, causing commands like\n;; cat to get EPIPE (exit 1) instead of being killed by SIGPIPE (exit 141).\n(def (open-process-with-sigpipe settings)\n (ffi-sigpipe-unblock)\n (let ((proc (open-process settings)))\n (ffi-sigpipe-block)\n proc))\n\n;;; --- SOH packing for ffi-execve / ffi-fork-exec ---\n\n;; Pack a list of strings with SOH (char 1) delimiter\n(def *soh* (make-string 1 (integer->char 1)))\n(def (pack-with-soh strs)\n (if (null? strs) \"\"\n (call-with-output-string\n (lambda (port)\n (display (car strs) port)\n (for-each (lambda (s)\n (display *soh* port)\n (display s port))\n (cdr strs))))))\n\n;; Pack a list of integers as SOH-delimited string of their decimal representations\n(def (pack-fds-with-soh fds)\n (pack-with-soh (map number->string fds)))\n\n;;; --- String utilities ---\n\n(def (string-trim-whitespace str)\n (let* ((len (string-length str))\n (start (let loop ((i 0))\n (if (and (< i len) (char-whitespace? (string-ref str i)))\n (loop (+ i 1)) i)))\n (end (let loop ((i (- len 1)))\n (if (and (>= i start) (char-whitespace? (string-ref str i)))\n (loop (- i 1)) (+ i 1)))))\n (substring str start end)))\n\n;; Split string by any character in charset (a string of delimiters)\n(def (string-split-chars str charset)\n (let loop ((i 0) (start 0) (result []))\n (cond\n ((>= i (string-length str))\n (reverse (if (> i start)\n (cons (substring str start i) result)\n result)))\n ((string-index charset (string-ref str i))\n (loop (+ i 1) (+ i 1)\n (if (> i start)\n (cons (substring str start i) result)\n result)))\n (else\n (loop (+ i 1) start result)))))\n\n;; Check if char is in string\n(def (string-index str ch)\n (let loop ((i 0))\n (cond\n ((>= i (string-length str)) #f)\n ((char=? (string-ref str i) ch) i)\n (else (loop (+ i 1))))))\n\n;; Substring test\n(def (string-contains? haystack needle)\n (and (std-string:string-contains haystack needle) #t))\n\n;; Join strings with separator.\n(def (string-join lst sep)\n (std-string:string-join lst sep))\n\n;; Find last occurrence of character in string\n(def (string-last-index-of str ch)\n (let loop ((i (- (string-length str) 1)))\n (cond\n ((< i 0) #f)\n ((char=? (string-ref str i) ch) i)\n (else (loop (- i 1))))))\n\n;;; --- Path / filesystem utilities ---\n\n;; Search PATH for an executable, return full path or #f\n(def (which name)\n (if (string-contains? name \"/\")\n ;; Absolute or relative path — resolve to absolute for the executability\n ;; check (ffi-access needs absolute path since Gambit's current-directory\n ;; doesn't match OS cwd), but return original name for display\n (let ((resolved (path-expand name)))\n (and (file-exists? resolved) (executable? resolved) name))\n ;; Search PATH\n (let ((path-dirs (string-split-chars (or (getenv \"PATH\" #f) \"/usr/bin:/bin\") \":\")))\n (let loop ((dirs path-dirs))\n (if (null? dirs) #f\n (let ((full (string-append (car dirs) \"/\" name)))\n (if (and (file-exists? full) (executable? full))\n full\n (loop (cdr dirs)))))))))\n\n;; Search PATH for a regular file (not directory), no execute requirement\n;; Used by source/. to find files to source\n;; Optional path-str parameter overrides getenv lookup (for temp env assignments)\n(def (find-file-in-path name (path-str #f))\n (let ((path-dirs (string-split-chars (or path-str (getenv \"PATH\" #f) \"/usr/bin:/bin\") \":\")))\n (let loop ((dirs path-dirs))\n (if (null? dirs) #f\n (let ((full (string-append (car dirs) \"/\" name)))\n (if (and (file-exists? full)\n (not (file-directory? full)))\n full\n (loop (cdr dirs))))))))\n\n;; Check if file is executable (by current user)\n(def (executable? path)\n (and (not (file-directory? path))\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 1) 0))))) ;; X_OK = 1\n\n;; Return home directory\n(def (home-directory)\n (or (getenv \"HOME\" #f)\n (with-catch\n (lambda (e) \"/\")\n (lambda () (user-info-home (user-info (user-name)))))))\n\n;; Expand ~ and ~user at the start of a path\n(def (expand-tilde path)\n (cond\n ((string=? path \"~\") (home-directory))\n ((and (> (string-length path) 1)\n (char=? (string-ref path 0) #\\~)\n (char=? (string-ref path 1) #\\/))\n (string-append (home-directory) (substring path 1 (string-length path))))\n ((and (> (string-length path) 1)\n (char=? (string-ref path 0) #\\~))\n ;; ~user form\n (let* ((slash-pos (string-index path #\\/))\n (username (if slash-pos\n (substring path 1 slash-pos)\n (substring path 1 (string-length path)))))\n (with-catch\n (lambda (e) path) ;; return as-is if user not found\n (lambda ()\n (let ((home (user-info-home (user-info username))))\n (if slash-pos\n (string-append home (substring path slash-pos (string-length path)))\n home))))))\n (else path)))\n\n;; Read all lines from a file\n(def (read-file-lines path)\n (if (file-exists? path)\n (call-with-input-file path\n (lambda (port)\n (let loop ((lines []))\n (let ((line (read-line port)))\n (if (eof-object? line)\n (reverse lines)\n (loop (cons line lines)))))))\n []))\n\n;;; --- Exception utilities ---\n\n;; Extract a message string from any exception.\n;; Chez-native: uses condition predicates instead of Gambit's error-exception?.\n(def (exception-message e)\n (define (format-condition c)\n (let ([msg (call-with-string-output-port\n (lambda (p) (display-condition c p)))])\n ;; display-condition prefixes with \"Exception: \" or \"Exception in WHO: \" —\n ;; strip those so callers get just the message text.\n (cond\n [(and (> (string-length msg) 11)\n (string=? (substring msg 0 11) \"Exception: \"))\n (substring msg 11 (string-length msg))]\n [(and (> (string-length msg) 13)\n (string=? (substring msg 0 13) \"Exception in \"))\n (let loop ([i 13])\n (cond\n [(>= (+ i 1) (string-length msg)) msg]\n [(and (char=? (string-ref msg i) #\\:)\n (char=? (string-ref msg (+ i 1)) #\\space))\n (substring msg (+ i 2) (string-length msg))]\n [else (loop (+ i 1))]))]\n [else msg])))\n (cond\n [(string? e) e]\n [(condition? e) (format-condition e)]\n [else (call-with-string-output-port\n (lambda (p) (display e p)))]))\n\n;; Run thunk, return result or #f on exception\n(def (try-or-false thunk)\n (with-catch (lambda (e) #f) thunk))\n\n;;; --- Misc ---\n\n;; Safe substring that doesn't error on out-of-bounds\n(def (safe-substring str start end)\n (let ((len (string-length str)))\n (substring str (min start len) (min end len))))\n\n;; Repeat a character n times\n(def (make-string-repeated ch n)\n (make-string n ch))\n\n;; Check if a string is a valid shell name (variable name)\n(def (valid-name? str)\n (and (> (string-length str) 0)\n (let ((ch (string-ref str 0)))\n (or (char-alphabetic? ch) (char=? ch #\\_)))\n (let loop ((i 1))\n (or (>= i (string-length str))\n (let ((ch (string-ref str i)))\n (and (or (char-alphabetic? ch) (char-numeric? ch) (char=? ch #\\_))\n (loop (+ i 1))))))))\n\n;; Check if string is a valid integer\n(def (string->integer str)\n (with-catch\n (lambda (e) #f)\n (lambda ()\n (let ((n (string->number str)))\n (and (integer? n) (exact? n) n)))))\n\n(def (string-upcase str)\n (list->string (map char-upcase (string->list str))))\n\n(def (string-downcase str)\n (list->string (map char-downcase (string->list str))))\n\n;; Check if a string contains control characters (chars < 0x20 or 0x7f)\n(def (string-has-control-chars? s)\n (let ((len (string-length s)))\n (let loop ((i 0))\n (if (>= i len) #f\n (let ((c (char->integer (string-ref s i))))\n (if (or (< c #x20) (= c #x7f))\n #t\n (loop (+ i 1))))))))\n\n(def (hex-char? ch)\n (or (and (char>=? ch #\\0) (char<=? ch #\\9))\n (and (char>=? ch #\\a) (char<=? ch #\\f))\n (and (char>=? ch #\\A) (char<=? ch #\\F))))\n\n;; Count UTF-8 code points in a string.\n;; If the string contains actual unicode chars (char-integer > 127),\n;; string-length is already correct. But if it contains raw bytes\n;; from command substitution (Latin-1 encoding), we need to count\n;; UTF-8 sequences by examining lead bytes.\n(def (utf8-string-length str)\n (let ((len (string-length str)))\n ;; Check if string has any chars > 127 (raw bytes from ffi-read-all)\n (let check ((i 0))\n (if (>= i len)\n ;; All chars <= 127 — pure ASCII, string-length is correct\n len\n (let ((c (char->integer (string-ref str i))))\n (if (> c 127)\n ;; Contains high bytes — count UTF-8 sequences\n (utf8-count-codepoints str len)\n (check (+ i 1))))))))\n\n;; Count UTF-8 code points by examining lead bytes\n(def (utf8-count-codepoints str len)\n (let loop ((i 0) (count 0))\n (if (>= i len)\n count\n (let ((b (char->integer (string-ref str i))))\n (cond\n ((< b #x80) (loop (+ i 1) (+ count 1))) ;; ASCII\n ((< b #xC0) (loop (+ i 1) count)) ;; continuation byte\n ((< b #xE0) (loop (+ i 1) (+ count 1))) ;; 2-byte lead\n ((< b #xF0) (loop (+ i 1) (+ count 1))) ;; 3-byte lead\n (else (loop (+ i 1) (+ count 1))))))))\n\n;; Count UTF-8 byte length of a Gambit Unicode string\n(def (utf8-byte-count str)\n (let ((len (string-length str)))\n (let loop ((i 0) (bytes 0))\n (if (>= i len) bytes\n (let ((cp (char->integer (string-ref str i))))\n (loop (+ i 1) (+ bytes (cond ((< cp #x80) 1)\n ((< cp #x800) 2)\n ((< cp #x10000) 3)\n (else 4)))))))))\n\n;;; --- File test helpers (for refactored builtins) ---\n\n;; Test if path is a symbolic link (don't follow symlinks)\n(def (file-symlink? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (eq? (file-info-type (file-info path #f)) 'symbolic-link))))\n\n;; Test if path exists and is non-empty\n(def (file-nonempty? path)\n (and (file-exists? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (> (file-info-size (file-info path)) 0)))))\n\n;; Test if path is readable\n(def (file-readable? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 4) 0)))) ;; R_OK = 4\n\n;; Test if path is writable\n(def (file-writable? path)\n (with-catch\n (lambda (e) #f)\n (lambda () (= (ffi-access path 2) 0)))) ;; W_OK = 2\n\n;; Note: file-executable? is already defined above as executable?\n\n;;; --- Raw byte encoding for $'...' byte escapes ---\n;;\n;; Jerboa strings are Unicode. Byte values 128-255 from $'\\NNN' and $'\\xNN'\n;; would be UTF-8 encoded on output (2 bytes instead of 1). We use Unicode\n;; Private Use Area (U+E000-U+E0FF) to mark these as raw bytes. Output\n;; functions detect PUA chars and write single bytes via write-u8.\n\n(def raw-byte-base #xE000)\n\n;; Encode a byte value (0-255) as a PUA character for raw byte output.\n;; Values < 128 are returned as-is since UTF-8 encoding matches raw byte.\n(def (byte->raw-char val)\n (if (>= val #x80)\n (integer->char (+ raw-byte-base val))\n (integer->char val)))\n\n;; Check if a character is a PUA raw byte marker\n(def (raw-byte-char? ch)\n (let ((code (char->integer ch)))\n (and (>= code raw-byte-base) (<= code (+ raw-byte-base #xFF)))))\n\n;; Display a shell string, converting PUA raw byte markers to actual bytes.\n;; Fast path: if no PUA chars, use regular display.\n(def (shell-display str)\n (let ((len (string-length str)))\n (let scan ((i 0))\n (cond\n ((>= i len) (display str)) ;; no PUA chars found, fast path\n ((raw-byte-char? (string-ref str i))\n ;; Found PUA char, use slow path for whole string\n (shell-display-raw str))\n (else (scan (+ i 1)))))))\n\n;; Slow path: display string with PUA chars converted to raw bytes\n(def (shell-display-raw str)\n (let ((len (string-length str)))\n (let loop ((i 0))\n (when (< i len)\n (let* ((ch (string-ref str i))\n (code (char->integer ch)))\n (if (and (>= code raw-byte-base) (<= code (+ raw-byte-base #xFF)))\n (begin\n (force-output)\n (write-u8 (- code raw-byte-base))\n (force-output))\n (display ch)))\n (loop (+ i 1))))))\n"} @@ -551,7 +551,7 @@ {"text":";; FILE: jerboa-shell/.jerboa/security.json\n{\n \"version\": 1,\n \"repo\": \"jerboa-shell\",\n \"extends\": [\"jerboa:cli\", \"jerboa:ffi\", \"jerboa:parser\", \"jerboa:generated-heavy\"],\n \"paths\": {\n \"production\": [\"*.ss\", \"*.sls\", \"lib/**/*.ss\", \"lib/**/*.sls\", \"src/**/*.{ss,sls,c,h,rs}\", \"support/**\", \"ffi-shim.c\", \"Makefile\"],\n \"tests\": [\"test/**\", \"tests/**\", \"**/*-test.ss\", \"fixtures/**\"],\n \"generated\": [\"build/**\", \"dist/**\", \"target/**\", \"_tmp/**\", \"jsh-generated.ss\", \"jsh-macos\", \"*.sha256\", \"*.so\", \"*.dylib\", \"*.wpo\"],\n \"vendor\": [\"vendor/**\", \"third_party/**\", \"oils/**\"],\n \"docs\": [\"README.md\", \"docs/**\", \"*.md\", \"AGENTS.md\"]\n },\n \"policy\": {\n \"failOn\": [\"critical\", \"high\"],\n \"imports\": { \"directChezscheme\": \"allow-in-ffi-boundaries\" },\n \"ffi\": { \"allowed\": true, \"requireCloseOnExec\": true, \"requireDynamicWindCleanup\": true },\n \"process\": { \"shellInterpolation\": \"deny\", \"restrictedModeExpected\": true },\n \"network\": { \"requireTimeouts\": true },\n \"eval\": { \"stringEval\": \"deny\", \"bareRead\": \"deny\", \"allowReadEval\": false },\n \"shell\": { \"treatScriptsAsCodeExecution\": true, \"requireFdHygiene\": true }\n },\n \"suppressions\": []\n}\n"} {"text":";; FILE: jerboa-qt/README.md\n# jerboa-qt\n\nQt6 Widgets bindings for Jerboa Scheme.\n\nBuild desktop GUI applications with native Qt6 widgets from Jerboa, using a thin C++ shim and Chez's FFI underneath. API-compatible with [qt-vendor](https://github.com/ober/qt-vendor) at the high-level `qt-*` API layer.\n\n## Requirements\n\n- Jerboa with `jerbuild` on `PATH`\n- Qt6 development libraries\n- C compiler\n- A Qt shim provider. The Makefile first looks for `$HOME/mine/qt-vendor/vendor`, then falls back to `$HOME/mine/jerboa-emacs`.\n\n### Linux (Ubuntu/Debian)\n\n```sh\nsudo apt install qt6-base-dev libgl1-mesa-dev chezscheme\n```\n\n### Linux (Fedora)\n\n```sh\nsudo dnf install qt6-qtbase-devel chez-scheme\n```\n\n### macOS (Homebrew)\n\n```sh\nbrew install qt@6 chezscheme\nexport PKG_CONFIG_PATH=\"$(brew --prefix qt@6)/lib/pkgconfig:$PKG_CONFIG_PATH\"\n```\n\n## Build\n\nFirst, clone and build [qt-vendor](https://github.com/ober/qt-vendor) to get the C++ shim:\n\n```sh\ngit clone https://github.com/ober/qt-vendor.git\ncd qt-vendor\nmake build\ncd ..\n```\n\nThen build jerboa-qt:\n\n```sh\ncd jerboa-qt\nmake\n```\n\nBy default, the Makefile uses `$HOME/mine/qt-vendor/vendor` when present and otherwise falls back to `$HOME/mine/jerboa-emacs`. Override with:\n\n```sh\nmake QT_SHIM_INCLUDE_DIR=/path/to/include QT_SHIM_LIB_DIR=/path/to/lib\n```\n\nThis transpiles the Jerboa modules under `lib/` and builds the callback bridge (`jerboa_qt_shim.dylib` on macOS, `jerboa_qt_shim.so` elsewhere).\n\n## Test\n\n```sh\nmake test\n```\n\nTests run headless using Qt's offscreen platform plugin (`QT_QPA_PLATFORM=offscreen`).\n\n## Usage\n\n```scheme\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n (label (qt-label-create \"Count: 0\"))\n (button (qt-push-button-create \"Click me!\"))\n (count 0))\n (qt-layout-add-widget! layout label)\n (qt-layout-add-widget! layout button)\n (qt-on-clicked! button\n (lambda ()\n (set! count (+ count 1))\n (qt-label-set-text! label\n (string-append \"Count: \" (number->string count)))))\n (qt-main-window-set-central-widget! win central)\n (qt-main-window-set-title! win \"Counter\")\n (qt-widget-resize! win 300 200)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n```\n\n### Running Examples\n\nAll examples are self-contained executables with shebangs. Just run them directly from anywhere:\n\n```sh\n./examples/hello.ss\n./examples/counter.ss\n./examples/form.ss\n./examples/editor.ss\n./examples/dashboard.ss\n```\n\nThe shebang automatically resolves library paths relative to the script location, so examples work from any working directory:\n\n```sh\ncd /tmp\n/path/to/jerboa-qt/examples/hello.ss\n```\n\nRun headless (no display required):\n\n```sh\nQT_QPA_PLATFORM=offscreen ./examples/hello.ss\n```\n\nOr invoke manually without the shebang:\n\n```sh\nJH=\"$(jerbuild --jerboa-home)\"\nJERBOA_QT_LIB=\"$PWD\" \\\nJERBOA_QT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\" \\\nDYLD_LIBRARY_PATH=\"$PWD:${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}:${DYLD_LIBRARY_PATH:-}\" \\\nQT_QPA_PLATFORM=offscreen \\\njerbuild exec --libdirs \"lib:$JH/lib\" examples/hello.ss\n```\n\n### Using from the REPL\n\nFrom the jerboa-qt directory:\n\n```scheme\n> (import (jerboa-qt qt))\n> (define app (qt-app-create))\n> (define win (qt-main-window-create))\n> (qt-main-window-set-title! win \"REPL Window\")\n> (qt-widget-resize! win 400 300)\n> (qt-widget-show! win)\n> (qt-app-exec! app)\n```\n\n## Differences from qt-vendor\n\n| Aspect | qt-vendor | jerboa-qt |\n|--------|-----------|---------|\n| Import | `(import :qt-vendor/qt)` | `(import (jerboa-qt qt))` |\n| Define | `(def (name args) ...)` | `(define (name args) ...)` |\n| Main | `(def (main) ...)` in build target | `(define (main) ...) (main)` at end of script |\n| Keyword args | `parent: #f` | Not supported; positional or omitted |\n| Build | `other-Scheme build` | `make` |\n| Run examples | `make demo-hello` | `./examples/hello.ss` |\n| FFI mechanism | Gambit `c-define` (compile-time) | Chez `foreign-callable` (runtime) |\n\nThe high-level API (`qt-*` functions) is identical between both projects. Code that uses only the `(jerboa-qt qt)` / `:qt-vendor/qt` API can be ported by changing the import line and using `define` instead of `def`.\n\n## API Reference\n\n### Application Lifecycle\n\n| Function | Description |\n|----------|-------------|\n| `(qt-app-create)` | Create QApplication |\n| `(qt-app-exec! app)` | Run the event loop |\n| `(qt-app-quit! app)` | Quit the event loop |\n| `(qt-app-process-events! app)` | Process pending events (cooperative polling) |\n| `(qt-app-destroy! app)` | Destroy application |\n| `(with-qt-app app body ...)` | Macro: create app, run body, destroy on exit |\n\n### Widget Base\n\nAll widget types support these operations:\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-create)` | Create a generic widget |\n| `(qt-widget-show! w)` | Show widget |\n| `(qt-widget-hide! w)` | Hide widget |\n| `(qt-widget-close! w)` | Close widget |\n| `(qt-widget-set-enabled! w bool)` | Enable/disable |\n| `(qt-widget-enabled? w)` | Check if enabled |\n| `(qt-widget-set-visible! w bool)` | Set visibility |\n| `(qt-widget-visible? w)` | Check if visible |\n| `(qt-widget-resize! w width height)` | Resize |\n| `(qt-widget-set-fixed-size! w width height)` | Set fixed size |\n| `(qt-widget-set-minimum-size! w width height)` | Set minimum size |\n| `(qt-widget-set-maximum-size! w width height)` | Set maximum size |\n| `(qt-widget-set-minimum-width! w pixels)` | Set minimum width |\n| `(qt-widget-set-minimum-height! w pixels)` | Set minimum height |\n| `(qt-widget-set-maximum-width! w pixels)` | Set maximum width |\n| `(qt-widget-set-maximum-height! w pixels)` | Set maximum height |\n| `(qt-widget-set-cursor! w cursor)` | Set cursor shape (use `QT_CURSOR_*` constants) |\n| `(qt-widget-unset-cursor! w)` | Reset cursor to default |\n| `(qt-widget-set-style-sheet! w css)` | Apply CSS stylesheet |\n| `(qt-widget-set-tooltip! w text)` | Set tooltip text |\n| `(qt-widget-set-font-size! w size)` | Set font point size |\n| `(qt-widget-destroy! w)` | Destroy widget |\n\n### Main Window\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-create)` | Create main window |\n| `(qt-main-window-set-title! w title)` | Set window title |\n| `(qt-main-window-set-central-widget! w child)` | Set central widget |\n\n### Layouts\n\n| Function | Description |\n|----------|-------------|\n| `(qt-vbox-layout-create parent)` | Vertical box layout |\n| `(qt-hbox-layout-create parent)` | Horizontal box layout |\n| `(qt-layout-add-widget! layout widget)` | Add widget to layout |\n| `(qt-layout-add-stretch! layout)` | Add stretch spacer |\n| `(qt-layout-set-spacing! layout spacing)` | Set item spacing |\n| `(qt-layout-set-margins! layout l t r b)` | Set content margins |\n| `(qt-layout-add-spacing! layout pixels)` | Add fixed pixel spacing |\n| `(qt-layout-set-stretch-factor! layout widget stretch)` | Set relative stretch factor |\n\n### Labels\n\n| Function | Description |\n|----------|-------------|\n| `(qt-label-create text)` | Create label |\n| `(qt-label-text l)` | Get text |\n| `(qt-label-set-text! l text)` | Set text |\n| `(qt-label-set-alignment! l alignment)` | Set alignment (use `QT_ALIGN_*` constants) |\n| `(qt-label-set-word-wrap! l bool)` | Enable/disable word wrap |\n\n### Push Button\n\n| Function | Description |\n|----------|-------------|\n| `(qt-push-button-create text)` | Create button |\n| `(qt-push-button-text b)` | Get button text |\n| `(qt-push-button-set-text! b text)` | Set button text |\n| `(qt-on-clicked! button handler)` | Connect clicked signal: `(lambda () ...)` |\n\n### Line Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-line-edit-create)` | Create single-line text input |\n| `(qt-line-edit-text e)` | Get text |\n| `(qt-line-edit-set-text! e text)` | Set text |\n| `(qt-line-edit-set-placeholder! e text)` | Set placeholder text |\n| `(qt-line-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-line-edit-set-echo-mode! e mode)` | Set echo mode (use `QT_ECHO_*` constants) |\n| `(qt-on-text-changed! e handler)` | Connect textChanged: `(lambda (text) ...)` |\n| `(qt-on-return-pressed! e handler)` | Connect returnPressed: `(lambda () ...)` |\n\n### Check Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-check-box-create text)` | Create checkbox |\n| `(qt-check-box-checked? c)` | Is checked? |\n| `(qt-check-box-set-checked! c bool)` | Set checked state |\n| `(qt-check-box-set-text! c text)` | Set label text |\n| `(qt-on-toggled! c handler)` | Connect toggled: `(lambda (checked?) ...)` |\n\n### Combo Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-combo-box-create)` | Create dropdown |\n| `(qt-combo-box-add-item! c text)` | Add item |\n| `(qt-combo-box-set-current-index! c index)` | Set selection |\n| `(qt-combo-box-current-index c)` | Get selected index |\n| `(qt-combo-box-current-text c)` | Get selected text |\n| `(qt-combo-box-count c)` | Get item count |\n| `(qt-combo-box-clear! c)` | Remove all items |\n| `(qt-on-index-changed! c handler)` | Connect indexChanged: `(lambda (index) ...)` |\n\n### Text Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-edit-create)` | Create multi-line text editor |\n| `(qt-text-edit-text e)` | Get plain text |\n| `(qt-text-edit-set-text! e text)` | Set text |\n| `(qt-text-edit-set-placeholder! e text)` | Set placeholder |\n| `(qt-text-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-text-edit-append! e text)` | Append text |\n| `(qt-text-edit-clear! e)` | Clear all text |\n| `(qt-text-edit-scroll-to-bottom! e)` | Scroll to bottom |\n| `(qt-text-edit-html e)` | Get HTML content |\n| `(qt-on-text-edit-changed! e handler)` | Connect textChanged: `(lambda () ...)` |\n\n### Spin Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-spin-box-create)` | Create integer spinner |\n| `(qt-spin-box-value s)` | Get value |\n| `(qt-spin-box-set-value! s value)` | Set value |\n| `(qt-spin-box-set-range! s min max)` | Set min/max range |\n| `(qt-spin-box-set-single-step! s step)` | Set step increment |\n| `(qt-spin-box-set-prefix! s prefix)` | Set display prefix |\n| `(qt-spin-box-set-suffix! s suffix)` | Set display suffix |\n| `(qt-on-value-changed! s handler)` | Connect valueChanged: `(lambda (value) ...)` |\n\n### Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dialog-create)` | Create dialog window |\n| `(qt-dialog-exec! d)` | Run modal dialog |\n| `(qt-dialog-accept! d)` | Accept and close |\n| `(qt-dialog-reject! d)` | Reject and close |\n| `(qt-dialog-set-title! d title)` | Set dialog title |\n\n### Message Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-message-box-information parent title text)` | Show info dialog |\n| `(qt-message-box-warning parent title text)` | Show warning dialog |\n| `(qt-message-box-question parent title text)` | Show yes/no dialog, returns boolean |\n| `(qt-message-box-critical parent title text)` | Show error dialog |\n\nPass `0` for `parent` if none.\n\n### File Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-file-dialog-open-file parent caption dir filter)` | Open file picker, returns path or `\"\"` |\n| `(qt-file-dialog-save-file parent caption dir filter)` | Save file picker, returns path or `\"\"` |\n| `(qt-file-dialog-open-directory parent caption dir)` | Directory picker, returns path or `\"\"` |\n\n### Menu Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-menu-bar win)` | Get menu bar from main window |\n\n### Menu\n\n| Function | Description |\n|----------|-------------|\n| `(qt-menu-bar-add-menu bar title)` | Add menu to menu bar |\n| `(qt-menu-add-menu menu title)` | Add submenu |\n| `(qt-menu-add-action! menu action)` | Add action to menu |\n| `(qt-menu-add-separator! menu)` | Add separator |\n\n### Action\n\n| Function | Description |\n|----------|-------------|\n| `(qt-action-create text)` | Create action |\n| `(qt-action-text a)` | Get text |\n| `(qt-action-set-text! a text)` | Set text |\n| `(qt-action-set-shortcut! a key-sequence)` | Set keyboard shortcut (e.g. `\"Ctrl+S\"`) |\n| `(qt-action-set-enabled! a bool)` | Enable/disable |\n| `(qt-action-enabled? a)` | Is enabled? |\n| `(qt-action-set-checkable! a bool)` | Make checkable |\n| `(qt-action-checkable? a)` | Is checkable? |\n| `(qt-action-set-checked! a bool)` | Set checked state |\n| `(qt-action-checked? a)` | Is checked? |\n| `(qt-action-set-tooltip! a text)` | Set tooltip |\n| `(qt-action-set-status-tip! a text)` | Set status bar tip |\n| `(qt-on-triggered! a handler)` | Connect triggered: `(lambda () ...)` |\n| `(qt-on-action-toggled! a handler)` | Connect toggled: `(lambda (checked?) ...)` |\n\n### Toolbar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-toolbar-create title)` | Create toolbar |\n| `(qt-main-window-add-toolbar! win toolbar)` | Add toolbar to main window |\n| `(qt-toolbar-add-action! toolbar action)` | Add action to toolbar |\n| `(qt-toolbar-add-separator! toolbar)` | Add separator |\n| `(qt-toolbar-add-widget! toolbar widget)` | Add widget to toolbar |\n| `(qt-toolbar-set-movable! toolbar bool)` | Set movable |\n| `(qt-toolbar-set-icon-size! toolbar w h)` | Set icon size |\n\n### Status Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-main-window-set-status-bar-text! win text)` | Set status bar message |\n\n### Grid Layout\n\n| Function | Description |\n|----------|-------------|\n| `(qt-grid-layout-create parent)` | Create grid layout |\n| `(qt-grid-layout-add-widget! grid widget row col)` | Add widget at position |\n| `(qt-grid-layout-set-row-stretch! grid row stretch)` | Set row stretch factor |\n| `(qt-grid-layout-set-column-stretch! grid col stretch)` | Set column stretch factor |\n| `(qt-grid-layout-set-row-minimum-height! grid row height)` | Set row minimum height |\n| `(qt-grid-layout-set-column-minimum-width! grid col width)` | Set column minimum width |\n\n### Timer\n\n| Function | Description |\n|----------|-------------|\n| `(qt-timer-create)` | Create timer |\n| `(qt-timer-start! t msec)` | Start with interval |\n| `(qt-timer-stop! t)` | Stop timer |\n| `(qt-timer-set-single-shot! t bool)` | Set single-shot mode |\n| `(qt-timer-active? t)` | Is running? |\n| `(qt-timer-interval t)` | Get interval |\n| `(qt-timer-set-interval! t msec)` | Set interval |\n| `(qt-on-timeout! t handler)` | Connect timeout: `(lambda () ...)` |\n| `(qt-timer-single-shot! msec handler)` | One-shot timer (static convenience) |\n| `(qt-timer-destroy! t)` | Destroy timer |\n\n### Clipboard\n\n| Function | Description |\n|----------|-------------|\n| `(qt-clipboard-text app)` | Get clipboard text |\n| `(qt-clipboard-set-text! app text)` | Set clipboard text |\n| `(qt-on-clipboard-changed! app handler)` | Connect dataChanged: `(lambda () ...)` |\n\nThe clipboard is a singleton owned by QApplication -- never destroy it.\n\n### Tree Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tree-widget-create)` | Create tree widget |\n| `(qt-tree-widget-set-column-count! t count)` | Set number of columns |\n| `(qt-tree-widget-column-count t)` | Get column count |\n| `(qt-tree-widget-set-header-label! t label)` | Set single header label |\n| `(qt-tree-widget-set-header-item-text! t col text)` | Set individual header text |\n| `(qt-tree-widget-add-top-level-item! t item)` | Add top-level item |\n| `(qt-tree-widget-top-level-item-count t)` | Count top-level items |\n| `(qt-tree-widget-top-level-item t index)` | Get top-level item by index |\n| `(qt-tree-widget-current-item t)` | Get selected item (or `#f`) |\n| `(qt-tree-widget-set-current-item! t item)` | Set selected item |\n| `(qt-tree-widget-expand-item! t item)` | Expand item |\n| `(qt-tree-widget-collapse-item! t item)` | Collapse item |\n| `(qt-tree-widget-expand-all! t)` | Expand all |\n| `(qt-tree-widget-collapse-all! t)` | Collapse all |\n| `(qt-tree-widget-clear! t)` | Remove all items |\n| `(qt-on-current-item-changed! t handler)` | `(lambda () ...)` |\n| `(qt-on-tree-item-double-clicked! t handler)` | `(lambda () ...)` |\n| `(qt-on-item-expanded! t handler)` | `(lambda () ...)` |\n| `(qt-on-item-collapsed! t handler)` | `(lambda () ...)` |\n\n### Tree Widget Item\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tree-item-create text)` | Create tree item |\n| `(qt-tree-item-set-text! item col text)` | Set text at column |\n| `(qt-tree-item-text item col)` | Get text at column |\n| `(qt-tree-item-add-child! parent child)` | Add child item |\n| `(qt-tree-item-child-count item)` | Get child count |\n| `(qt-tree-item-child item index)` | Get child by index |\n| `(qt-tree-item-parent item)` | Get parent item |\n| `(qt-tree-item-set-expanded! item bool)` | Set expanded state |\n| `(qt-tree-item-expanded? item)` | Is expanded? |\n\n### List Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-list-widget-create)` | Create list widget |\n| `(qt-list-widget-add-item! l text)` | Add item |\n| `(qt-list-widget-insert-item! l row text)` | Insert at position |\n| `(qt-list-widget-remove-item! l row)` | Remove by position |\n| `(qt-list-widget-current-row l)` | Get selected row |\n| `(qt-list-widget-set-current-row! l row)` | Set selected row |\n| `(qt-list-widget-item-text l row)` | Get item text |\n| `(qt-list-widget-count l)` | Get item count |\n| `(qt-list-widget-clear! l)` | Remove all items |\n| `(qt-list-widget-set-item-data! l row data)` | Set hidden data string |\n| `(qt-list-widget-item-data l row)` | Get hidden data string |\n| `(qt-on-current-row-changed! l handler)` | `(lambda (row) ...)` |\n| `(qt-on-item-double-clicked! l handler)` | `(lambda (row) ...)` |\n\n### Table Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-table-widget-create rows cols)` | Create table widget |\n| `(qt-table-widget-set-item! t row col text)` | Set cell text |\n| `(qt-table-widget-item-text t row col)` | Get cell text |\n| `(qt-table-widget-set-horizontal-header! t col text)` | Set column header |\n| `(qt-table-widget-set-vertical-header! t row text)` | Set row header |\n| `(qt-table-widget-set-row-count! t count)` | Set row count |\n| `(qt-table-widget-set-column-count! t count)` | Set column count |\n| `(qt-table-widget-row-count t)` | Get row count |\n| `(qt-table-widget-column-count t)` | Get column count |\n| `(qt-table-widget-current-row t)` | Get current row |\n| `(qt-table-widget-current-column t)` | Get current column |\n| `(qt-table-widget-clear! t)` | Clear all cells |\n| `(qt-on-cell-clicked! t handler)` | `(lambda () ...)` |\n\n### Tab Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tab-widget-create)` | Create tab widget |\n| `(qt-tab-widget-add-tab! tw page title)` | Add tab page |\n| `(qt-tab-widget-set-current-index! tw index)` | Set active tab |\n| `(qt-tab-widget-current-index tw)` | Get active tab index |\n| `(qt-tab-widget-count tw)` | Get tab count |\n| `(qt-tab-widget-set-tab-text! tw index text)` | Change tab label |\n| `(qt-on-tab-changed! tw handler)` | `(lambda (index) ...)` |\n\n### Progress Bar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-progress-bar-create)` | Create progress bar |\n| `(qt-progress-bar-set-value! p value)` | Set current value |\n| `(qt-progress-bar-value p)` | Get current value |\n| `(qt-progress-bar-set-range! p min max)` | Set value range |\n| `(qt-progress-bar-set-format! p fmt)` | Set display format (e.g. `\"%p%\"`) |\n\n### Slider\n\n| Function | Description |\n|----------|-------------|\n| `(qt-slider-create orientation)` | Create slider (`QT_HORIZONTAL` / `QT_VERTICAL`) |\n| `(qt-slider-set-value! s value)` | Set value |\n| `(qt-slider-value s)` | Get value |\n| `(qt-slider-set-range! s min max)` | Set range |\n| `(qt-slider-set-single-step! s step)` | Set step |\n| `(qt-slider-set-tick-interval! s interval)` | Set tick spacing |\n| `(qt-slider-set-tick-position! s position)` | Set tick position (use `QT_TICKS_*` constants) |\n| `(qt-on-slider-value-changed! s handler)` | `(lambda (value) ...)` |\n\n### Window State\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-show-minimized! w)` | Minimize |\n| `(qt-widget-show-maximized! w)` | Maximize |\n| `(qt-widget-show-fullscreen! w)` | Fullscreen |\n| `(qt-widget-show-normal! w)` | Normal |\n| `(qt-widget-window-state w)` | Get state constant |\n| `(qt-widget-move! w x y)` | Move window |\n| `(qt-widget-x w)` | Get X position |\n| `(qt-widget-y w)` | Get Y position |\n| `(qt-widget-width w)` | Get width |\n| `(qt-widget-height w)` | Get height |\n| `(qt-widget-set-focus! w)` | Set keyboard focus |\n\n### App-wide Style Sheet\n\n| Function | Description |\n|----------|-------------|\n| `(qt-app-set-style-sheet! app css)` | Apply CSS to entire application |\n\n### Scroll Area\n\n| Function | Description |\n|----------|-------------|\n| `(qt-scroll-area-create)` | Create scroll area |\n| `(qt-scroll-area-set-widget! sa widget)` | Set scrollable content |\n| `(qt-scroll-area-set-widget-resizable! sa bool)` | Allow content to resize |\n| `(qt-scroll-area-set-horizontal-scrollbar-policy! sa policy)` | Set horizontal scrollbar |\n| `(qt-scroll-area-set-vertical-scrollbar-policy! sa policy)` | Set vertical scrollbar |\n\n### Splitter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-splitter-create orientation)` | Create splitter (`QT_HORIZONTAL` / `QT_VERTICAL`) |\n| `(qt-splitter-add-widget! sp widget)` | Add widget |\n| `(qt-splitter-insert-widget! sp index widget)` | Insert at position |\n| `(qt-splitter-count sp)` | Get widget count |\n| `(qt-splitter-set-handle-width! sp pixels)` | Set handle width |\n| `(qt-splitter-set-collapsible! sp index bool)` | Set collapsible |\n| `(qt-splitter-collapsible? sp index)` | Is collapsible? |\n| `(qt-splitter-set-orientation! sp orientation)` | Change orientation |\n\n### Keyboard Events\n\n| Function | Description |\n|----------|-------------|\n| `(qt-on-key-press! w handler)` | Key press: `(lambda () ...)`, then query key info |\n| `(qt-on-key-press-consuming! w handler)` | Same but consumes the event |\n| `(qt-last-key-code)` | Get last key code (use `QT_KEY_*` constants) |\n| `(qt-last-key-modifiers)` | Get modifier flags (use `QT_MOD_*` constants) |\n| `(qt-last-key-text)` | Get key text |\n\n### Pixmap\n\n| Function | Description |\n|----------|-------------|\n| `(qt-pixmap-load path)` | Load image from file |\n| `(qt-pixmap-create-blank w h)` | Create blank pixmap |\n| `(qt-pixmap-width pm)` | Get width |\n| `(qt-pixmap-height pm)` | Get height |\n| `(qt-pixmap-null? pm)` | Is empty? |\n| `(qt-pixmap-scaled pm w h)` | Scale pixmap, returns new pixmap |\n| `(qt-pixmap-fill! pm r g b a)` | Fill with color |\n| `(qt-pixmap-destroy! pm)` | Destroy pixmap |\n| `(qt-label-set-pixmap! label pm)` | Display pixmap in label |\n\n### Icon\n\n| Function | Description |\n|----------|-------------|\n| `(qt-icon-create path)` | Create icon from file |\n| `(qt-icon-create-from-pixmap pm)` | Create icon from pixmap |\n| `(qt-icon-null? icon)` | Is empty? |\n| `(qt-icon-destroy! icon)` | Destroy icon |\n| `(qt-push-button-set-icon! button icon)` | Set button icon |\n| `(qt-action-set-icon! action icon)` | Set action icon |\n| `(qt-widget-set-window-icon! w icon)` | Set window icon |\n\n### Radio Button\n\n| Function | Description |\n|----------|-------------|\n| `(qt-radio-button-create text)` | Create radio button |\n| `(qt-radio-button-text r)` | Get text |\n| `(qt-radio-button-set-text! r text)` | Set text |\n| `(qt-radio-button-checked? r)` | Is checked? |\n| `(qt-radio-button-set-checked! r bool)` | Set checked state |\n| `(qt-on-radio-toggled! r handler)` | `(lambda (checked?) ...)` |\n\n### Button Group\n\n| Function | Description |\n|----------|-------------|\n| `(qt-button-group-create)` | Create button group |\n| `(qt-button-group-add-button! bg button id)` | Add button with ID |\n| `(qt-button-group-remove-button! bg button)` | Remove button |\n| `(qt-button-group-checked-id bg)` | Get checked button ID |\n| `(qt-button-group-set-exclusive! bg bool)` | Set exclusive mode |\n| `(qt-button-group-exclusive? bg)` | Is exclusive? |\n| `(qt-on-button-group-clicked! bg handler)` | `(lambda (id) ...)` |\n| `(qt-button-group-destroy! bg)` | Destroy group |\n\n### Group Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-group-box-create title)` | Create group box |\n| `(qt-group-box-title gb)` | Get title |\n| `(qt-group-box-set-title! gb title)` | Set title |\n| `(qt-group-box-set-checkable! gb bool)` | Make checkable |\n| `(qt-group-box-checkable? gb)` | Is checkable? |\n| `(qt-group-box-set-checked! gb bool)` | Set checked state |\n| `(qt-group-box-checked? gb)` | Is checked? |\n| `(qt-on-group-box-toggled! gb handler)` | `(lambda (checked?) ...)` |\n\n### QFont\n\n| Function | Description |\n|----------|-------------|\n| `(qt-font-create family point-size)` | Create font |\n| `(qt-font-family f)` | Get font family name |\n| `(qt-font-point-size f)` | Get point size |\n| `(qt-font-bold? f)` | Check if bold |\n| `(qt-font-set-bold! f bool)` | Set bold |\n| `(qt-font-italic? f)` | Check if italic |\n| `(qt-font-set-italic! f bool)` | Set italic |\n| `(qt-font-destroy! f)` | Destroy font |\n| `(qt-widget-set-font! w f)` | Set font on any widget |\n| `(qt-widget-font w)` | Get widget's font (new copy -- caller must destroy) |\n\n### QColor\n\n| Function | Description |\n|----------|-------------|\n| `(qt-color-create r g b a)` | Create from RGBA (0-255) |\n| `(qt-color-create-name name)` | Create from `\"#rrggbb\"` or named color |\n| `(qt-color-red c)` | Red channel |\n| `(qt-color-green c)` | Green channel |\n| `(qt-color-blue c)` | Blue channel |\n| `(qt-color-alpha c)` | Alpha channel |\n| `(qt-color-name c)` | Hex string `\"#rrggbb\"` |\n| `(qt-color-valid? c)` | Is color valid? |\n| `(qt-color-destroy! c)` | Destroy color |\n\n### QFontDialog / QColorDialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-font-dialog-get-font)` | Show font picker, returns QFont or `#f` |\n| `(qt-color-dialog-get-color)` | Show color picker, returns QColor or `#f` |\n\n### Stacked Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-stacked-widget-create)` | Create stacked widget |\n| `(qt-stacked-widget-add-widget! sw widget)` | Add page |\n| `(qt-stacked-widget-set-current-index! sw index)` | Set visible page |\n| `(qt-stacked-widget-current-index sw)` | Get visible page index |\n| `(qt-stacked-widget-count sw)` | Get page count |\n| `(qt-on-stacked-current-changed! sw handler)` | `(lambda (index) ...)` |\n\n### Dock Widget\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dock-widget-create title)` | Create dock widget |\n| `(qt-dock-widget-set-widget! dock widget)` | Set dock content |\n| `(qt-dock-widget-widget dock)` | Get dock content |\n| `(qt-dock-widget-set-title! dock title)` | Set dock title |\n| `(qt-dock-widget-title dock)` | Get dock title |\n| `(qt-dock-widget-set-floating! dock bool)` | Set floating state |\n| `(qt-dock-widget-floating? dock)` | Is floating? |\n| `(qt-main-window-add-dock-widget! win area dock)` | Add to main window (use `QT_DOCK_*` constants) |\n\n### System Tray Icon\n\n| Function | Description |\n|----------|-------------|\n| `(qt-system-tray-icon-create)` | Create tray icon |\n| `(qt-system-tray-icon-set-tooltip! tray text)` | Set tooltip |\n| `(qt-system-tray-icon-set-icon! tray icon)` | Set tray icon |\n| `(qt-system-tray-icon-show! tray)` | Show in tray |\n| `(qt-system-tray-icon-hide! tray)` | Hide from tray |\n| `(qt-system-tray-icon-show-message! tray title msg icon-type msec)` | Show notification |\n| `(qt-system-tray-icon-set-context-menu! tray menu)` | Set right-click menu |\n| `(qt-on-tray-activated! tray handler)` | `(lambda (reason) ...)` |\n| `(qt-system-tray-icon-available?)` | Is system tray available? |\n| `(qt-system-tray-icon-destroy! tray)` | Destroy tray icon |\n\n### QPainter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-painter-create target)` | Create painter on pixmap or paint widget |\n| `(qt-painter-end! p)` | End painting |\n| `(qt-painter-destroy! p)` | Destroy painter |\n| `(qt-painter-set-pen-color! p r g b)` | Set pen color |\n| `(qt-painter-set-pen-width! p width)` | Set pen width |\n| `(qt-painter-set-brush-color! p r g b)` | Set fill color |\n| `(qt-painter-set-font! p font)` | Set text font |\n| `(qt-painter-set-antialiasing! p bool)` | Enable antialiasing |\n| `(qt-painter-draw-line! p x1 y1 x2 y2)` | Draw line |\n| `(qt-painter-draw-rect! p x y w h)` | Draw rectangle |\n| `(qt-painter-fill-rect! p x y w h)` | Fill rectangle |\n| `(qt-painter-draw-ellipse! p x y w h)` | Draw ellipse |\n| `(qt-painter-draw-text! p x y text)` | Draw text at point |\n| `(qt-painter-draw-text-rect! p x y w h flags text)` | Draw text in rectangle |\n| `(qt-painter-draw-pixmap! p x y pixmap)` | Draw pixmap |\n| `(qt-painter-draw-point! p x y)` | Draw point |\n| `(qt-painter-draw-arc! p x y w h start-angle span-angle)` | Draw arc |\n| `(qt-painter-save! p)` | Save painter state |\n| `(qt-painter-restore! p)` | Restore painter state |\n| `(qt-painter-translate! p dx dy)` | Translate origin |\n| `(qt-painter-rotate! p angle)` | Rotate (degrees) |\n| `(qt-painter-scale! p sx sy)` | Scale |\n| `(with-painter (p target) body ...)` | Macro: create, paint, auto end+destroy |\n\n### Drag and Drop\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-set-accept-drops! w bool)` | Enable drop target |\n| `(qt-drop-filter-install! w)` | Install drop event filter |\n| `(qt-drop-filter-last-text)` | Get last dropped text |\n| `(qt-drop-filter-destroy! filter)` | Destroy drop filter |\n| `(qt-drag-text! source text)` | Initiate text drag |\n\n### Double Spin Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-double-spin-box-create)` | Create decimal spinner |\n| `(qt-double-spin-box-set-value! s value)` | Set value |\n| `(qt-double-spin-box-value s)` | Get value |\n| `(qt-double-spin-box-set-range! s min max)` | Set range |\n| `(qt-double-spin-box-set-single-step! s step)` | Set step |\n| `(qt-double-spin-box-set-decimals! s n)` | Set decimal places |\n| `(qt-double-spin-box-decimals s)` | Get decimal places |\n| `(qt-double-spin-box-set-prefix! s prefix)` | Set prefix |\n| `(qt-double-spin-box-set-suffix! s suffix)` | Set suffix |\n| `(qt-on-double-spin-value-changed! s handler)` | `(lambda (value) ...)` |\n\n### Date Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-date-edit-create)` | Create date picker |\n| `(qt-date-edit-set-date! d year month day)` | Set date |\n| `(qt-date-edit-year d)` | Get year |\n| `(qt-date-edit-month d)` | Get month |\n| `(qt-date-edit-day d)` | Get day |\n| `(qt-date-edit-date-string d)` | Get ISO date string |\n| `(qt-date-edit-set-minimum-date! d year month day)` | Set minimum |\n| `(qt-date-edit-set-maximum-date! d year month day)` | Set maximum |\n| `(qt-date-edit-set-calendar-popup! d bool)` | Enable calendar popup |\n| `(qt-date-edit-set-display-format! d format)` | Set display format |\n| `(qt-on-date-changed! d handler)` | `(lambda () ...)` |\n\n### Time Edit\n\n| Function | Description |\n|----------|-------------|\n| `(qt-time-edit-create)` | Create time picker |\n| `(qt-time-edit-set-time! t hour minute second)` | Set time |\n| `(qt-time-edit-hour t)` | Get hour |\n| `(qt-time-edit-minute t)` | Get minute |\n| `(qt-time-edit-second t)` | Get second |\n| `(qt-time-edit-time-string t)` | Get time string |\n| `(qt-time-edit-set-display-format! t format)` | Set display format |\n| `(qt-on-time-changed! t handler)` | `(lambda () ...)` |\n\n### Frame\n\n| Function | Description |\n|----------|-------------|\n| `(qt-frame-create)` | Create frame |\n| `(qt-frame-set-frame-shape! f shape)` | Set shape (use `QT_FRAME_*` constants) |\n| `(qt-frame-frame-shape f)` | Get shape |\n| `(qt-frame-set-frame-shadow! f shadow)` | Set shadow |\n| `(qt-frame-frame-shadow f)` | Get shadow |\n| `(qt-frame-set-line-width! f width)` | Set line width |\n| `(qt-frame-line-width f)` | Get line width |\n| `(qt-frame-set-mid-line-width! f width)` | Set mid-line width |\n\n### Progress Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-progress-dialog-create title cancel-text min max)` | Create progress dialog |\n| `(qt-progress-dialog-set-value! d value)` | Set progress |\n| `(qt-progress-dialog-value d)` | Get progress |\n| `(qt-progress-dialog-set-range! d min max)` | Set range |\n| `(qt-progress-dialog-set-label-text! d text)` | Set label |\n| `(qt-progress-dialog-was-canceled? d)` | Was cancelled? |\n| `(qt-progress-dialog-set-minimum-duration! d msec)` | Set delay before showing |\n| `(qt-progress-dialog-set-auto-close! d bool)` | Auto close on completion |\n| `(qt-progress-dialog-set-auto-reset! d bool)` | Auto reset on completion |\n| `(qt-progress-dialog-reset! d)` | Reset dialog |\n| `(qt-on-progress-canceled! d handler)` | `(lambda () ...)` |\n\n### Input Dialog\n\n| Function | Description |\n|----------|-------------|\n| `(qt-input-dialog-get-text title label default)` | Get text from user; returns string or `\"\"` |\n| `(qt-input-dialog-get-int title label value min max step)` | Get integer |\n| `(qt-input-dialog-get-double title label value min max decimals)` | Get double |\n| `(qt-input-dialog-get-item title label items current editable)` | Choose from list |\n| `(qt-input-dialog-was-accepted?)` | Was last dialog accepted? |\n\n### Form Layout\n\n| Function | Description |\n|----------|-------------|\n| `(qt-form-layout-create parent)` | Create form layout (label:field rows) |\n| `(qt-form-layout-add-row! form label widget)` | Add labeled row |\n| `(qt-form-layout-add-row-widget! form widget)` | Add spanning row |\n| `(qt-form-layout-add-spanning-widget! form widget)` | Add spanning widget |\n| `(qt-form-layout-row-count form)` | Get number of rows |\n\n### Shortcut\n\n| Function | Description |\n|----------|-------------|\n| `(qt-shortcut-create key-sequence parent)` | Create shortcut (e.g. `\"Ctrl+S\"`) |\n| `(qt-shortcut-set-key! sc key-sequence)` | Change key sequence |\n| `(qt-shortcut-set-enabled! sc bool)` | Enable/disable |\n| `(qt-shortcut-enabled? sc)` | Is enabled? |\n| `(qt-on-shortcut-activated! sc handler)` | `(lambda () ...)` |\n| `(qt-shortcut-destroy! sc)` | Destroy shortcut |\n\n### Calendar\n\n| Function | Description |\n|----------|-------------|\n| `(qt-calendar-create)` | Create calendar widget |\n| `(qt-calendar-set-selected-date! cal year month day)` | Set selected date |\n| `(qt-calendar-selected-year cal)` | Get year |\n| `(qt-calendar-selected-month cal)` | Get month (1-12) |\n| `(qt-calendar-selected-day cal)` | Get day (1-31) |\n| `(qt-calendar-selected-date-string cal)` | Get ISO date string |\n| `(qt-calendar-set-minimum-date! cal year month day)` | Set minimum date |\n| `(qt-calendar-set-maximum-date! cal year month day)` | Set maximum date |\n| `(qt-calendar-set-first-day-of-week! cal day)` | Set first day (use `QT_MONDAY`..`QT_SUNDAY`) |\n| `(qt-calendar-set-grid-visible! cal bool)` | Show/hide grid |\n| `(qt-calendar-grid-visible? cal)` | Is grid visible? |\n| `(qt-calendar-set-navigation-bar-visible! cal bool)` | Show/hide navigation |\n| `(qt-on-calendar-selection-changed! cal handler)` | `(lambda () ...)` |\n| `(qt-on-calendar-clicked! cal handler)` | `(lambda (iso-date) ...)` |\n\n### Text Browser\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-browser-create)` | Create rich text/HTML viewer |\n| `(qt-text-browser-set-html! tb html)` | Set HTML content |\n| `(qt-text-browser-set-plain-text! tb text)` | Set plain text |\n| `(qt-text-browser-plain-text tb)` | Get plain text |\n| `(qt-text-browser-set-open-external-links! tb bool)` | Enable browser launch on click |\n| `(qt-text-browser-set-source! tb url)` | Load content from URL/file |\n| `(qt-text-browser-source tb)` | Get current source URL |\n| `(qt-text-browser-scroll-to-bottom! tb)` | Scroll to bottom |\n| `(qt-text-browser-append! tb text)` | Append text |\n| `(qt-text-browser-html tb)` | Get HTML content |\n| `(qt-on-anchor-clicked! tb handler)` | Link clicked: `(lambda (url) ...)` |\n\n### Dialog Button Box\n\n| Function | Description |\n|----------|-------------|\n| `(qt-button-box-create flags)` | Create with standard button flags (`bitwise-ior`) |\n| `(qt-button-box-button bb role)` | Get button by standard constant |\n| `(qt-button-box-add-button! bb text role)` | Add custom button |\n| `(qt-on-button-box-accepted! bb handler)` | `(lambda () ...)` |\n| `(qt-on-button-box-rejected! bb handler)` | `(lambda () ...)` |\n| `(qt-on-button-box-clicked! bb handler)` | `(lambda () ...)` |\n\n**Standard buttons:** `QT_BUTTON_OK`, `QT_BUTTON_CANCEL`, `QT_BUTTON_APPLY`, `QT_BUTTON_CLOSE`, `QT_BUTTON_YES`, `QT_BUTTON_NO`, `QT_BUTTON_RESET`, `QT_BUTTON_HELP`, `QT_BUTTON_SAVE`, `QT_BUTTON_DISCARD`\n\n### QSettings\n\n| Function | Description |\n|----------|-------------|\n| `(qt-settings-create org app)` | Create settings for org/app |\n| `(qt-settings-create-file path format)` | Create file-backed settings |\n| `(qt-settings-set-string! s key value)` | Store string |\n| `(qt-settings-value-string s key default)` | Read string |\n| `(qt-settings-set-int! s key value)` | Store integer |\n| `(qt-settings-value-int s key default)` | Read integer |\n| `(qt-settings-set-double! s key value)` | Store double |\n| `(qt-settings-value-double s key default)` | Read double |\n| `(qt-settings-set-bool! s key value)` | Store boolean |\n| `(qt-settings-value-bool s key default)` | Read boolean |\n| `(qt-settings-contains? s key)` | Check if key exists |\n| `(qt-settings-remove! s key)` | Remove key |\n| `(qt-settings-all-keys s)` | List all keys |\n| `(qt-settings-child-keys s)` | Keys in current group |\n| `(qt-settings-child-groups s)` | Subgroups in current group |\n| `(qt-settings-begin-group! s prefix)` | Enter group |\n| `(qt-settings-end-group! s)` | Leave group |\n| `(qt-settings-group s)` | Current group name |\n| `(qt-settings-sync! s)` | Flush to storage |\n| `(qt-settings-clear! s)` | Remove all keys |\n| `(qt-settings-file-name s)` | Path to storage file |\n| `(qt-settings-writable? s)` | Can write? |\n| `(qt-settings-destroy! s)` | Destroy settings |\n\n**Format constants:** `QT_SETTINGS_NATIVE`, `QT_SETTINGS_INI`\n\n### QCompleter\n\n| Function | Description |\n|----------|-------------|\n| `(qt-completer-create items)` | Create from list of strings |\n| `(qt-completer-set-model-strings! c items)` | Update completion list |\n| `(qt-completer-set-case-sensitivity! c sensitive?)` | Case-sensitive matching |\n| `(qt-completer-set-completion-mode! c mode)` | Set popup/inline mode |\n| `(qt-completer-set-filter-mode! c mode)` | Set starts-with/contains/ends-with |\n| `(qt-completer-set-max-visible-items! c count)` | Max visible popup items |\n| `(qt-completer-completion-count c)` | Number of completions |\n| `(qt-completer-current-completion c)` | Current completion text |\n| `(qt-completer-set-completion-prefix! c prefix)` | Set prefix to match |\n| `(qt-on-completer-activated! c handler)` | `(lambda (text) ...)` |\n| `(qt-line-edit-set-completer! e c)` | Attach to line edit |\n| `(qt-completer-set-widget! c widget)` | Attach to arbitrary widget |\n| `(qt-completer-complete-rect! c x y w h)` | Show popup at rect |\n| `(qt-completer-destroy! c)` | Destroy (only if not attached) |\n\n**Mode constants:** `QT_COMPLETER_POPUP`, `QT_COMPLETER_INLINE`, `QT_COMPLETER_UNFILTERED_POPUP`\n\n**Case constants:** `QT_CASE_INSENSITIVE`, `QT_CASE_SENSITIVE`\n\n**Filter constants:** `QT_MATCH_STARTS_WITH`, `QT_MATCH_CONTAINS`, `QT_MATCH_ENDS_WITH`\n\n### Tooltip / WhatsThis\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tooltip-show-text! x y text)` | Show tooltip at screen position |\n| `(qt-tooltip-hide-text!)` | Hide current tooltip |\n| `(qt-tooltip-visible?)` | Is tooltip visible? |\n| `(qt-widget-tooltip w)` | Get widget's tooltip text |\n| `(qt-widget-set-whats-this! w text)` | Set \"What's This?\" text |\n| `(qt-widget-whats-this w)` | Get \"What's This?\" text |\n\n### QStandardItemModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-standard-model-create rows cols)` | Create model |\n| `(qt-standard-model-destroy! m)` | Destroy model |\n| `(qt-standard-model-row-count m)` | Row count |\n| `(qt-standard-model-column-count m)` | Column count |\n| `(qt-standard-model-set-row-count! m rows)` | Set rows |\n| `(qt-standard-model-set-column-count! m cols)` | Set columns |\n| `(qt-standard-model-set-item! m row col item)` | Set item (transfers ownership) |\n| `(qt-standard-model-item m row col)` | Get item |\n| `(qt-standard-model-insert-row! m row)` | Insert row |\n| `(qt-standard-model-insert-column! m col)` | Insert column |\n| `(qt-standard-model-remove-row! m row)` | Remove row |\n| `(qt-standard-model-remove-column! m col)` | Remove column |\n| `(qt-standard-model-clear! m)` | Clear all items |\n| `(qt-standard-model-set-horizontal-header! m col text)` | Set column header |\n| `(qt-standard-model-set-vertical-header! m row text)` | Set row header |\n\n### QStandardItem\n\n| Function | Description |\n|----------|-------------|\n| `(qt-standard-item-create text)` | Create item |\n| `(qt-standard-item-text item)` | Get text |\n| `(qt-standard-item-set-text! item text)` | Set text |\n| `(qt-standard-item-tooltip item)` | Get tooltip |\n| `(qt-standard-item-set-tooltip! item text)` | Set tooltip |\n| `(qt-standard-item-set-editable! item bool)` | Set editable |\n| `(qt-standard-item-editable? item)` | Is editable? |\n| `(qt-standard-item-set-enabled! item bool)` | Set enabled |\n| `(qt-standard-item-enabled? item)` | Is enabled? |\n| `(qt-standard-item-set-selectable! item bool)` | Set selectable |\n| `(qt-standard-item-selectable? item)` | Is selectable? |\n| `(qt-standard-item-set-checkable! item bool)` | Set checkable |\n| `(qt-standard-item-checkable? item)` | Is checkable? |\n| `(qt-standard-item-set-check-state! item state)` | Set check state |\n| `(qt-standard-item-check-state item)` | Get check state |\n| `(qt-standard-item-set-icon! item icon)` | Set icon |\n| `(qt-standard-item-append-row! parent child)` | Add child (tree hierarchy) |\n| `(qt-standard-item-row-count item)` | Child row count |\n| `(qt-standard-item-column-count item)` | Child column count |\n| `(qt-standard-item-child item row col)` | Get child item |\n\nItems transfer ownership to the model after `set-item!` or `append-row!`. Do not destroy manually.\n\n### QStringListModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-string-list-model-create items)` | Create from list of strings |\n| `(qt-string-list-model-destroy! m)` | Destroy model |\n| `(qt-string-list-model-set-strings! m items)` | Replace all strings |\n| `(qt-string-list-model-strings m)` | Get all strings as list |\n| `(qt-string-list-model-row-count m)` | Number of items |\n\n### Views (QListView, QTableView, QTreeView)\n\n| Function | Description |\n|----------|-------------|\n| `(qt-list-view-create)` | Create list view |\n| `(qt-table-view-create)` | Create table view |\n| `(qt-tree-view-create)` | Create tree view |\n| `(qt-view-set-model! view model)` | Set data model |\n| `(qt-view-set-selection-mode! view mode)` | Set selection mode |\n| `(qt-view-set-selection-behavior! view behavior)` | Set selection behavior |\n| `(qt-view-set-alternating-row-colors! view bool)` | Alternating colors |\n| `(qt-view-set-sorting-enabled! view bool)` | Enable sorting |\n| `(qt-view-set-edit-triggers! view triggers)` | Set edit triggers |\n| `(qt-list-view-set-flow! v flow)` | Set list flow direction |\n| `(qt-table-view-set-column-width! v col w)` | Set column width |\n| `(qt-table-view-set-row-height! v row h)` | Set row height |\n| `(qt-table-view-hide-column! v col)` | Hide column |\n| `(qt-table-view-show-column! v col)` | Show column |\n| `(qt-table-view-hide-row! v row)` | Hide row |\n| `(qt-table-view-show-row! v row)` | Show row |\n| `(qt-table-view-resize-columns-to-contents! v)` | Auto-fit columns |\n| `(qt-table-view-resize-rows-to-contents! v)` | Auto-fit rows |\n| `(qt-tree-view-expand-all! v)` | Expand all nodes |\n| `(qt-tree-view-collapse-all! v)` | Collapse all nodes |\n| `(qt-tree-view-set-indentation! v pixels)` | Set indentation |\n| `(qt-tree-view-indentation v)` | Get indentation |\n| `(qt-tree-view-set-root-is-decorated! v bool)` | Root decoration |\n| `(qt-tree-view-set-header-hidden! v bool)` | Hide header |\n| `(qt-tree-view-set-column-width! v col w)` | Set column width |\n\n### QHeaderView (via view)\n\n| Function | Description |\n|----------|-------------|\n| `(qt-view-header-set-stretch-last-section! view bool)` | Stretch last section |\n| `(qt-view-header-set-section-resize-mode! view mode)` | Set resize mode |\n| `(qt-view-header-hide! view)` | Hide header |\n| `(qt-view-header-show! view)` | Show header |\n| `(qt-view-header-set-default-section-size! view size)` | Set default section size |\n\n### QSortFilterProxyModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-sort-filter-proxy-create)` | Create proxy |\n| `(qt-sort-filter-proxy-destroy! p)` | Destroy proxy |\n| `(qt-sort-filter-proxy-set-source-model! p model)` | Set source model |\n| `(qt-sort-filter-proxy-set-filter-regex! p pattern)` | Set filter regex |\n| `(qt-sort-filter-proxy-set-filter-column! p col)` | Filter column |\n| `(qt-sort-filter-proxy-set-filter-case-sensitivity! p cs)` | Case sensitivity |\n| `(qt-sort-filter-proxy-set-filter-role! p role)` | Filter data role |\n| `(qt-sort-filter-proxy-sort! p col)` | Sort by column |\n| `(qt-sort-filter-proxy-set-sort-role! p role)` | Sort data role |\n| `(qt-sort-filter-proxy-set-dynamic-sort-filter! p bool)` | Auto re-sort |\n| `(qt-sort-filter-proxy-invalidate-filter! p)` | Force re-filter |\n| `(qt-sort-filter-proxy-row-count p)` | Visible row count |\n\n### View Signals + Selection\n\n| Function | Description |\n|----------|-------------|\n| `(qt-on-view-clicked! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-double-clicked! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-activated! view handler)` | `(lambda () ...)` |\n| `(qt-on-view-selection-changed! view handler)` | `(lambda () ...)` |\n| `(qt-view-last-clicked-row)` | Row of last click |\n| `(qt-view-last-clicked-col)` | Column of last click |\n| `(qt-view-selected-rows view)` | List of selected row indices |\n| `(qt-view-current-row view)` | Current row (-1 if none) |\n\n### Validators\n\n| Function | Description |\n|----------|-------------|\n| `(qt-int-validator-create min max)` | Integer range validator |\n| `(qt-double-validator-create bottom top decimals)` | Decimal range validator |\n| `(qt-regex-validator-create pattern)` | Regex validator |\n| `(qt-validator-destroy! v)` | Destroy validator |\n| `(qt-validator-validate v input)` | Validate string, returns state constant |\n| `(qt-line-edit-set-validator! edit validator)` | Attach to line edit |\n| `(qt-line-edit-has-acceptable-input? edit)` | Current input passes? |\n\n**Validator state constants:** `QT_VALIDATOR_INVALID` (0), `QT_VALIDATOR_INTERMEDIATE` (1), `QT_VALIDATOR_ACCEPTABLE` (2)\n\n### QPlainTextEdit\n\nEfficient plain text editor for large documents.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-create)` | Create editor |\n| `(qt-plain-text-edit-set-text! e text)` | Set text |\n| `(qt-plain-text-edit-text e)` | Get text |\n| `(qt-plain-text-edit-append! e text)` | Append line |\n| `(qt-plain-text-edit-clear! e)` | Clear all |\n| `(qt-plain-text-edit-set-read-only! e bool)` | Set read-only |\n| `(qt-plain-text-edit-read-only? e)` | Is read-only? |\n| `(qt-plain-text-edit-set-placeholder! e text)` | Set placeholder |\n| `(qt-plain-text-edit-line-count e)` | Line count |\n| `(qt-plain-text-edit-set-max-block-count! e n)` | Limit max lines |\n| `(qt-plain-text-edit-cursor-line e)` | Cursor line (0-based) |\n| `(qt-plain-text-edit-cursor-column e)` | Cursor column (0-based) |\n| `(qt-plain-text-edit-set-line-wrap! e mode)` | Set wrap mode |\n| `(qt-on-plain-text-changed! e handler)` | `(lambda () ...)` |\n\n**Editor extensions:**\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-cursor-position e)` | Get cursor position |\n| `(qt-plain-text-edit-set-cursor-position! e pos)` | Set cursor position |\n| `(qt-plain-text-edit-move-cursor! e operation anchor)` | Move cursor |\n| `(qt-plain-text-edit-select-all! e)` | Select all text |\n| `(qt-plain-text-edit-selected-text e)` | Get selection |\n| `(qt-plain-text-edit-selection-start e)` | Selection start |\n| `(qt-plain-text-edit-selection-end e)` | Selection end |\n| `(qt-plain-text-edit-set-selection! e start end)` | Set selection range |\n| `(qt-plain-text-edit-has-selection? e)` | Has selection? |\n| `(qt-plain-text-edit-insert-text! e text)` | Insert at cursor |\n| `(qt-plain-text-edit-remove-selected-text! e)` | Delete selection |\n| `(qt-plain-text-edit-undo! e)` | Undo |\n| `(qt-plain-text-edit-redo! e)` | Redo |\n| `(qt-plain-text-edit-can-undo? e)` | Can undo? |\n| `(qt-plain-text-edit-cut! e)` | Cut |\n| `(qt-plain-text-edit-copy! e)` | Copy |\n| `(qt-plain-text-edit-paste! e)` | Paste |\n| `(qt-plain-text-edit-text-length e)` | Total text length |\n| `(qt-plain-text-edit-text-range e start end)` | Get text range |\n| `(qt-plain-text-edit-line-from-position e pos)` | Line at position |\n| `(qt-plain-text-edit-line-end-position e line)` | End of line |\n| `(qt-plain-text-edit-find-text e text flags)` | Find text |\n| `(qt-plain-text-edit-ensure-cursor-visible! e)` | Scroll to cursor |\n| `(qt-plain-text-edit-center-cursor! e)` | Center cursor in view |\n\n**Line wrap constants:** `QT_PLAIN_NO_WRAP` (0), `QT_PLAIN_WIDGET_WRAP` (1)\n\n**Cursor movement constants:** `QT_CURSOR_NO_MOVE`, `QT_CURSOR_START`, `QT_CURSOR_UP`, `QT_CURSOR_START_OF_LINE`, `QT_CURSOR_END_OF_LINE`, `QT_CURSOR_NEXT_CHAR`, `QT_CURSOR_PREVIOUS_CHAR`, `QT_CURSOR_END`, `QT_CURSOR_DOWN`, etc.\n\n**Anchor constants:** `QT_MOVE_ANCHOR`, `QT_KEEP_ANCHOR`\n\n**Find flags:** `QT_FIND_BACKWARD`, `QT_FIND_CASE_SENSITIVE`, `QT_FIND_WHOLE_WORDS`\n\n### QTextDocument\n\n| Function | Description |\n|----------|-------------|\n| `(qt-text-document-create)` | Create document |\n| `(qt-plain-text-document-create)` | Create plain text document |\n| `(qt-text-document-destroy! doc)` | Destroy document |\n| `(qt-plain-text-edit-document e)` | Get editor's document |\n| `(qt-plain-text-edit-set-document! e doc)` | Set editor's document |\n| `(qt-text-document-modified? doc)` | Is modified? |\n| `(qt-text-document-set-modified! doc bool)` | Set modified flag |\n\n### QToolButton\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tool-button-create)` | Create tool button |\n| `(qt-tool-button-set-text! b text)` | Set text |\n| `(qt-tool-button-text b)` | Get text |\n| `(qt-tool-button-set-icon! b path)` | Set icon from file |\n| `(qt-tool-button-set-menu! b menu)` | Attach dropdown menu |\n| `(qt-tool-button-set-popup-mode! b mode)` | Set popup mode |\n| `(qt-tool-button-set-auto-raise! b bool)` | Auto-raise appearance |\n| `(qt-tool-button-set-arrow-type! b arrow)` | Set arrow indicator |\n| `(qt-tool-button-set-tool-button-style! b style)` | Set display style |\n| `(qt-on-tool-button-clicked! b handler)` | `(lambda () ...)` |\n\n**Popup mode:** `QT_DELAYED_POPUP` (0), `QT_MENU_BUTTON_POPUP` (1), `QT_INSTANT_POPUP` (2)\n\n**Arrow type:** `QT_NO_ARROW` (0), `QT_UP_ARROW` (1), `QT_DOWN_ARROW` (2), `QT_LEFT_ARROW` (3), `QT_RIGHT_ARROW` (4)\n\n**Style:** `QT_TOOL_BUTTON_ICON_ONLY` (0), `QT_TOOL_BUTTON_TEXT_ONLY` (1), `QT_TOOL_BUTTON_TEXT_BESIDE_ICON` (2), `QT_TOOL_BUTTON_TEXT_UNDER_ICON` (3)\n\n### QSizePolicy\n\n| Function | Description |\n|----------|-------------|\n| `(qt-widget-set-size-policy! w h-policy v-policy)` | Set size policy |\n\n**Constants:** `QT_SIZE_FIXED` (0), `QT_SIZE_MINIMUM` (1), `QT_SIZE_MINIMUM_EXPANDING` (3), `QT_SIZE_MAXIMUM` (4), `QT_SIZE_PREFERRED` (5), `QT_SIZE_EXPANDING` (7), `QT_SIZE_IGNORED` (13)\n\n### QGraphicsScene\n\n2D scene graph for interactive diagrams.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-scene-create x y w h)` | Create scene with bounds |\n| `(qt-graphics-scene-add-rect! scene x y w h)` | Add rectangle |\n| `(qt-graphics-scene-add-ellipse! scene x y w h)` | Add ellipse |\n| `(qt-graphics-scene-add-line! scene x1 y1 x2 y2)` | Add line |\n| `(qt-graphics-scene-add-text! scene text)` | Add text item |\n| `(qt-graphics-scene-add-pixmap! scene pixmap)` | Add pixmap |\n| `(qt-graphics-scene-remove-item! scene item)` | Remove item |\n| `(qt-graphics-scene-clear! scene)` | Clear all items |\n| `(qt-graphics-scene-items-count scene)` | Item count |\n| `(qt-graphics-scene-set-background! scene r g b)` | Set background color |\n| `(qt-graphics-scene-destroy! scene)` | Destroy scene (and all items) |\n\n### QGraphicsView\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-view-create scene)` | Create view for scene |\n| `(qt-graphics-view-set-render-hint! view hint)` | Set render hint |\n| `(qt-graphics-view-set-drag-mode! view mode)` | Set drag mode |\n| `(qt-graphics-view-fit-in-view! view)` | Fit scene to view |\n| `(qt-graphics-view-scale! view sx sy)` | Zoom |\n| `(qt-graphics-view-center-on! view x y)` | Center on coordinates |\n\n### QGraphicsItem\n\n| Function | Description |\n|----------|-------------|\n| `(qt-graphics-item-set-pos! item x y)` | Set position |\n| `(qt-graphics-item-x item)` | Get X |\n| `(qt-graphics-item-y item)` | Get Y |\n| `(qt-graphics-item-set-pen! item r g b width)` | Set outline |\n| `(qt-graphics-item-set-brush! item r g b)` | Set fill |\n| `(qt-graphics-item-set-flags! item flags)` | Set interaction flags |\n| `(qt-graphics-item-set-tooltip! item text)` | Set tooltip |\n| `(qt-graphics-item-set-zvalue! item z)` | Set stacking order |\n| `(qt-graphics-item-zvalue item)` | Get stacking order |\n| `(qt-graphics-item-set-rotation! item angle)` | Set rotation |\n| `(qt-graphics-item-set-scale! item factor)` | Set scale |\n| `(qt-graphics-item-set-visible! item bool)` | Show/hide |\n\n**Item flags:** `QT_ITEM_MOVABLE` (0x1), `QT_ITEM_SELECTABLE` (0x2), `QT_ITEM_FOCUSABLE` (0x4). Combine with `bitwise-ior`.\n\n**Drag modes:** `QT_DRAG_NONE` (0), `QT_DRAG_SCROLL` (1), `QT_DRAG_RUBBER_BAND` (2)\n\n**Render hints:** `QT_RENDER_ANTIALIASING` (0x01), `QT_RENDER_SMOOTH_PIXMAP` (0x02), `QT_RENDER_TEXT_ANTIALIASING` (0x04)\n\n### PaintWidget (custom paintEvent)\n\nA QWidget subclass that fires a Scheme callback during `paintEvent()`.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-paint-widget-create)` | Create custom paint widget |\n| `(qt-on-paint! widget handler)` | Register paint callback |\n| `(qt-paint-widget-painter widget)` | Get active QPainter (only valid inside callback) |\n| `(qt-paint-widget-update! widget)` | Request repaint |\n| `(qt-paint-widget-width widget)` | Current width |\n| `(qt-paint-widget-height widget)` | Current height |\n\n### QProcess\n\n| Function | Description |\n|----------|-------------|\n| `(qt-process-create)` | Create process |\n| `(qt-process-start! proc program args)` | Start process |\n| `(qt-process-write! proc data)` | Write to stdin |\n| `(qt-process-close-write! proc)` | Close stdin |\n| `(qt-process-read-stdout proc)` | Read stdout |\n| `(qt-process-read-stderr proc)` | Read stderr |\n| `(qt-process-wait-for-finished! proc msecs)` | Wait for exit |\n| `(qt-process-exit-code proc)` | Get exit code |\n| `(qt-process-state proc)` | Get state |\n| `(qt-process-kill! proc)` | Kill (SIGKILL) |\n| `(qt-process-terminate! proc)` | Terminate (SIGTERM) |\n| `(qt-on-process-finished! proc handler)` | `(lambda (exit-code) ...)` |\n| `(qt-on-process-ready-read! proc handler)` | `(lambda () ...)` |\n| `(qt-process-destroy! proc)` | Destroy process |\n\n**Constants:** `QT_PROCESS_NOT_RUNNING` (0), `QT_PROCESS_STARTING` (1), `QT_PROCESS_RUNNING` (2)\n\n### QWizard / QWizardPage\n\n| Function | Description |\n|----------|-------------|\n| `(qt-wizard-create)` | Create wizard dialog |\n| `(qt-wizard-add-page! wizard page)` | Add page, returns ID |\n| `(qt-wizard-set-start-id! wizard id)` | Set starting page |\n| `(qt-wizard-current-id wizard)` | Current page ID |\n| `(qt-wizard-set-title! wizard title)` | Set title |\n| `(qt-wizard-exec! wizard)` | Run modal wizard |\n| `(qt-wizard-page-create)` | Create page |\n| `(qt-wizard-page-set-title! page title)` | Set page title |\n| `(qt-wizard-page-set-subtitle! page subtitle)` | Set subtitle |\n| `(qt-wizard-page-set-layout! page layout)` | Set page layout |\n| `(qt-on-wizard-current-changed! wizard handler)` | `(lambda (page-id) ...)` |\n\n### QMdiArea / QMdiSubWindow\n\n| Function | Description |\n|----------|-------------|\n| `(qt-mdi-area-create)` | Create MDI area |\n| `(qt-mdi-area-add-sub-window! area widget)` | Add sub-window |\n| `(qt-mdi-area-remove-sub-window! area sub)` | Remove sub-window |\n| `(qt-mdi-area-active-sub-window area)` | Get active (or `#f`) |\n| `(qt-mdi-area-sub-window-count area)` | Count sub-windows |\n| `(qt-mdi-area-cascade! area)` | Cascade layout |\n| `(qt-mdi-area-tile! area)` | Tile layout |\n| `(qt-mdi-area-set-view-mode! area mode)` | Set view mode |\n| `(qt-mdi-sub-window-set-title! sub title)` | Set title |\n| `(qt-on-mdi-sub-window-activated! area handler)` | `(lambda () ...)` |\n\n**Constants:** `QT_MDI_SUBWINDOW` (0), `QT_MDI_TABBED` (1)\n\n### QDial\n\n| Function | Description |\n|----------|-------------|\n| `(qt-dial-create)` | Create dial (knob) |\n| `(qt-dial-set-value! dial value)` | Set value |\n| `(qt-dial-value dial)` | Get value |\n| `(qt-dial-set-range! dial min max)` | Set range |\n| `(qt-dial-set-notches-visible! dial bool)` | Show notches |\n| `(qt-dial-set-wrapping! dial bool)` | Enable wrap-around |\n| `(qt-on-dial-value-changed! dial handler)` | `(lambda (value) ...)` |\n\n### QLCDNumber\n\n| Function | Description |\n|----------|-------------|\n| `(qt-lcd-create digits)` | Create LCD display |\n| `(qt-lcd-display-int! lcd value)` | Display integer |\n| `(qt-lcd-display-double! lcd value)` | Display float |\n| `(qt-lcd-display-string! lcd text)` | Display string |\n| `(qt-lcd-set-mode! lcd mode)` | Set mode (dec/hex/oct/bin) |\n| `(qt-lcd-set-segment-style! lcd style)` | Set style |\n\n**Constants:** `QT_LCD_DEC` (0), `QT_LCD_HEX` (1), `QT_LCD_OCT` (2), `QT_LCD_BIN` (3); `QT_LCD_OUTLINE` (0), `QT_LCD_FILLED` (1), `QT_LCD_FLAT` (2)\n\n### QToolBox\n\n| Function | Description |\n|----------|-------------|\n| `(qt-tool-box-create)` | Create accordion widget |\n| `(qt-tool-box-add-item! tb widget text)` | Add page |\n| `(qt-tool-box-set-current-index! tb index)` | Switch page |\n| `(qt-tool-box-current-index tb)` | Current page index |\n| `(qt-tool-box-count tb)` | Page count |\n| `(qt-tool-box-set-item-text! tb index text)` | Change label |\n| `(qt-on-tool-box-current-changed! tb handler)` | `(lambda (index) ...)` |\n\n### QUndoStack\n\n| Function | Description |\n|----------|-------------|\n| `(qt-undo-stack-create)` | Create undo stack |\n| `(qt-undo-stack-push! stack text undo-handler redo-handler)` | Push command |\n| `(qt-undo-stack-undo! stack)` | Undo |\n| `(qt-undo-stack-redo! stack)` | Redo |\n| `(qt-undo-stack-can-undo? stack)` | Can undo? |\n| `(qt-undo-stack-can-redo? stack)` | Can redo? |\n| `(qt-undo-stack-undo-text stack)` | Next undo text |\n| `(qt-undo-stack-redo-text stack)` | Next redo text |\n| `(qt-undo-stack-clear! stack)` | Clear history |\n| `(qt-undo-stack-create-undo-action stack)` | Create undo QAction |\n| `(qt-undo-stack-create-redo-action stack)` | Create redo QAction |\n| `(qt-undo-stack-destroy! stack)` | Destroy stack |\n\n```scheme\n;; Undo/redo example\n(qt-undo-stack-push! stack \"Increment\"\n (lambda () (set! counter (- counter 1))) ; undo\n (lambda () (set! counter (+ counter 1)))) ; redo (called immediately)\n(qt-undo-stack-undo! stack) ; counter goes back\n(qt-undo-stack-redo! stack) ; counter goes forward\n```\n\n### QFileSystemModel\n\n| Function | Description |\n|----------|-------------|\n| `(qt-file-system-model-create)` | Create filesystem model |\n| `(qt-file-system-model-set-root-path! model path)` | Set root directory |\n| `(qt-file-system-model-set-filter! model filters)` | Set filters (`bitwise-ior`) |\n| `(qt-file-system-model-set-name-filters! model patterns)` | Set glob patterns (list of strings) |\n| `(qt-file-system-model-file-path model row col)` | Get file path |\n| `(qt-tree-view-set-file-system-root! view model path)` | Set tree root |\n| `(qt-file-system-model-destroy! model)` | Destroy model |\n\n**Constants:** `QT_DIR_DIRS`, `QT_DIR_FILES`, `QT_DIR_HIDDEN`, `QT_DIR_NO_DOT_AND_DOT_DOT`\n\n### QSyntaxHighlighter\n\nRegex-based syntax highlighting for QPlainTextEdit.\n\n| Function | Description |\n|----------|-------------|\n| `(qt-syntax-highlighter-create document)` | Create highlighter on a document |\n| `(qt-syntax-highlighter-destroy! h)` | Destroy highlighter |\n| `(qt-syntax-highlighter-add-rule! h pattern fg-color bold)` | Add regex rule |\n| `(qt-syntax-highlighter-add-keywords! h words fg-color bold)` | Add keyword list |\n| `(qt-syntax-highlighter-add-multiline-rule! h start end fg-color bold)` | Add multiline pattern |\n| `(qt-syntax-highlighter-clear-rules! h)` | Clear all rules |\n| `(qt-syntax-highlighter-rehighlight! h)` | Re-apply highlighting |\n\n### Line Number Area\n\n| Function | Description |\n|----------|-------------|\n| `(qt-line-number-area-create editor)` | Create line numbers for QPlainTextEdit |\n| `(qt-line-number-area-destroy! area)` | Destroy line number area |\n| `(qt-line-number-area-set-visible! area bool)` | Show/hide |\n| `(qt-line-number-area-set-bg-color! area color)` | Set background color |\n| `(qt-line-number-area-set-fg-color! area color)` | Set text color |\n\n### Extra Selections\n\n| Function | Description |\n|----------|-------------|\n| `(qt-plain-text-edit-clear-extra-selections! e)` | Clear highlights |\n| `(qt-plain-text-edit-add-extra-selection-line! e line bg-color)` | Highlight line |\n| `(qt-plain-text-edit-add-extra-selection-range! e start end fg bg)` | Highlight range |\n| `(qt-plain-text-edit-apply-extra-selections! e)` | Apply pending highlights |\n\n### QScintilla\n\nAdvanced code editor component (requires libqscintilla2).\n\n| Function | Description |\n|----------|-------------|\n| `(qt-scintilla-create)` | Create Scintilla editor |\n| `(qt-scintilla-destroy! s)` | Destroy editor |\n| `(qt-scintilla-send-message s msg wparam lparam)` | Send raw Scintilla message |\n| `(qt-scintilla-send-message-string s msg wparam str)` | Send message with string |\n| `(qt-scintilla-receive-string s msg wparam)` | Receive string from message |\n| `(qt-scintilla-set-text! s text)` | Set text |\n| `(qt-scintilla-get-text s)` | Get text |\n| `(qt-scintilla-get-text-length s)` | Get text length |\n| `(qt-scintilla-set-lexer-language! s language)` | Set lexer (e.g. `\"cpp\"`) |\n| `(qt-scintilla-get-lexer-language s)` | Get lexer language |\n| `(qt-scintilla-set-read-only! s bool)` | Set read-only |\n| `(qt-scintilla-read-only? s)` | Is read-only? |\n| `(qt-scintilla-set-margin-width! s margin pixels)` | Set margin width |\n| `(qt-scintilla-set-margin-type! s margin type)` | Set margin type |\n| `(qt-scintilla-set-focus! s)` | Set keyboard focus |\n| `(qt-on-scintilla-text-changed! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-char-added! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-save-point-reached! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-save-point-left! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-margin-clicked! s handler)` | `(lambda () ...)` |\n| `(qt-on-scintilla-modified! s handler)` | `(lambda () ...)` |\n\n### Signal Disconnect & Callback Management\n\n| Function | Description |\n|----------|-------------|\n| `(unregister-qt-handler! id)` | Remove callback by ID (returned from `qt-on-*!`) |\n| `(qt-disconnect-all! obj)` | Disconnect all signals from a QObject |\n\nAll `qt-on-*!` functions return a callback ID:\n\n```scheme\n(let ((id (qt-on-clicked! button (lambda () (display \"clicked!\\n\")))))\n ;; Later, remove the handler:\n (unregister-qt-handler! id))\n```\n\nCalling `qt-on-*!` multiple times accumulates connections. To replace a handler, unregister the old one first.\n\n### Resource Safety Macros\n\nRAII-style macros that guarantee cleanup even on exceptions.\n\n| Macro | Description |\n|-------|-------------|\n| `(with-painter (p target) body ...)` | Create QPainter, auto end+destroy |\n| `(with-qt-app app body ...)` | Create QApplication, auto destroy |\n\n## Constants Reference\n\n### Alignment\n`QT_ALIGN_LEFT`, `QT_ALIGN_RIGHT`, `QT_ALIGN_CENTER`, `QT_ALIGN_TOP`, `QT_ALIGN_BOTTOM`\n\n### Orientation\n`QT_HORIZONTAL`, `QT_VERTICAL`\n\n### Echo Mode\n`QT_ECHO_NORMAL`, `QT_ECHO_NO_ECHO`, `QT_ECHO_PASSWORD`, `QT_ECHO_PASSWORD_ON_EDIT`\n\n### Tick Position\n`QT_TICKS_NONE`, `QT_TICKS_ABOVE`, `QT_TICKS_BELOW`, `QT_TICKS_BOTH_SIDES`\n\n### Window State\n`QT_WINDOW_NO_STATE`, `QT_WINDOW_MINIMIZED`, `QT_WINDOW_MAXIMIZED`, `QT_WINDOW_FULL_SCREEN`\n\n### Scrollbar Policy\n`QT_SCROLLBAR_AS_NEEDED`, `QT_SCROLLBAR_ALWAYS_OFF`, `QT_SCROLLBAR_ALWAYS_ON`\n\n### Cursor Shape\n`QT_CURSOR_ARROW`, `QT_CURSOR_CROSS`, `QT_CURSOR_WAIT`, `QT_CURSOR_IBEAM`, `QT_CURSOR_POINTING_HAND`, `QT_CURSOR_FORBIDDEN`, `QT_CURSOR_BUSY`\n\n### Frame\n**Shape:** `QT_FRAME_NO_FRAME`, `QT_FRAME_BOX`, `QT_FRAME_PANEL`, `QT_FRAME_WIN_PANEL`, `QT_FRAME_HLINE`, `QT_FRAME_VLINE`, `QT_FRAME_STYLED_PANEL`\n\n**Shadow:** `QT_FRAME_PLAIN`, `QT_FRAME_RAISED`, `QT_FRAME_SUNKEN`\n\n### Dock Area\n`QT_DOCK_LEFT`, `QT_DOCK_RIGHT`, `QT_DOCK_TOP`, `QT_DOCK_BOTTOM`\n\n### Tray Icon\n`QT_TRAY_NO_ICON`, `QT_TRAY_INFORMATION`, `QT_TRAY_WARNING`, `QT_TRAY_CRITICAL`\n\n### Key Codes\n`QT_KEY_ESCAPE`, `QT_KEY_TAB`, `QT_KEY_BACKTAB`, `QT_KEY_BACKSPACE`, `QT_KEY_RETURN`, `QT_KEY_ENTER`, `QT_KEY_INSERT`, `QT_KEY_DELETE`, `QT_KEY_PAUSE`, `QT_KEY_HOME`, `QT_KEY_END`, `QT_KEY_LEFT`, `QT_KEY_UP`, `QT_KEY_RIGHT`, `QT_KEY_DOWN`, `QT_KEY_PAGE_UP`, `QT_KEY_PAGE_DOWN`, `QT_KEY_F1`..`QT_KEY_F12`, `QT_KEY_SPACE`\n\n### Key Modifiers\n`QT_MOD_NONE`, `QT_MOD_SHIFT`, `QT_MOD_CONTROL`, `QT_MOD_ALT`, `QT_MOD_META`\n\n### Selection\n**Mode:** `QT_SELECT_NO_SELECTION`, `QT_SELECT_SINGLE`, `QT_SELECT_MULTI`, `QT_SELECT_EXTENDED`, `QT_SELECT_CONTIGUOUS`\n\n**Behavior:** `QT_SELECT_ITEMS`, `QT_SELECT_ROWS`, `QT_SELECT_COLUMNS`\n\n### Sort Order\n`QT_SORT_ASCENDING`, `QT_SORT_DESCENDING`\n\n### Check State\n`QT_UNCHECKED`, `QT_PARTIALLY_CHECKED`, `QT_CHECKED`\n\n### Header Resize Mode\n`QT_HEADER_INTERACTIVE`, `QT_HEADER_STRETCH`, `QT_HEADER_FIXED`, `QT_HEADER_RESIZE_TO_CONTENTS`\n\n### Edit Triggers\n`QT_NO_EDIT_TRIGGERS`, `QT_EDIT_DOUBLE_CLICK`, `QT_EDIT_SELECTED_CLICK`, `QT_EDIT_ANY_KEY_PRESSED`, `QT_EDIT_ALL_TRIGGERS`\n\n### Flow Direction\n`QT_FLOW_TOP_TO_BOTTOM`, `QT_FLOW_LEFT_TO_RIGHT`\n\n### Day of Week\n`QT_MONDAY`, `QT_TUESDAY`, `QT_WEDNESDAY`, `QT_THURSDAY`, `QT_FRIDAY`, `QT_SATURDAY`, `QT_SUNDAY`\n\n## Architecture\n\nThe binding uses a three-layer architecture:\n\n1. **C++ shim** (`vendor/qt_shim.h`, `vendor/qt_shim.cpp` in qt-vendor) -- thin `extern \"C\"` wrappers around Qt6 C++ classes. All Qt objects are opaque `void*` handles. Compiled as `libqt_shim.so`.\n\n2. **Chez callback bridge** (`jerboa_qt_shim.c`) -- stores Chez-provided `foreign-callable` function pointers and provides C wrapper functions that pass them to the C++ shim's signal connection APIs. Unlike Gambit's compile-time `c-define` trampolines, Chez creates callback pointers at runtime.\n\n3. **FFI layer** (`jerboa-qt/ffi.ss`) -- Chez `foreign-procedure` bindings for each C function. Loads `libqt_shim.so` and `jerboa_qt_shim.so` at library import time. Registers the four callback trampolines (void/string/int/bool) that dispatch to Scheme closures via a callback table.\n\n4. **High-level API** (`jerboa-qt/qt.ss`) -- Idiomatic Chez Scheme wrappers with boolean conversions, the `with-qt-app` macro, and all the `qt-on-*!` signal registration functions.\n\n### Callback Pattern\n\nQt signals are connected to Scheme handlers through a callback trampoline system:\n\n```\nQt signal -> C++ lambda -> chez_qt_*() wrapper -> foreign-callable trampoline\n -> callback table lookup -> user's Scheme closure\n```\n\nFour callback types cover all signals: `void`, `string(text)`, `int(value)`, `bool(checked)`.\n\nAll `qt-on-*!` signal registration functions return a callback ID (integer). Use `unregister-qt-handler!` to remove a specific callback, or `qt-disconnect-all!` to disconnect all signals from a QObject.\n\n### Memory Management\n\nQt uses parent-child ownership: destroying a parent automatically destroys all children. No GC finalizers are used on parented widgets. The QApplication must be explicitly destroyed (or use `with-qt-app`).\n\n## Examples\n\n| Example | Description |\n|---------|-------------|\n| `hello.ss` | Minimal window with label |\n| `counter.ss` | Button click counter |\n| `form.ss` | Form with text inputs, checkboxes, combo box, spin box, message boxes |\n| `editor.ss` | Text editor with menus, toolbar, keyboard shortcuts, file I/O |\n| `dashboard.ss` | Tabbed dashboard with todo list, data table, slider + progress bar |\n| `filebrowser.ss` | File browser with tree view, grid layout, timer clock, clipboard |\n| `styled.ss` | Dark-themed split-pane app with scroll area, key events, fullscreen toggle |\n| `settings.ss` | Settings dialog with radio buttons, button groups, group boxes, dark theme |\n| `painter.ss` | QPainter demo with shapes, text, transforms, compositing |\n| `datainput.ss` | Double spin box, date/time pickers, frames, progress dialog, input dialogs |\n| `planner.ss` | Event planner with form layout, calendar, rich text preview, dialog buttons, shortcuts |\n| `autocomplete.ss` | Search with auto-complete, persistent history (QSettings), tooltips |\n| `modelviewer.ss` | Model/View with sortable table, live text filter, tree hierarchy |\n| `polished.ss` | Validated inputs, tool buttons, log area, size policies |\n| `diagram.ss` | Interactive diagram with QGraphicsScene/View and custom PaintWidget |\n| `terminal.ss` | Simple terminal with QProcess, command input, streaming output |\n| `widgets.ss` | QDial + QLCDNumber, QToolBox accordion, QUndoStack undo/redo |\n| `filemanager.ss` | File system browser with QFileSystemModel + QTreeView, filters |\n| `wizard.ss` | Multi-step wizard dialog with QWizard/QWizardPage |\n| `mdi.ss` | Multi-document interface with QMdiArea, undo/redo, tile/cascade |\n| `dockable.ss` | Dock widgets with QDockWidget |\n| `trayapp.ss` | System tray icon with context menu and notifications |\n| `dragdrop.ss` | Drag and drop text between widgets |\n| `keyboard.ss` | Keyboard event handling demo |\n| `dialogs.ss` | All dialog types (message, file, input, color, font) |\n| `richtext.ss` | Rich text editing with QTextBrowser |\n\n## License\n\nMIT\n"} {"text":";; FILE: jerboa-qt/compile-libs.ss\n;;; compile-libs.ss — Compile jerboa-qt libraries\n(import (jerboa-qt ffi) (jerboa-qt qt))\n"} -{"text":";; FILE: jerboa-qt/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-qt/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-qt/qt-test.ss\n;;; qt-test.ss — Test suite for jerboa-qt\n;;;\n;;; Run: make test\n\n(import (chezscheme)\n (jerboa-qt qt))\n\n(define *pass* 0)\n(define *fail* 0)\n(define *skip* 0)\n(define *test-name* \"\")\n(define *run-known-crash-tests*\n (equal? (getenv \"JERBOA_QT_RUN_KNOWN_CRASH_TESTS\") \"1\"))\n(define immediate-exit (foreign-procedure \"_exit\" (int) void))\n\n(define (finish-tests status)\n (flush-output-port (current-output-port))\n (flush-output-port (current-error-port))\n (immediate-exit status))\n\n(define-syntax test-group\n (syntax-rules ()\n [(_ name body ...)\n (begin\n (display (string-append \"\\n=== \" name \" ===\\n\"))\n body ...)]))\n\n(define-syntax test-case\n (syntax-rules ()\n [(_ name body ...)\n (begin\n (set! *test-name* name)\n (guard (e [#t (set! *fail* (+ *fail* 1))\n\t (display (string-append \" FAIL: \" name \"\\n\"))\n\t (display (string-append \" error: \"\n\t (if (message-condition? e)\n\t (condition-message e)\n\t (format \"~s\" e))\n\t \"\\n\"))])\n body ...\n (set! *pass* (+ *pass* 1))\n (display (string-append \" pass: \" name \"\\n\"))))]))\n\n(define (skip-case name reason)\n (set! *skip* (+ *skip* 1))\n (display (string-append \" skip: \" name \" (\" reason \")\\n\")))\n\n(define-syntax check\n (syntax-rules (=> ?)\n [(_ expr => expected)\n (let ([got expr] [exp expected])\n (unless (equal? got exp)\n (error 'check\n (format \"~a: expected ~s, got ~s\" *test-name* exp got))))]\n [(_ expr ? pred)\n (let ([got expr])\n (unless (pred got)\n (error 'check\n (format \"~a: predicate failed for ~s\" *test-name* got))))]))\n\n;; Create the QApplication (required for all Qt tests)\n(define test-app (qt-app-create))\n\n;; ==================== Phase 1: Core ====================\n\n(test-group \"core\"\n (test-case \"application create\"\n (check (not (eqv? test-app 0)) ? values))\n\n (test-case \"main window create\"\n (let ((win (qt-main-window-create)))\n (check (not (eqv? win 0)) ? values)\n (qt-main-window-set-title! win \"Test Window\")\n (qt-widget-destroy! win)))\n\n (test-case \"widget create\"\n (let ((w (qt-widget-create)))\n (check (not (eqv? w 0)) ? values)\n (qt-widget-destroy! w)))\n\n (test-case \"widget enabled round-trip\"\n (let ((w (qt-widget-create)))\n (check (qt-widget-enabled? w) => #t)\n (qt-widget-set-enabled! w #f)\n (check (qt-widget-enabled? w) => #f)\n (qt-widget-set-enabled! w #t)\n (check (qt-widget-enabled? w) => #t)\n (qt-widget-destroy! w)))\n\n (test-case \"widget visible round-trip\"\n (let ((w (qt-widget-create)))\n (check (qt-widget-visible? w) => #f)\n (qt-widget-set-visible! w #t)\n (check (qt-widget-visible? w) => #t)\n (qt-widget-set-visible! w #f)\n (check (qt-widget-visible? w) => #f)\n (qt-widget-destroy! w)))\n\n (test-case \"layout create\"\n (let* ((w (qt-widget-create))\n (vbox (qt-vbox-layout-create w))\n\t (w2 (qt-widget-create))\n\t (hbox (qt-hbox-layout-create w2)))\n\t (check (not (eqv? vbox 0)) ? values)\n\t (check (not (eqv? hbox 0)) ? values)))\n\n (test-case \"label text round-trip\"\n (let ((l (qt-label-create \"hello\")))\n (check (qt-label-text l) => \"hello\")\n (qt-label-set-text! l \"world\")\n (check (qt-label-text l) => \"world\")\n (qt-widget-destroy! l)))\n\n (test-case \"label word wrap\"\n (let ((l (qt-label-create \"long text\")))\n (qt-label-set-word-wrap! l #t)\n (qt-label-set-word-wrap! l #f)\n (qt-widget-destroy! l)))\n\n (test-case \"widget minimum/maximum width and height\"\n (let ((w (qt-widget-create)))\n (qt-widget-set-minimum-width! w 100)\n (qt-widget-set-minimum-height! w 50)\n (qt-widget-set-maximum-width! w 800)\n (qt-widget-set-maximum-height! w 600)\n (qt-widget-destroy! w)))\n\n (test-case \"widget set cursor\"\n (let ((w (qt-widget-create)))\n (qt-widget-set-cursor! w QT_CURSOR_POINTING_HAND)\n (qt-widget-set-cursor! w QT_CURSOR_WAIT)\n (qt-widget-unset-cursor! w)\n (qt-widget-destroy! w)))\n\n (test-case \"push button text round-trip\"\n (let ((b (qt-push-button-create \"Click\")))\n (check (qt-push-button-text b) => \"Click\")\n (qt-push-button-set-text! b \"Press\")\n (check (qt-push-button-text b) => \"Press\")\n (qt-widget-destroy! b)))\n\n (test-case \"button clicked signal registration\"\n (let ((b (qt-push-button-create \"Test\")))\n (qt-on-clicked! b (lambda () #t))\n (qt-widget-destroy! b))))\n\n;; ==================== Phase 2: Core Widgets ====================\n\n(test-group \"core widgets\"\n (test-case \"line edit text round-trip\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-text! e \"test input\")\n (check (qt-line-edit-text e) => \"test input\")\n (qt-line-edit-set-text! e \"\")\n (check (qt-line-edit-text e) => \"\")\n (qt-widget-destroy! e)))\n\n (test-case \"line edit placeholder and read-only\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-placeholder! e \"Enter text...\")\n (qt-line-edit-set-read-only! e #t)\n (qt-widget-destroy! e)))\n\n (test-case \"line edit echo mode\"\n (let ((e (qt-line-edit-create)))\n (qt-line-edit-set-echo-mode! e QT_ECHO_PASSWORD)\n (qt-line-edit-set-echo-mode! e QT_ECHO_NORMAL)\n (qt-widget-destroy! e)))\n\n (test-case \"line edit signal registration\"\n (let ((e (qt-line-edit-create)))\n (qt-on-text-changed! e (lambda (text) #t))\n (qt-on-return-pressed! e (lambda () #t))\n (qt-widget-destroy! e)))\n\n (test-case \"check box checked round-trip\"\n (let ((c (qt-check-box-create \"Option\")))\n (check (qt-check-box-checked? c) => #f)\n (qt-check-box-set-checked! c #t)\n (check (qt-check-box-checked? c) => #t)\n (qt-check-box-set-checked! c #f)\n (check (qt-check-box-checked? c) => #f)\n (qt-widget-destroy! c)))\n\n (test-case \"check box set text\"\n (let ((c (qt-check-box-create \"Before\")))\n (qt-check-box-set-text! c \"After\")\n (qt-widget-destroy! c)))\n\n (test-case \"check box signal registration\"\n (let ((c (qt-check-box-create \"Test\")))\n (qt-on-toggled! c (lambda (checked) #t))\n (qt-widget-destroy! c)))\n\n (test-case \"combo box add items and round-trip\"\n (let ((c (qt-combo-box-create)))\n (check (qt-combo-box-count c) => 0)\n (qt-combo-box-add-item! c \"Apple\")\n (qt-combo-box-add-item! c \"Banana\")\n (qt-combo-box-add-item! c \"Cherry\")\n (check (qt-combo-box-count c) => 3)\n (check (qt-combo-box-current-index c) => 0)\n (check (qt-combo-box-current-text c) => \"Apple\")\n (qt-combo-box-set-current-index! c 2)\n (check (qt-combo-box-current-index c) => 2)\n (check (qt-combo-box-current-text c) => \"Cherry\")\n (qt-widget-destroy! c)))\n\n (test-case \"combo box clear\"\n (let ((c (qt-combo-box-create)))\n (qt-combo-box-add-item! c \"X\")\n (qt-combo-box-add-item! c \"Y\")\n (check (qt-combo-box-count c) => 2)\n (qt-combo-box-clear! c)\n (check (qt-combo-box-count c) => 0)\n (qt-widget-destroy! c)))\n\n (test-case \"combo box signal registration\"\n (let ((c (qt-combo-box-create)))\n (qt-on-index-changed! c (lambda (idx) #t))\n (qt-widget-destroy! c)))\n\n (test-case \"text edit text round-trip\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Hello World\")\n (check (qt-text-edit-text e) => \"Hello World\")\n (qt-widget-destroy! e)))\n\n (test-case \"text edit append and clear\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Line 1\")\n (qt-text-edit-append! e \"Line 2\")\n (qt-text-edit-clear! e)\n (check (qt-text-edit-text e) => \"\")\n (qt-widget-destroy! e)))\n\n (test-case \"text edit html\"\n (let ((e (qt-text-edit-create)))\n (qt-text-edit-set-text! e \"Hello World\")\n (let ((html (qt-text-edit-html e)))\n (check (string? html) ? values))\n (qt-widget-destroy! e)))\n\n (test-case \"text edit signal registration\"\n (let ((e (qt-text-edit-create)))\n (qt-on-text-edit-changed! e (lambda () #t))\n (qt-widget-destroy! e)))\n\n (test-case \"spin box value round-trip\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-range! s 0 100)\n (qt-spin-box-set-value! s 42)\n (check (qt-spin-box-value s) => 42)\n (qt-spin-box-set-value! s 0)\n (check (qt-spin-box-value s) => 0)\n (qt-widget-destroy! s)))\n\n (test-case \"spin box range clamping\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-range! s 10 50)\n (qt-spin-box-set-value! s 100)\n (check (qt-spin-box-value s) => 50)\n (qt-spin-box-set-value! s -5)\n (check (qt-spin-box-value s) => 10)\n (qt-widget-destroy! s)))\n\n (test-case \"spin box prefix and suffix\"\n (let ((s (qt-spin-box-create)))\n (qt-spin-box-set-prefix! s \"$\")\n (qt-spin-box-set-suffix! s \" USD\")\n (qt-widget-destroy! s)))\n\n (test-case \"spin box signal registration\"\n (let ((s (qt-spin-box-create)))\n (qt-on-value-changed! s (lambda (val) #t))\n (qt-widget-destroy! s)))\n\n (test-case \"dialog create\"\n (let ((d (qt-dialog-create)))\n (qt-dialog-set-title! d \"Test Dialog\")\n (qt-widget-destroy! d))))\n\n;; ==================== Constants ====================\n\n(test-group \"constants\"\n (test-case \"echo mode constants\"\n (check QT_ECHO_NORMAL => 0)\n (check QT_ECHO_NO_ECHO => 1)\n (check QT_ECHO_PASSWORD => 2)\n (check QT_ECHO_PASSWORD_ON_EDIT => 3))\n\n (test-case \"alignment constants\"\n (check QT_ALIGN_LEFT => #x0001)\n (check QT_ALIGN_RIGHT => #x0002)\n (check QT_ALIGN_CENTER => #x0084)\n (check QT_ALIGN_TOP => #x0020)\n (check QT_ALIGN_BOTTOM => #x0040))\n\n (test-case \"orientation constants\"\n (check QT_HORIZONTAL => #x1)\n (check QT_VERTICAL => #x2)))\n\n;; ==================== Phase 3: Menus, Actions, Toolbars ====================\n\n(test-group \"menus and actions\"\n (test-case \"menu bar from main window\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win)))\n (check (not (eqv? bar 0)) ? values)\n (qt-widget-destroy! win)))\n\n (test-case \"menu and submenu creation\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win))\n (file-menu (qt-menu-bar-add-menu bar \"File\"))\n (sub-menu (qt-menu-add-menu file-menu \"Recent\")))\n (check (not (eqv? file-menu 0)) ? values)\n (check (not (eqv? sub-menu 0)) ? values)\n (qt-widget-destroy! win)))\n\n (test-case \"action create and text round-trip\"\n (let ((a (qt-action-create \"Open\")))\n (check (qt-action-text a) => \"Open\")\n (qt-action-set-text! a \"Close\")\n (check (qt-action-text a) => \"Close\")))\n\n (test-case \"action enabled round-trip\"\n (let ((a (qt-action-create \"Test\")))\n (check (qt-action-enabled? a) => #t)\n (qt-action-set-enabled! a #f)\n (check (qt-action-enabled? a) => #f)\n (qt-action-set-enabled! a #t)\n (check (qt-action-enabled? a) => #t)))\n\n (test-case \"action checkable round-trip\"\n (let ((a (qt-action-create \"Toggle\")))\n (check (qt-action-checkable? a) => #f)\n (qt-action-set-checkable! a #t)\n (check (qt-action-checkable? a) => #t)\n (qt-action-set-checked! a #t)\n (check (qt-action-checked? a) => #t)\n (qt-action-set-checked! a #f)\n (check (qt-action-checked? a) => #f)))\n\n (test-case \"action shortcut and tips\"\n (let ((a (qt-action-create \"Save\")))\n (qt-action-set-shortcut! a \"Ctrl+S\")\n (qt-action-set-tooltip! a \"Save file\")\n (qt-action-set-status-tip! a \"Save current file\")))\n\n (test-case \"action signal registration\"\n (let ((a (qt-action-create \"Act\")))\n (qt-on-triggered! a (lambda () #t))\n (qt-action-set-checkable! a #t)\n (qt-on-action-toggled! a (lambda (checked) #t))))\n\n (test-case \"menu add action and separator\"\n (let* ((win (qt-main-window-create))\n (bar (qt-main-window-menu-bar win))\n (menu (qt-menu-bar-add-menu bar \"Edit\"))\n (act (qt-action-create \"Cut\")))\n (qt-menu-add-action! menu act)\n (qt-menu-add-separator! menu)\n (qt-widget-destroy! win)))\n\n (test-case \"toolbar create and add action\"\n (let* ((win (qt-main-window-create))\n (tb (qt-toolbar-create \"Main\")))\n (qt-main-window-add-toolbar! win tb)\n (let ((act (qt-action-create \"Toolbar Action\")))\n (qt-toolbar-add-action! tb act)\n (qt-toolbar-add-separator! tb))\n (qt-toolbar-set-movable! tb #f)\n (qt-toolbar-set-icon-size! tb 24 24)\n (qt-widget-destroy! win)))\n\n (test-case \"toolbar add widget\"\n (let* ((win (qt-main-window-create))\n (tb (qt-toolbar-create \"Tools\"))\n (btn (qt-push-button-create \"TB Button\")))\n (qt-main-window-add-toolbar! win tb)\n (qt-toolbar-add-widget! tb btn)\n (qt-widget-destroy! win)))\n\n (test-case \"status bar text\"\n (let ((win (qt-main-window-create)))\n (qt-main-window-set-status-bar-text! win \"Ready\")\n (qt-widget-destroy! win))))\n\n;; ==================== Phase 4: Advanced Widgets ====================\n\n(test-group \"list widget\"\n (test-case \"list widget add and count\"\n (let ((l (qt-list-widget-create)))\n (check (qt-list-widget-count l) => 0)\n (qt-list-widget-add-item! l \"Item 1\")\n (qt-list-widget-add-item! l \"Item 2\")\n (qt-list-widget-add-item! l \"Item 3\")\n (check (qt-list-widget-count l) => 3)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget item text\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"Alpha\")\n (qt-list-widget-add-item! l \"Beta\")\n (qt-list-widget-add-item! l \"Gamma\")\n (check (qt-list-widget-item-text l 0) => \"Alpha\")\n (check (qt-list-widget-item-text l 1) => \"Beta\")\n (check (qt-list-widget-item-text l 2) => \"Gamma\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget insert item\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"First\")\n (qt-list-widget-add-item! l \"Third\")\n (qt-list-widget-insert-item! l 1 \"Second\")\n (check (qt-list-widget-count l) => 3)\n (check (qt-list-widget-item-text l 0) => \"First\")\n (check (qt-list-widget-item-text l 1) => \"Second\")\n (check (qt-list-widget-item-text l 2) => \"Third\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget remove item\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"A\")\n (qt-list-widget-add-item! l \"B\")\n (qt-list-widget-add-item! l \"C\")\n (qt-list-widget-remove-item! l 1)\n (check (qt-list-widget-count l) => 2)\n (check (qt-list-widget-item-text l 0) => \"A\")\n (check (qt-list-widget-item-text l 1) => \"C\")\n (qt-widget-destroy! l)))\n\n (test-case \"list widget current row\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"X\")\n (qt-list-widget-add-item! l \"Y\")\n (qt-list-widget-set-current-row! l 1)\n (check (qt-list-widget-current-row l) => 1)\n (qt-list-widget-set-current-row! l 0)\n (check (qt-list-widget-current-row l) => 0)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget clear\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"A\")\n (qt-list-widget-add-item! l \"B\")\n (check (qt-list-widget-count l) => 2)\n (qt-list-widget-clear! l)\n (check (qt-list-widget-count l) => 0)\n (qt-widget-destroy! l)))\n\n (test-case \"list widget signal registration\"\n (let ((l (qt-list-widget-create)))\n (qt-on-current-row-changed! l (lambda (row) #t))\n (qt-on-item-double-clicked! l (lambda (row) #t))\n (qt-widget-destroy! l)))\n\n (test-case \"list widget item data round-trip\"\n (let ((l (qt-list-widget-create)))\n (qt-list-widget-add-item! l \"Visible Text\")\n (qt-list-widget-set-item-data! l 0 \"hidden-id-123\")\n (check (qt-list-widget-item-data l 0) => \"hidden-id-123\")\n (check (qt-list-widget-item-text l 0) => \"Visible Text\")\n (qt-widget-destroy! l))))\n\n(test-group \"table widget\"\n (test-case \"table widget create with dimensions\"\n (let ((t (qt-table-widget-create 3 4)))\n (check (qt-table-widget-row-count t) => 3)\n (check (qt-table-widget-column-count t) => 4)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget set/get item text\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-item! t 0 0 \"A1\")\n (qt-table-widget-set-item! t 0 1 \"B1\")\n (qt-table-widget-set-item! t 1 0 \"A2\")\n (qt-table-widget-set-item! t 1 1 \"B2\")\n (check (qt-table-widget-item-text t 0 0) => \"A1\")\n (check (qt-table-widget-item-text t 0 1) => \"B1\")\n (check (qt-table-widget-item-text t 1 0) => \"A2\")\n (check (qt-table-widget-item-text t 1 1) => \"B2\")\n (qt-widget-destroy! t)))\n\n ;; Known external qt_shim limitation: empty cells currently return a null\n ;; const char*, which cannot cross Chez FFI as a string.\n\n (test-case \"table widget resize row/column counts\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-row-count! t 5)\n (qt-table-widget-set-column-count! t 3)\n (check (qt-table-widget-row-count t) => 5)\n (check (qt-table-widget-column-count t) => 3)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget header items\"\n (let ((t (qt-table-widget-create 2 3)))\n (qt-table-widget-set-horizontal-header! t 0 \"Name\")\n (qt-table-widget-set-horizontal-header! t 1 \"Age\")\n (qt-table-widget-set-horizontal-header! t 2 \"City\")\n (qt-table-widget-set-vertical-header! t 0 \"Row 1\")\n (qt-table-widget-set-vertical-header! t 1 \"Row 2\")\n (qt-widget-destroy! t)))\n\n (test-case \"table widget clear\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-table-widget-set-item! t 0 0 \"data\")\n (qt-table-widget-clear! t)\n (qt-widget-destroy! t)))\n\n (test-case \"table widget signal registration\"\n (let ((t (qt-table-widget-create 2 2)))\n (qt-on-cell-clicked! t (lambda () #t))\n (qt-widget-destroy! t))))\n\n(test-group \"tab widget\"\n (test-case \"tab widget add tabs\"\n (let* ((tw (qt-tab-widget-create))\n (page1 (qt-widget-create))\n (page2 (qt-widget-create)))\n (check (qt-tab-widget-count tw) => 0)\n (qt-tab-widget-add-tab! tw page1 \"Tab 1\")\n (qt-tab-widget-add-tab! tw page2 \"Tab 2\")\n (check (qt-tab-widget-count tw) => 2)\n (qt-widget-destroy! tw)))\n\n (test-case \"tab widget current index\"\n (let* ((tw (qt-tab-widget-create))\n (page1 (qt-widget-create))\n (page2 (qt-widget-create)))\n (qt-tab-widget-add-tab! tw page1 \"Tab 1\")\n (qt-tab-widget-add-tab! tw page2 \"Tab 2\")\n (check (qt-tab-widget-current-index tw) => 0)\n (qt-tab-widget-set-current-index! tw 1)\n (check (qt-tab-widget-current-index tw) => 1)\n (qt-widget-destroy! tw)))\n\n (test-case \"tab widget signal registration\"\n (let ((tw (qt-tab-widget-create)))\n (qt-on-tab-changed! tw (lambda (idx) #t))\n (qt-widget-destroy! tw))))\n\n(test-group \"tree widget\"\n (test-case \"tree widget create\"\n (let ((t (qt-tree-widget-create)))\n (qt-tree-widget-set-column-count! t 2)\n (check (qt-tree-widget-column-count t) => 2)\n (qt-tree-widget-set-header-label! t \"Name\")\n (qt-widget-destroy! t)))\n\n (test-case \"tree widget items\"\n (let ((t (qt-tree-widget-create)))\n (qt-tree-widget-set-column-count! t 1)\n (let ((item (qt-tree-item-create \"Root\")))\n (qt-tree-widget-add-top-level-item! t item)\n (check (qt-tree-widget-top-level-item-count t) => 1)\n (check (qt-tree-item-text item 0) => \"Root\")\n (let ((child (qt-tree-item-create \"Child\")))\n (qt-tree-item-add-child! item child)\n (check (qt-tree-item-child-count item) => 1)))\n (qt-widget-destroy! t)))\n\n (test-case \"tree widget signals\"\n (let ((t (qt-tree-widget-create)))\n (qt-on-current-item-changed! t (lambda () #t))\n (qt-on-tree-item-double-clicked! t (lambda () #t))\n (qt-on-item-expanded! t (lambda () #t))\n (qt-on-item-collapsed! t (lambda () #t))\n (qt-widget-destroy! t))))\n\n;; ==================== Phase 5: Timer, Clipboard ====================\n\n(test-group \"timer\"\n (test-case \"timer create and configure\"\n (let ((tm (qt-timer-create)))\n (qt-timer-set-interval! tm 1000)\n (check (qt-timer-interval tm) => 1000)\n (qt-timer-set-single-shot! tm #t)\n (qt-on-timeout! tm (lambda () #t))\n (qt-timer-destroy! tm)))\n\n (test-case \"timer start/stop\"\n (let ((tm (qt-timer-create)))\n (qt-timer-set-interval! tm 500)\n (check (qt-timer-active? tm) => #f)\n (qt-timer-start! tm 500)\n (check (qt-timer-active? tm) => #t)\n (qt-timer-stop! tm)\n (check (qt-timer-active? tm) => #f)\n (qt-timer-destroy! tm))))\n\n(test-group \"clipboard\"\n (test-case \"clipboard text round-trip\"\n (qt-clipboard-set-text! test-app \"jerboa-qt test\")\n (check (qt-clipboard-text test-app) => \"jerboa-qt test\")))\n\n;; ==================== Phase 6: Keyboard, Window State ====================\n\n(test-group \"keyboard and window state\"\n (test-case \"key handler registration\"\n (let ((w (qt-widget-create)))\n (qt-on-key-press! w (lambda () #t))\n (qt-widget-destroy! w)))\n\n (test-case \"window state functions\"\n (let ((win (qt-main-window-create)))\n (qt-widget-show-minimized! win)\n (qt-widget-show-normal! win)\n (qt-widget-move! win 100 100)\n (qt-widget-destroy! win)))\n\n (test-case \"widget geometry\"\n (let ((w (qt-widget-create)))\n (qt-widget-resize! w 200 150)\n (qt-widget-destroy! w))))\n\n;; ==================== Phase 7: Pixmap, Icon, Radio, Groups ====================\n\n(test-group \"radio buttons and groups\"\n (test-case \"radio button create\"\n (let ((r (qt-radio-button-create \"Option A\")))\n (check (qt-radio-button-text r) => \"Option A\")\n (qt-radio-button-set-text! r \"Option B\")\n (check (qt-radio-button-text r) => \"Option B\")\n (qt-widget-destroy! r)))\n\n (test-case \"radio button checked round-trip\"\n (let ((r (qt-radio-button-create \"Test\")))\n (check (qt-radio-button-checked? r) => #f)\n (qt-radio-button-set-checked! r #t)\n (check (qt-radio-button-checked? r) => #t)\n (qt-widget-destroy! r)))\n\n (test-case \"radio button signal registration\"\n (let ((r (qt-radio-button-create \"Test\")))\n (qt-on-radio-toggled! r (lambda (checked) #t))\n (qt-widget-destroy! r)))\n\n (test-case \"button group\"\n (let ((bg (qt-button-group-create))\n (r1 (qt-radio-button-create \"A\"))\n (r2 (qt-radio-button-create \"B\")))\n (qt-button-group-add-button! bg r1 0)\n (qt-button-group-add-button! bg r2 1)\n (qt-button-group-set-exclusive! bg #t)\n (check (qt-button-group-exclusive? bg) => #t)\n (qt-on-button-group-clicked! bg (lambda (id) #t))\n (qt-button-group-destroy! bg)\n (qt-widget-destroy! r1)\n (qt-widget-destroy! r2)))\n\n (test-case \"group box\"\n (let ((gb (qt-group-box-create \"Settings\")))\n (check (qt-group-box-title gb) => \"Settings\")\n (qt-group-box-set-title! gb \"Options\")\n (check (qt-group-box-title gb) => \"Options\")\n (qt-group-box-set-checkable! gb #t)\n (check (qt-group-box-checkable? gb) => #t)\n (qt-group-box-set-checked! gb #f)\n (check (qt-group-box-checked? gb) => #f)\n (qt-on-group-box-toggled! gb (lambda (checked) #t))\n (qt-widget-destroy! gb))))\n\n;; ==================== Phase 8: Font, Color ====================\n\n(test-group \"font and color\"\n (test-case \"font create and query\"\n (let ((f (qt-font-create \"Monospace\" 12)))\n (check (string? (qt-font-family f)) ? values)\n (check (qt-font-point-size f) => 12)\n (qt-font-set-bold! f #t)\n (check (qt-font-bold? f) => #t)\n (qt-font-set-italic! f #t)\n (check (qt-font-italic? f) => #t)\n (qt-font-destroy! f)))\n\n (test-case \"font set on widget\"\n (let ((w (qt-widget-create))\n (f (qt-font-create \"Sans\" 14)))\n (qt-widget-set-font! w f)\n (qt-font-destroy! f)\n (qt-widget-destroy! w)))\n\n (test-case \"color create and query\"\n (let ((c (qt-color-create 255 128 0 255)))\n (check (qt-color-red c) => 255)\n (check (qt-color-green c) => 128)\n (check (qt-color-blue c) => 0)\n (check (qt-color-alpha c) => 255)\n (check (qt-color-valid? c) => #t)\n (qt-color-destroy! c)))\n\n (test-case \"color create from name\"\n (let ((c (qt-color-create-name \"red\")))\n (check (qt-color-valid? c) => #t)\n (check (qt-color-red c) => 255)\n (qt-color-destroy! c))))\n\n;; ==================== Phase 8b: Scroll Area, Splitter, Progress, Slider ====================\n\n(test-group \"scroll area and splitter\"\n (test-case \"scroll area create\"\n (let ((sa (qt-scroll-area-create))\n (content (qt-widget-create)))\n (qt-scroll-area-set-widget! sa content)\n (qt-scroll-area-set-widget-resizable! sa #t)\n (qt-scroll-area-set-horizontal-scrollbar-policy! sa QT_SCROLLBAR_ALWAYS_OFF)\n (qt-scroll-area-set-vertical-scrollbar-policy! sa QT_SCROLLBAR_AS_NEEDED)\n (qt-widget-destroy! sa)))\n\n (test-case \"splitter create\"\n (let ((sp (qt-splitter-create QT_HORIZONTAL))\n (w1 (qt-widget-create))\n (w2 (qt-widget-create)))\n (qt-splitter-add-widget! sp w1)\n (qt-splitter-add-widget! sp w2)\n (check (qt-splitter-count sp) => 2)\n (qt-splitter-set-handle-width! sp 5)\n (qt-widget-destroy! sp))))\n\n(test-group \"progress bar\"\n (test-case \"progress bar value round-trip\"\n (let ((p (qt-progress-bar-create)))\n (qt-progress-bar-set-range! p 0 100)\n (qt-progress-bar-set-value! p 50)\n (check (qt-progress-bar-value p) => 50)\n (qt-progress-bar-set-format! p \"%p%\")\n (qt-widget-destroy! p))))\n\n(test-group \"slider\"\n (test-case \"slider value round-trip\"\n (let ((s (qt-slider-create QT_HORIZONTAL)))\n (qt-slider-set-range! s 0 100)\n (qt-slider-set-value! s 75)\n (check (qt-slider-value s) => 75)\n (qt-slider-set-single-step! s 5)\n (qt-slider-set-tick-interval! s 10)\n (qt-slider-set-tick-position! s QT_TICKS_BELOW)\n (qt-widget-destroy! s)))\n\n (test-case \"slider signal registration\"\n (let ((s (qt-slider-create QT_HORIZONTAL)))\n (qt-on-slider-value-changed! s (lambda (val) #t))\n (qt-widget-destroy! s))))\n\n;; ==================== Grid Layout ====================\n\n(test-group \"grid layout\"\n (if *run-known-crash-tests*\n (test-case \"grid layout create and add widgets\"\n (let* ((w (qt-widget-create))\n (grid (qt-grid-layout-create w))\n (l1 (qt-label-create \"Name:\"))\n (e1 (qt-line-edit-create)))\n (qt-grid-layout-add-widget! grid l1 0 0)\n (qt-grid-layout-add-widget! grid e1 0 1)\n (qt-grid-layout-set-row-stretch! grid 0 1)\n (qt-grid-layout-set-column-stretch! grid 1 2)))\n (skip-case \"grid layout create and add widgets\"\n \"set JERBOA_QT_RUN_KNOWN_CRASH_TESTS=1 to reproduce external qt_shim teardown crash\")))\n\n;; -----------------------------------------------------------------\n;; Summary\n\n(newline)\n(let ([status (if (zero? *fail*) 0 1)])\n (printf \"~a tests passed\\n\" *pass*)\n (when (> *skip* 0)\n (printf \"~a tests skipped\\n\" *skip*))\n (when (> *fail* 0)\n (printf \"~a tests FAILED\\n\" *fail*))\n (finish-tests status))\n"} {"text":";; FILE: jerboa-qt/examples/form.ss\n#!/bin/sh\n#|\nJERBOA_QT_DIR=\"$(cd \"$(dirname \"$0\")/..\" && pwd)\"\nJH=\"$(jerbuild --jerboa-home 2>/dev/null)\"\nif [ -z \"$JH\" ]; then\n echo \"jerbuild --jerboa-home failed\" >&2\n exit 1\nfi\nQT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\"\nexport JERBOA_QT_LIB=\"$JERBOA_QT_DIR\"\nexport JERBOA_QT_SHIM_DIR=\"$QT_SHIM_DIR\"\nexport DYLD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${DYLD_LIBRARY_PATH:-}\"\nexport LD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${LD_LIBRARY_PATH:-}\"\nexec jerbuild exec --libdirs \"$JERBOA_QT_DIR/lib:$JH/lib\" \"$0\" \"$@\"\n|#\n;;; Form example: exercises Phase 2 widgets\n;;; QLineEdit, QCheckBox, QComboBox, QSpinBox, QPushButton + QMessageBox\n\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n ;; Name input\n (name-edit (qt-line-edit-create))\n ;; Color selector\n (color-combo (qt-combo-box-create))\n ;; Age spinner\n (age-spin (qt-spin-box-create))\n ;; Newsletter toggle\n (news-check (qt-check-box-create \"Subscribe to newsletter\"))\n ;; Submit button\n (submit-btn (qt-push-button-create \"Submit\")))\n\n ;; Configure name input\n (qt-line-edit-set-placeholder! name-edit \"Enter your name...\")\n\n ;; Configure color selector\n (qt-combo-box-add-item! color-combo \"Red\")\n (qt-combo-box-add-item! color-combo \"Green\")\n (qt-combo-box-add-item! color-combo \"Blue\")\n (qt-combo-box-add-item! color-combo \"Yellow\")\n\n ;; Configure age spinner\n (qt-spin-box-set-range! age-spin 1 120)\n (qt-spin-box-set-value! age-spin 25)\n (qt-spin-box-set-suffix! age-spin \" years\")\n\n ;; Add widgets with labels\n (let ((name-label (qt-label-create \"Name:\"))\n (color-label (qt-label-create \"Favorite color:\"))\n (age-label (qt-label-create \"Age:\")))\n (qt-layout-add-widget! layout name-label)\n (qt-layout-add-widget! layout name-edit)\n (qt-layout-add-widget! layout color-label)\n (qt-layout-add-widget! layout color-combo)\n (qt-layout-add-widget! layout age-label)\n (qt-layout-add-widget! layout age-spin)\n (qt-layout-add-widget! layout news-check)\n (qt-layout-add-widget! layout submit-btn))\n\n (qt-layout-set-spacing! layout 8)\n (qt-layout-set-margins! layout 16 16 16 16)\n\n ;; Submit button shows summary in a message box\n (qt-on-clicked! submit-btn\n (lambda ()\n (let ((name (qt-line-edit-text name-edit))\n (color (qt-combo-box-current-text color-combo))\n (age (qt-spin-box-value age-spin))\n (subscribed (qt-check-box-checked? news-check)))\n (qt-message-box-information win \"Form Summary\"\n (string-append\n \"Name: \" name \"\\n\"\n \"Color: \" color \"\\n\"\n \"Age: \" (number->string age) \"\\n\"\n \"Newsletter: \" (if subscribed \"Yes\" \"No\"))))))\n\n (qt-main-window-set-title! win \"Form Demo\")\n (qt-main-window-set-central-widget! win central)\n (qt-widget-resize! win 350 350)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n"} {"text":";; FILE: jerboa-qt/examples/wizard.ss\n#!/bin/sh\n#|\nJERBOA_QT_DIR=\"$(cd \"$(dirname \"$0\")/..\" && pwd)\"\nJH=\"$(jerbuild --jerboa-home 2>/dev/null)\"\nif [ -z \"$JH\" ]; then\n echo \"jerbuild --jerboa-home failed\" >&2\n exit 1\nfi\nQT_SHIM_DIR=\"${JERBOA_QT_SHIM_DIR:-$HOME/mine/jerboa-emacs}\"\nexport JERBOA_QT_LIB=\"$JERBOA_QT_DIR\"\nexport JERBOA_QT_SHIM_DIR=\"$QT_SHIM_DIR\"\nexport DYLD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${DYLD_LIBRARY_PATH:-}\"\nexport LD_LIBRARY_PATH=\"$JERBOA_QT_DIR:$QT_SHIM_DIR:${LD_LIBRARY_PATH:-}\"\nexec jerbuild exec --libdirs \"$JERBOA_QT_DIR/lib:$JH/lib\" \"$0\" \"$@\"\n|#\n(import (jerboa-qt qt))\n\n(define (main)\n (with-qt-app app\n (let* ((win (qt-main-window-create))\n (central (qt-widget-create))\n (layout (qt-vbox-layout-create central))\n (launch-btn (qt-push-button-create \"Launch Wizard\"))\n (status (qt-label-create \"Click to start the wizard\"))\n (result-label (qt-label-create \"\")))\n ;; wizard launcher\n (qt-on-clicked! launch-btn\n (lambda ()\n (let* ((wiz (qt-wizard-create win))\n ;; page 1: welcome\n (page1 (qt-wizard-page-create))\n (p1-layout (qt-vbox-layout-create page1))\n (p1-label (qt-label-create \"Welcome to the jerboa-qt Wizard.\\nThis demonstrates wizard pages with various controls.\"))\n ;; page 2: radio buttons\n (page2 (qt-wizard-page-create))\n (p2-layout (qt-vbox-layout-create page2))\n (p2-label (qt-label-create \"Choose your preference:\"))\n (radio1 (qt-radio-button-create \"Option A\"))\n (radio2 (qt-radio-button-create \"Option B\"))\n (radio3 (qt-radio-button-create \"Option C\"))\n (btn-group (qt-button-group-create))\n ;; page 3: checkboxes in group box\n (page3 (qt-wizard-page-create))\n (p3-layout (qt-vbox-layout-create page3))\n (group-box (qt-group-box-create \"Features\"))\n (gb-layout (qt-vbox-layout-create group-box))\n (cb1 (qt-check-box-create \"Feature 1\"))\n (cb2 (qt-check-box-create \"Feature 2\"))\n (cb3 (qt-check-box-create \"Feature 3\"))\n ;; page 4: summary\n (page4 (qt-wizard-page-create))\n (p4-layout (qt-vbox-layout-create page4))\n (summary (qt-label-create \"Click Finish to complete.\")))\n ;; page 1\n (qt-wizard-page-set-title! page1 \"Welcome\")\n (qt-label-set-word-wrap! p1-label #t)\n (qt-layout-add-widget! p1-layout p1-label)\n ;; page 2\n (qt-wizard-page-set-title! page2 \"Preferences\")\n (qt-layout-add-widget! p2-layout p2-label)\n (qt-layout-add-widget! p2-layout radio1)\n (qt-layout-add-widget! p2-layout radio2)\n (qt-layout-add-widget! p2-layout radio3)\n (qt-button-group-add-button! btn-group radio1 0)\n (qt-button-group-add-button! btn-group radio2 1)\n (qt-button-group-add-button! btn-group radio3 2)\n (qt-radio-button-set-checked! radio1 #t)\n (qt-on-button-group-clicked! btn-group\n (lambda (id)\n (qt-label-set-text! status (format #f \"Selected option ~a\" id))))\n ;; page 3\n (qt-wizard-page-set-title! page3 \"Features\")\n (qt-group-box-set-checkable! group-box #t)\n (qt-group-box-set-checked! group-box #t)\n (qt-layout-add-widget! gb-layout cb1)\n (qt-layout-add-widget! gb-layout cb2)\n (qt-layout-add-widget! gb-layout cb3)\n (qt-check-box-set-checked! cb1 #t)\n (qt-layout-add-widget! p3-layout group-box)\n (qt-on-group-box-toggled! group-box\n (lambda (checked)\n (qt-label-set-text! status\n (if checked \"Features enabled\" \"Features disabled\"))))\n ;; page 4\n (qt-wizard-page-set-title! page4 \"Summary\")\n (qt-layout-add-widget! p4-layout summary)\n ;; add pages\n (qt-wizard-add-page! wiz page1)\n (qt-wizard-add-page! wiz page2)\n (qt-wizard-add-page! wiz page3)\n (qt-wizard-add-page! wiz page4)\n ;; wizard signals\n (qt-on-wizard-current-changed! wiz\n (lambda (id)\n (qt-label-set-text! status (format #f \"Wizard page: ~a\" id))))\n (qt-wizard-set-title! wiz \"jerboa-qt Wizard\")\n (qt-widget-resize! wiz 500 400)\n ;; run\n (let ((result (qt-wizard-exec! wiz)))\n (qt-label-set-text! result-label\n (if (= result 1) \"Wizard completed!\" \"Wizard cancelled.\"))))))\n ;; main layout\n (qt-label-set-alignment! status QT_ALIGN_CENTER)\n (qt-label-set-alignment! result-label QT_ALIGN_CENTER)\n (qt-layout-add-stretch! layout)\n (qt-layout-add-widget! layout launch-btn)\n (qt-layout-add-spacing! layout 10)\n (qt-layout-add-widget! layout status)\n (qt-layout-add-widget! layout result-label)\n (qt-layout-add-stretch! layout)\n ;; window\n (qt-main-window-set-title! win \"Wizard Demo\")\n (qt-main-window-set-central-widget! win central)\n (qt-widget-resize! win 400 300)\n (qt-widget-show! win)\n (qt-app-exec! app))))\n\n(main)\n"} @@ -588,7 +588,7 @@ {"text":";; FILE: jerboa-code/README.md\n# jerboa-code\n\n**A portable AI coding agent written in [Jerboa](https://git.sr.ht/~lisp/jerboa) Scheme.**\n\n`jcode` is a terminal coding agent — think opencode / aider / Claude Code — that\ncompiles to a standalone binary without a Node or Python runtime. It talks to 14\nLLM providers (cloud and local), drives your editor through a real tool loop,\nand ships a reliability layer that makes even small self-hosted models call\ntools dependably.\n\n```\n┌────────────────────────────────────────────────────────────────┐\n│ jcode BUILD · sonnet │\n│ │\n│ › add a --json flag to the status command │\n│ │\n│ ● read src/cli.ss │\n│ ● edit src/cli.ss (+12 −1) │\n│ ● bash make test 411 passed, 0 failed │\n│ │\n│ Done — `--json` emits the status block as a JSON object. │\n└────────────────────────────────────────────────────────────────┘\n```\n\n## Why it exists\n\n- **Portable.** One standalone binary. Runs on macOS, Linux, FreeBSD,\n and Android (via Termux). No Node, no Python, no ecosystem.\n- **Provider-agnostic.** Anthropic, OpenAI, Google, OpenRouter, DeepSeek, xAI,\n Groq, Mistral, Together, Cerebras, Perplexity — plus local **Ollama** and\n **MLX**. Switch with `/model` mid-session.\n- **Reliable on small models.** A native port of [forge](https://github.com/azambelli/forge)\n plus [ATLAS](docs/FORGE.md#the-atlas-reliability-layer)-style verify-and-repair\n wraps every call: prose-to-tool rescue, step enforcement, verify-gate, and\n best-of-k. Always on, every provider.\n- **Delegation built in.** Named sub-agent roles for the `task` tool —\n read-only `delegate`, docs-scoped `doc-explorer`, gated `implementer`\n (BLUEPRINT → approve → EXECUTE) — with enforced write scopes, per-agent\n model routing via `jcode.json`, and plan-lifecycle skills\n (`create-plan` / `resume-plan` / `generate-handover`). See\n [docs/agents.md](docs/agents.md).\n- **A real TUI.** termbox-based panels, markdown + syntax highlighting, live\n diffs, themes, a sidebar with token / cost / GPU stats.\n\n## Quickstart\n\nYou need a C compiler and Rust/Cargo. `make build` and `make binary` use a\nlocal Jerboa toolchain when present, otherwise they fetch the configured\nrelease bundle into `.jerboa/bin`. See\n**[docs/getting-started.md](docs/getting-started.md)** for the full setup.\n\n```bash\ngit clone https://git.sr.ht/~lisp/jerboa-code && cd jerboa-code\n\nmake build # compile src/ → lib/\nmake binary # produce the standalone ./jcode\n./jcode keys add anthropic # store an API key (encrypted)\n\n./jcode # interactive REPL\n./jcode --tui # full terminal UI\n./jcode -p \"explain this repo\" # one-shot prompt\n```\n\n## Documentation\n\n| Doc | What's in it |\n|---|---|\n| **[Getting started](docs/getting-started.md)** | Prerequisites, building on every platform, configuration, keys, first run. |\n| **[CLI reference](docs/cli.md)** | Every subcommand, flag, slash command, and environment variable. |\n| **[Architecture](docs/architecture.md)** | The agent loop, module map, and how a turn flows through the guardrails. |\n| **[Providers & models](docs/providers.md)** | The 14 providers, model registry, per-model sampling, and hardware tiers. |\n| **[Tools](docs/tools.md)** | The agent's toolbox (file, bash, web, git, patch, task, MCP) and the safety model. |\n| **[Named agents & plans](docs/agents.md)** | Sub-agent roles with enforced write scopes, per-agent models, gated execution, and the plan-lifecycle skills. |\n| **[TUI](docs/tui.md)** | Layout, keybindings, themes, and the rendering features. |\n| **[Forge & ATLAS reliability](docs/FORGE.md)** | Guardrails, workflows, verify-gate, best-of-k, the proxy, and the eval harness. |\n| **[Remote & Android](docs/remote.md)** | `serve` / `relay` / `connect` and the thin-client architecture. |\n\nSee **[docs/](docs/)** for the full index.\n\n## Build targets\n\n`make build` · `test` · `run` · `run-tui` · `binary` · `install` ·\n`linux` · `linux-amd64` · `linux-arm64` · `freebsd` · `android`.\nRun `make help` for the complete list.\n\n## Layout\n\n```\nmain.ss entry point\nsrc/jcode/\n core/ agent loop, config, sessions, guardrails plumbing, ATLAS\n provider/ the 14 LLM providers + per-model sampling\n tool/ file, bash, web, git, patch, task, repomap, lsp\n guardrails/ rescue, validator, step-enforcer, respond, error budget\n proxy/ OpenAI-compatible guardrail proxy\n eval/ deterministic ablation harness\n ui/ cli, tui-*, serve/relay/connect\n mcp/ MCP client\n```\n\nSource is **Jerboa `.ss`**, compiled by `jerbuild` to Chez `.sls` under `lib/`.\nSee [`AGENTS.md`](AGENTS.md) for the language reference and [`CLAUDE.md`](CLAUDE.md)\nfor contributor conventions.\n"} {"text":";; FILE: jerboa-code/main-binary.ss\n#!chezscheme\n;;; jcode binary entry point\n;;; In binary mode, all libraries are compiled in via boot files.\n\n(import (chezscheme)\n (jcode core config)\n (jcode core prompts)\n (jcode core agent)\n (jcode ui cli))\n\n(define (has-positional-args? args)\n (cond\n ((null? args) #f)\n ;; -p starts the one-shot prompt: everything after is positional.\n ((equal? (car args) \"-p\") (pair? (cdr args)))\n ((member (car args) '(\"--help\" \"-h\" \"--version\" \"-v\" \"--debug\" \"-d\" \"--tui\" \"--no-tui\" \"--verbose\" \"--repl\" \"--no-mcp\"))\n (has-positional-args? (cdr args)))\n ((member (car args) '(\"--model\" \"-m\" \"--provider\" \"--repl-port\" \"--trace\"))\n (if (null? (cdr args)) #f (has-positional-args? (cddr args))))\n (else #t)))\n\n(cli-main (if (or (member \"--no-tui\" (command-line-arguments))\n (has-positional-args? (command-line-arguments)))\n (command-line-arguments)\n (cons \"--tui\" (command-line-arguments))))\n"} {"text":";; FILE: jerboa-code/build-jcode-cross.ss\n#!chezscheme\n;;; build-jcode-cross.ss — Cross-compile jcode from macOS to Linux musl\n;;;\n;;; Usage:\n;;; JERBOA_HOME=/Users/user/mine/jerboa TARGET_ARCH=amd64 scheme \\\n;;; --libdirs <libs> --script build-jcode-cross.ss\n;;;\n;;; TARGET_ARCH selects the cross target:\n;;; amd64 (default) — chez ta6le + x86_64-linux-musl-gcc → jcode-linux-amd64\n;;; arm64 — chez tarm64le + aarch64-linux-musl-gcc → jcode-linux-arm64\n;;;\n;;; Cross-compile analogue of build-jcode-musl.ss that runs on a non-Linux host.\n;;; Uses:\n;;; - $JERBOA_HOME/.chez-cross-<machine>/ — cross-built Chez install\n;;; - $JERBOA_HOME/build/chez/xc-<machine>/s/xpatch — host compiler emit mode\n;;; - <toolchain>-linux-musl-gcc — C compile + final static link\n;;;\n;;; This is the \"WPO as program\" pattern: main-binary.ss + all imports are\n;;; bundled into one .so via compile-whole-program, loaded at runtime via\n;;; Sscheme_program — no jcode.boot bundling required.\n\n(import (chezscheme))\n\n;; ── Params ──────────────────────────────────────────────────────────────────\n(define jerboa-home\n (or (getenv \"JERBOA_HOME\") \"/Users/user/mine/jerboa\"))\n\n(define target-arch (or (getenv \"TARGET_ARCH\") \"amd64\"))\n\n;; Per-arch dispatch:\n;; (arch chez-machine c-toolchain rust-target output-name ar-tool target-env-lower target-env-upper)\n(define arch-table\n '((\"amd64\" \"ta6le\" \"x86_64-linux-musl-gcc\" \"x86_64-unknown-linux-musl\" \"jcode-linux-amd64\"\n \"x86_64-linux-musl-ar\" \"x86_64_unknown_linux_musl\" \"X86_64_UNKNOWN_LINUX_MUSL\")\n (\"arm64\" \"tarm64le\" \"aarch64-linux-musl-gcc\" \"aarch64-unknown-linux-musl\" \"jcode-linux-arm64\"\n \"aarch64-linux-musl-ar\" \"aarch64_unknown_linux_musl\" \"AARCH64_UNKNOWN_LINUX_MUSL\")))\n\n(define arch-row\n (or (assoc target-arch arch-table)\n (error 'build-jcode-cross\n (format \"unknown TARGET_ARCH (expected amd64|arm64): ~a\" target-arch))))\n\n(define chez-machine (list-ref arch-row 1))\n(define rust-target (list-ref arch-row 3))\n(define cross-ar (list-ref arch-row 5))\n(define rust-target-env-lower (list-ref arch-row 6))\n(define rust-target-env-upper (list-ref arch-row 7))\n\n(define cross-prefix (format \"~a/.chez-cross-~a\" jerboa-home chez-machine))\n(define xpatch (format \"~a/build/chez/xc-~a/s/xpatch\" jerboa-home chez-machine))\n(define cross-cc (or (getenv \"CROSS_CC\") (list-ref arch-row 2)))\n\n(define output (list-ref arch-row 4))\n(define entry-script \"main-binary.ss\")\n\n;; jcode uses only this subset of jerboa-native-rs features:\n;; tls — provider/provider.ss (rustls)\n;; crypto — secrets.ss, hashing, hmac, aead, scrypt, argon2id\n;;\n;; SQLite is linked through vendor/jerboa-sqlite/jerboa_sqlite_shim.c plus\n;; support/sqlite-bundled. The Rust crate's sqlite feature exports a different\n;; jerboa_sqlite_* surface, so enabling it here creates duplicate symbols and\n;; still does not provide the int64/bytes/constants API the Scheme module uses.\n(define cargo-features \"tls,crypto\")\n\n(define jerboa-native-a\n (or (getenv \"JERBOA_NATIVE_A\")\n (format \"~a/jerboa-native-rs/target/~a/release/libjerboa_native.a\"\n jerboa-home rust-target)))\n\n(define sqlite-bundled-a\n (format \"support/sqlite-bundled/target/~a/release/libjcode_sqlite_bundled.a\"\n rust-target))\n\n(define cross-csv-dir\n (let ([lib (format \"~a/lib\" cross-prefix)])\n (unless (file-directory? lib)\n (error 'build-jcode-cross \"cross prefix lib dir missing — run 'make chez' in jerboa first\" lib))\n (let* ([entries (directory-list lib)]\n [csvs (filter (lambda (e)\n (and (>= (string-length e) 3)\n (string=? (substring e 0 3) \"csv\")))\n entries)])\n (when (null? csvs)\n (error 'build-jcode-cross \"no csv* in cross lib\" lib))\n (format \"~a/~a/~a\" lib (car csvs) chez-machine))))\n\n(define (require-file p)\n (unless (file-exists? p)\n (error 'build-jcode-cross \"missing file\" p)))\n\n(require-file xpatch)\n(require-file (format \"~a/libkernel.a\" cross-csv-dir))\n(require-file (format \"~a/scheme.h\" cross-csv-dir))\n(require-file (format \"~a/petite.boot\" cross-csv-dir))\n(require-file (format \"~a/scheme.boot\" cross-csv-dir))\n(require-file entry-script)\n\n(printf \"==> build-jcode-cross~n\")\n(printf \" JERBOA_HOME: ~a~n\" jerboa-home)\n(printf \" cross csv-dir: ~a~n\" cross-csv-dir)\n(printf \" xpatch: ~a~n\" xpatch)\n(printf \" cross-cc: ~a~n\" cross-cc)\n(printf \" output: ~a~n\" output)\n(printf \" features: ~a~n\" cargo-features)\n(printf \" sqlite archive: ~a~n~n\" sqlite-bundled-a)\n\n;; ── Step 0: Build/rebuild jerboa-native-rs for x86_64-linux-musl ───────────\n;; libjerboa_native.a is shared across jerboa-shell, jerboa-code, etc. If a\n;; sibling cross build (e.g. jsh-cross) built it with a different feature\n;; set, rebuild to match what jcode needs. Sentinel file records features.\n\n(define native-features-sentinel\n (format \"~a/jerboa-native-rs/target/~a/release/.built-with-~a\"\n jerboa-home rust-target\n (let ([s (string-copy cargo-features)])\n (let loop ([i 0])\n (cond [(= i (string-length s)) s]\n [(char=? (string-ref s i) #\\,)\n (string-set! s i #\\-) (loop (+ i 1))]\n [else (loop (+ i 1))])))))\n\n(define (rs-source-newer-than? a-path)\n (let ([src-dir (format \"~a/jerboa-native-rs/src\" jerboa-home)])\n (and (file-directory? src-dir)\n (file-exists? a-path)\n (let ([a-mtime (file-modification-time a-path)])\n (let walk ([dirs (list src-dir)])\n (and (pair? dirs)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter (lambda (p) (not (file-directory? p))) entries)]\n [subs (filter file-directory? entries)])\n (or (ormap (lambda (f)\n (and (let ([n (string-length f)])\n (and (> n 3)\n (string=? \".rs\" (substring f (- n 3) n))))\n (time>? (file-modification-time f) a-mtime)))\n files)\n (walk (append subs (cdr dirs)))))))))))\n\n;; Force cargo to use rustup-managed rustc. Homebrew on macOS often ships its\n;; own rustc ahead of rustup proxies on PATH; that homebrew rustc has no\n;; cross targets installed, so the musl build fails with \"can't find crate\n;; for core\". Detect rustup's active toolchain via `rustup which rustc` and\n;; pin both PATH and RUSTC to it (same trick as build-jcode-musl.ss).\n(define (path-dirname s)\n (let loop ([i (- (string-length s) 1)])\n (cond [(< i 0) \".\"]\n [(char=? (string-ref s i) #\\/) (substring s 0 i)]\n [else (loop (- i 1))])))\n\n(define (capture-line cmd)\n ;; open-process-ports returns 4 values: stdin, stdout, stderr, pid.\n (call-with-values\n (lambda () (open-process-ports cmd (buffer-mode block) (native-transcoder)))\n (lambda (to-stdin from-stdout from-stderr pid)\n (let ([line (get-line from-stdout)])\n (close-port to-stdin)\n (close-port from-stdout)\n (close-port from-stderr)\n (if (or (eof-object? line) (zero? (string-length line))) #f line)))))\n\n(define rustup-rustc-path (capture-line \"rustup which rustc 2>/dev/null\"))\n(define rustup-bin-dir (and rustup-rustc-path (path-dirname rustup-rustc-path)))\n\n(define (try-cargo-build cmd)\n (printf \" $ ~a~n\" cmd)\n (zero? (system cmd)))\n\n(define (build-sqlite-bundled!)\n (require-file \"support/sqlite-bundled/Cargo.toml\")\n (let* ([sqlite-dir \"support/sqlite-bundled\"]\n [cargo-args (format \"build --release --target ~a\" rust-target)]\n [cc-env (format \"CARGO_TARGET_~a_LINKER='~a' CC_~a='~a' AR_~a='~a' \"\n rust-target-env-upper cross-cc\n rust-target-env-lower cross-cc\n rust-target-env-lower cross-ar)]\n [via-rustup\n (and rustup-bin-dir\n (format \"cd '~a' && env ~aPATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a\"\n sqlite-dir cc-env rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))]\n [via-path (format \"cd '~a' && env ~acargo ~a\" sqlite-dir cc-env cargo-args)]\n [ok? (or (and via-rustup (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless ok?\n (error 'build-jcode-cross\n (format \"failed to build bundled SQLite for ~a with ~a\"\n rust-target cross-cc)))\n (unless (file-exists? sqlite-bundled-a)\n (error 'build-jcode-cross\n \"cargo succeeded but bundled SQLite archive is missing\"\n sqlite-bundled-a))))\n\n(define (rebuild-native-lib!)\n (let* ([nrs-dir (format \"~a/jerboa-native-rs\" jerboa-home)]\n [cargo-args (format \"build --release --no-default-features --features ~a --target ~a\"\n cargo-features rust-target)]\n [via-rustup\n (and rustup-bin-dir\n (format \"cd '~a' && env PATH='~a':$PATH RUSTC='~a/rustc' '~a/cargo' ~a\"\n nrs-dir rustup-bin-dir rustup-bin-dir rustup-bin-dir cargo-args))]\n [via-path (format \"cd '~a' && cargo ~a\" nrs-dir cargo-args)]\n [ok? (or (and via-rustup (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless ok?\n (error 'build-jcode-cross\n (format\n (string-append\n \"failed to build jerboa-native-rs for ~a. \"\n \"Required: `rustup target add ~a`, plus the \"\n \"FiloSottile/musl-cross toolchain on PATH so cargo finds \"\n \"~a as the linker.\")\n rust-target rust-target cross-cc)))\n (unless (file-exists? jerboa-native-a)\n (error 'build-jcode-cross \"cargo succeeded but .a missing\" jerboa-native-a))\n (call-with-output-file native-features-sentinel\n (lambda (out) (display cargo-features out) (newline out))\n 'truncate)))\n\n(cond\n [(not (file-exists? jerboa-native-a))\n (printf \"==> jerboa-native-rs missing — building (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(not (file-exists? native-features-sentinel))\n (printf \"==> jerboa-native-rs sentinel missing — rebuilding (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(time>? (file-modification-time jerboa-native-a)\n (file-modification-time native-features-sentinel))\n ;; The .a is shared across sibling repos (jerboa-shell, etc.). A newer .a\n ;; than our sentinel means someone rebuilt it — possibly with different\n ;; features — so our tag can't be trusted. Rebuild to be sure (prevents\n ;; the silent \"undefined reference to jerboa_sqlite_*\" cross-link break).\n (printf \"==> jerboa-native-rs .a newer than sentinel (foreign rebuild?) — rebuilding (features=~a)~n\" cargo-features)\n (rebuild-native-lib!)]\n [(rs-source-newer-than? jerboa-native-a)\n (printf \"==> jerboa-native-rs .rs source newer than .a — rebuilding~n\")\n (rebuild-native-lib!)]\n [else\n (printf \"==> jerboa-native-rs up to date (features=~a)~n\" cargo-features)])\n\n(printf \"==> building bundled SQLite archive (~a)~n\" rust-target)\n(build-sqlite-bundled!)\n\n(printf \"~n\")\n\n;; ── Step 0.5: isolate cross-compiled objects ───────────────────────────────\n;; Never patch source libraries in-place. Chez xpatch can compile target\n;; objects while `library-directories` maps source directories to a separate\n;; writable object directory.\n\n(define obj-dir (format \".build/~a-obj\" output))\n(define entry-so (format \"~a/program.so\" obj-dir))\n(define entry-wpo (format \"~a/program.wpo\" obj-dir))\n\n(define (prepare-obj-dir!)\n (system (format \"rm -rf '~a'\" obj-dir))\n (system (format \"mkdir -p '~a'\" obj-dir)))\n\n(define (cleanup!)\n (system (format \"rm -rf '~a'\" obj-dir)))\n\n(prepare-obj-dir!)\n\n;; ── Stage 1: load xpatch (target=ta6le emit mode) ──────────────────────────\n(define orig-libdirs (library-directories))\n(printf \"==> [1/6] loading xpatch (compiler -> ~a emit mode)~n\" chez-machine)\n(load xpatch)\n(library-directories\n (map (lambda (pair)\n (cons (if (pair? pair) (car pair) pair) obj-dir))\n orig-libdirs))\n\n(compile-imported-libraries #t)\n(generate-wpo-files #t)\n\n;; ── Stage 2: compile-program main-binary.ss ────────────────────────────────\n(printf \"==> [2/6] compile-program ~a -> ~a~n\" entry-script entry-so)\n(guard (e [#t (cleanup!) (raise e)])\n (compile-program entry-script entry-so))\n\n;; ── Stage 3: compile-whole-program → wpo .so ───────────────────────────────\n(define wpo-output (string-append output \".wp.so\"))\n(printf \"==> [3/6] compile-whole-program ~a -> ~a~n\" entry-wpo wpo-output)\n(guard (e [#t (cleanup!) (raise e)])\n (compile-whole-program entry-wpo wpo-output #t))\n\n;; ── Stage 4: embed boot files + program as C arrays ────────────────────────\n(define (embed-as-c-array in-path var-name out-path)\n (let* ([bv (call-with-port (open-file-input-port in-path) get-bytevector-all)]\n [n (bytevector-length bv)])\n (call-with-port (open-file-output-port out-path\n (file-options no-fail)\n (buffer-mode block)\n (native-transcoder))\n (lambda (out)\n (display (format \"static const unsigned char ~a[] = {\\n\" var-name) out)\n (let loop ([i 0])\n (when (< i n)\n (display (format \"0x~2,'0x,\" (bytevector-u8-ref bv i)) out)\n (when (= (mod (+ i 1) 16) 0) (newline out))\n (loop (+ i 1))))\n (when (positive? n) (newline out))\n (display \"};\\n\" out)\n (display (format \"static const unsigned int ~a_size = sizeof(~a);\\n\"\n var-name var-name)\n out)))\n (printf \" embed ~a (~a bytes) -> ~a~n\" in-path n out-path)))\n\n(printf \"==> [4/6] embed boot files + program as C arrays~n\")\n(embed-as-c-array (format \"~a/petite.boot\" cross-csv-dir) \"petite_boot\" \"petite_boot.h\")\n(embed-as-c-array (format \"~a/scheme.boot\" cross-csv-dir) \"scheme_boot\" \"scheme_boot.h\")\n(embed-as-c-array wpo-output \"jcode_program\" \"jcode_program.h\")\n\n;; ── Stage 5: generate main.c ───────────────────────────────────────────────\n;; Symbol surface mirrors build-jcode-musl.ss (FFI + libc), plus the dlopen\n;; stubs needed for fully-static binaries. dlerror MUST return non-NULL —\n;; Chez's load-shared-object error path strlen()s it.\n\n(define ffi-shim-symbols\n '(;; jerboa-sqlite shim (vendor/jerboa-sqlite/jerboa_sqlite_shim.c)\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_clear_bindings\" \"jerboa_sqlite_step\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_name\"\n \"jerboa_sqlite_column_type\" \"jerboa_sqlite_column_int64\"\n \"jerboa_sqlite_column_double\" \"jerboa_sqlite_column_text\"\n \"jerboa_sqlite_column_bytes\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_bind_int64\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\"\n \"jerboa_sqlite_bind_null\" \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_SQLITE_ROW\" \"jerboa_SQLITE_DONE\" \"jerboa_SQLITE_OK\"\n ;; termbox2 TUI shim (src/jcode/ui/jcode_tui_shim.c)\n \"jcode_tb_init\" \"jcode_tb_shutdown\"\n \"jcode_tb_width\" \"jcode_tb_height\"\n \"jcode_tb_clear\" \"jcode_tb_present\"\n \"jcode_tb_set_cursor\" \"jcode_tb_hide_cursor\"\n \"jcode_tb_change_cell\" \"jcode_tb_set_clear_attrs\"\n \"jcode_tb_print\" \"jcode_tb_printf\"\n \"jcode_tb_set_input_mode\" \"jcode_tb_set_output_mode\"\n \"jcode_tb_poll_event\" \"jcode_tb_peek_event\"\n \"jcode_tb_event_type\" \"jcode_tb_event_mod\"\n \"jcode_tb_event_key\" \"jcode_tb_event_ch\"\n \"jcode_tb_event_w\" \"jcode_tb_event_h\"\n \"jcode_tb_event_x\" \"jcode_tb_event_y\"\n ;; landlock-shim (support/landlock-shim.c)\n \"jerboa_landlock_sandbox\"\n \"jerboa_landlock_sandbox_ex\"\n \"jerboa_landlock_abi_version\"))\n\n(define jerboa-native-symbols\n '(;; jerboa-native (TLS/rustls)\n \"jerboa_tls_server_new\" \"jerboa_tls_server_new_pem\"\n \"jerboa_tls_server_new_mtls\"\n \"jerboa_tls_server_free\" \"jerboa_tls_accept\"\n \"jerboa_tls_connect\" \"jerboa_tls_connect_pinned\"\n \"jerboa_tls_connect_mtls\" \"jerboa_tls_close\"\n \"jerboa_tls_read\" \"jerboa_tls_write\" \"jerboa_tls_flush\"\n \"jerboa_tls_get_fd\" \"jerboa_tls_set_nonblock\"\n \"jerboa_last_error\"\n ;; jerboa-native (x509) — self-signed cert for the debug-REPL TLS listener\n \"jerboa_x509_generate_self_signed_mem\"\n ;; jerboa-native (crypto)\n \"jerboa_sha1\" \"jerboa_sha256\" \"jerboa_sha384\" \"jerboa_sha512\"\n \"jerboa_random_bytes\" \"jerboa_timing_safe_equal\"\n \"jerboa_hmac_sha256\" \"jerboa_hmac_sha256_verify\"\n \"jerboa_aead_seal\" \"jerboa_aead_open\"\n \"jerboa_chacha20_seal\" \"jerboa_chacha20_open\"\n \"jerboa_scrypt\"\n \"jerboa_pbkdf2_derive\" \"jerboa_pbkdf2_verify\"\n \"jerboa_argon2id_hash\" \"jerboa_argon2id_verify\"\n ;; jerboa-native (regex) — visit-time even if jcode never matches\n \"jerboa_regex_compile\" \"jerboa_regex_is_match\"\n \"jerboa_regex_find\" \"jerboa_regex_replace_all\" \"jerboa_regex_free\"\n ;; jerboa-native (aproc) — (std os aproc) for bash tool\n \"jerboa_aproc_spawn\" \"jerboa_aproc_spawn_pty\"\n \"jerboa_aproc_set_nonblock\" \"jerboa_aproc_killpg\" \"jerboa_aproc_wait4\"\n ;; jerboa-native (net/io)\n \"jerboa_writev2\"))\n\n(define posix-symbols\n '(;; sockets — std/net/tcp, std/net/udp\n \"socket\" \"bind\" \"listen\" \"accept\" \"connect\" \"close\"\n \"setsockopt\" \"getsockopt\" \"getsockname\"\n \"htons\" \"ntohs\" \"inet_pton\" \"inet_addr\"\n \"read\" \"write\" \"recvfrom\" \"sendto\"\n ;; DNS — std/net/resolve\n \"getaddrinfo\" \"freeaddrinfo\" \"inet_ntop\"\n ;; process/signals — std/misc/process, std/os/signal, aproc\n \"fork\" \"waitpid\" \"kill\" \"getpid\" \"getppid\"\n \"getpgid\" \"setpgid\" \"setsid\"\n \"getuid\" \"geteuid\" \"getgid\" \"getegid\"\n \"sigemptyset\" \"sigfillset\" \"sigaddset\" \"sigdelset\"\n \"sigismember\" \"sigprocmask\"\n ;; terminal/fd — TUI + REPL\n \"isatty\" \"tcgetattr\" \"tcsetattr\" \"tcgetpgrp\" \"tcsetpgrp\"\n \"pipe\" \"dup\" \"dup2\" \"lseek\"\n ;; env/misc — std/os/env, std/text/time\n \"setenv\" \"unsetenv\" \"strerror\" \"localtime\" \"strftime\"\n \"sysconf\" \"getpagesize\" \"getrlimit\"\n \"system\" \"getenv\" \"putenv\" \"_exit\" \"exit\" \"execvp\" \"execve\"\n ;; temporary files/directories — std/os/temp\n \"mkstemp\" \"mkdtemp\" \"unlink\" \"rmdir\"\n ;; errno location + Linux sandboxing\n \"__errno_location\" \"fcntl\" \"prctl\" \"syscall\"))\n\n(define main-c-path (string-append output \"-main.c\"))\n\n(define (emit-c out)\n (display \"/* Generated by build-jcode-cross.ss — do not edit by hand. */\\n\" out)\n (display \"#define _GNU_SOURCE\\n\" out)\n (display \"#include <stdlib.h>\\n\" out)\n (display \"#include <string.h>\\n\" out)\n (display \"#include <stdio.h>\\n\" out)\n (display \"#include <unistd.h>\\n\" out)\n (display \"#include <sys/mman.h>\\n\" out)\n (display \"#include <sys/types.h>\\n\" out)\n (display \"#include <sys/stat.h>\\n\" out)\n (display \"#include <sys/wait.h>\\n\" out)\n (display \"#include <sys/resource.h>\\n\" out)\n (display \"#include <sys/prctl.h>\\n\" out)\n (display \"#include <sys/socket.h>\\n\" out)\n (display \"#include <netinet/in.h>\\n\" out)\n (display \"#include <arpa/inet.h>\\n\" out)\n (display \"#include <netdb.h>\\n\" out)\n (display \"#include <termios.h>\\n\" out)\n (display \"#include <fcntl.h>\\n\" out)\n (display \"#include <signal.h>\\n\" out)\n (display \"#include <time.h>\\n\" out)\n (display \"#include <errno.h>\\n\" out)\n (display \"#include \\\"scheme.h\\\"\\n\" out)\n (display \"#include \\\"petite_boot.h\\\"\\n\" out)\n (display \"#include \\\"scheme_boot.h\\\"\\n\" out)\n (display \"#include \\\"jcode_program.h\\\"\\n\\n\" out)\n ;; dlopen/dlsym stubs — in a fully-static -static binary musl's dlopen\n ;; always fails. Jerboa stdlib does (load-shared-object #f) and, in some\n ;; libc fallback modules, (load-shared-object \"\") to expose the main\n ;; executable; with these stubs those succeed and Chez routes lookups\n ;; through Sforeign_symbol.\n (display \"/* dlopen stubs for static linking.\\n\" out)\n (display \" * (load-shared-object #f) passes f=NULL — succeed (main exe).\\n\" out)\n (display \" * (load-shared-object \\\"\\\") passes f=\\\"\\\" — also succeed (main exe).\\n\" out)\n (display \" * (load-shared-object \\\"libfoo\\\") passes f=\\\"libfoo\\\" — fail so the\\n\" out)\n (display \" * Scheme guard falls back to a no-op stub and we never try to\\n\" out)\n (display \" * dlsym a function that's not statically linked. */\\n\" out)\n (display \"void *dlopen(const char *f, int flags) { (void)flags; return (!f || f[0] == '\\\\0') ? (void*)1 : NULL; }\\n\" out)\n (display \"void *dlsym(void *h, const char *s) { (void)h; (void)s; return NULL; }\\n\" out)\n (display \"int dlclose(void *h) { (void)h; return 0; }\\n\" out)\n ;; dlerror MUST return a non-NULL string — Chez's load-shared-object error\n ;; path calls strlen(dlerror()), and strlen(NULL) is a SIGSEGV inside libc\n ;; with no useful diagnostic. Return a stable message instead.\n (display \"static char dlerror_msg[] = \\\"static binary: dlopen of named libraries is stubbed\\\";\\n\" out)\n (display \"char *dlerror(void) { return dlerror_msg; }\\n\\n\" out)\n ;; extern decls for shim functions linked via .c files\n (display \"/* Shim function decls — jerboa_sqlite_shim.c + jcode_tui_shim.c + landlock-shim.c */\\n\" out)\n (for-each (lambda (n) (fprintf out \"extern void ~a();\\n\" n)) ffi-shim-symbols)\n ;; extern decls for libjerboa_native.a symbols\n (display \"\\n/* libjerboa_native.a — features=tls,crypto */\\n\" out)\n (for-each (lambda (n) (fprintf out \"extern void ~a();\\n\" n)) jerboa-native-symbols)\n ;; POSIX libc symbols already declared by system headers above.\n (display \"\\nextern int *__errno_location(void);\\n\" out)\n ;; register all symbols at startup\n (newline out)\n (display \"static void register_ffi_symbols(void) {\\n\" out)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n ffi-shim-symbols)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n jerboa-native-symbols)\n (for-each (lambda (n)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" n n))\n posix-symbols)\n (display \"}\\n\\n\" out)\n (display \"int main(int argc, char *argv[]) {\\n\" out)\n ;; Tell jerboa stdlib we are statically linked — must precede Sscheme_init.\n (display \" setenv(\\\"JERBOA_STATIC\\\", \\\"1\\\", 1);\\n\\n\" out)\n ;; memfd_create for the WPO program, with tmpfile fallback\n (display \" int fd = memfd_create(\\\"jcode-program\\\", MFD_CLOEXEC);\\n\" out)\n (display \" char prog_path[64];\\n\" out)\n (display \" if (fd >= 0) {\\n\" out)\n (display \" if (write(fd, jcode_program, jcode_program_size) != (ssize_t)jcode_program_size) {\\n\" out)\n (display \" perror(\\\"write memfd\\\"); close(fd); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"/proc/self/fd/%d\\\", fd);\\n\" out)\n (display \" } else {\\n\" out)\n (display \" const char *tmp = getenv(\\\"TMPDIR\\\"); if (!tmp) tmp = \\\"/tmp\\\";\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"%s/.jcode-prog-%d.so\\\", tmp, getpid());\\n\" out)\n (display \" FILE *fp = fopen(prog_path, \\\"wb\\\");\\n\" out)\n (display \" if (!fp) { perror(\\\"fopen tmpfile\\\"); return 1; }\\n\" out)\n (display \" if (fwrite(jcode_program, 1, jcode_program_size, fp) != jcode_program_size) {\\n\" out)\n (display \" perror(\\\"fwrite\\\"); fclose(fp); unlink(prog_path); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" fclose(fp);\\n\" out)\n (display \" }\\n\\n\" out)\n ;; Boot Chez.\n (display \" Sscheme_init(NULL);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"petite\\\", (void *)petite_boot, petite_boot_size);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"scheme\\\", (void *)scheme_boot, scheme_boot_size);\\n\" out)\n (display \" Sbuild_heap(NULL, NULL);\\n\" out)\n (display \" register_ffi_symbols();\\n\\n\" out)\n ;; argv is passed through directly to Sscheme_program — main-binary.ss\n ;; reads (command-line-arguments) for --tui detection.\n (display \" int status = Sscheme_program(prog_path, argc, (const char **)argv);\\n\\n\" out)\n (display \" if (fd >= 0) close(fd); else unlink(prog_path);\\n\" out)\n (display \" Sscheme_deinit();\\n\" out)\n (display \" return status;\\n\" out)\n (display \"}\\n\" out))\n\n(call-with-port (open-file-output-port main-c-path\n (file-options no-fail) (buffer-mode block) (native-transcoder))\n emit-c)\n(printf \"==> [5/6] generated ~a (~a shim + ~a native + ~a posix)~n\"\n main-c-path\n (length ffi-shim-symbols)\n (length jerboa-native-symbols)\n (length posix-symbols))\n\n;; ── Stage 6: compile + link with cross-cc ──────────────────────────────────\n(printf \"==> [6/6] compile + link with ~a~n\" cross-cc)\n\n(define sqlite-shim-c \"vendor/jerboa-sqlite/jerboa_sqlite_shim.c\")\n(define jcode-tui-shim-c \"src/jcode/ui/jcode_tui_shim.c\")\n(define landlock-shim-c \"support/landlock-shim.c\")\n(define sqlite-include-dir \"support\")\n\n(require-file sqlite-shim-c)\n(require-file jcode-tui-shim-c)\n(require-file landlock-shim-c)\n(require-file jerboa-native-a)\n(require-file sqlite-bundled-a)\n(require-file \"support/sqlite3.h\")\n\n(printf \" sqlite3.h: support/sqlite3.h~n\")\n(printf \" tls/crypto via libjerboa_native.a; sqlite via jerboa_sqlite_shim.c + bundled SQLite~n\")\n\n;; -Wl,--export-dynamic exports symbols into the dynamic symbol table so\n;; Chez's foreign-procedure / dlsym(RTLD_DEFAULT) can find them in a\n;; -static binary. (Same trick as build-jsh-cross.ss.)\n(define link-cmd\n (format\n (string-append\n \"~a -O2 -static -Wl,--export-dynamic \"\n \"-I~a \" ;; scheme.h\n \"-I~a \" ;; sqlite3.h\n \"-Ivendor/termbox2 -DTB_OPT_ATTR_W=32 \" ;; jcode_tui_shim\n \"-o ~a \" ;; output\n \"~a ~a ~a ~a \" ;; main.c + 3 shims\n \"~a/libkernel.a ~a/libz.a ~a/liblz4.a \" ;; chez kernel\n \"~a \" ;; libjerboa_native.a\n \"~a \" ;; bundled sqlite3\n \"-Wl,--allow-multiple-definition \"\n \"-Wl,--defsym=_dl_find_object=0 \"\n \"-lm -ldl -lpthread\")\n cross-cc cross-csv-dir sqlite-include-dir output\n main-c-path sqlite-shim-c jcode-tui-shim-c landlock-shim-c\n cross-csv-dir cross-csv-dir cross-csv-dir\n jerboa-native-a sqlite-bundled-a))\n(printf \" ~a~n\" link-cmd)\n(let ([rc (system link-cmd)])\n (unless (zero? rc)\n (cleanup!)\n (error 'build-jcode-cross \"cross-link failed\" rc)))\n\n;; ── Cleanup: remove isolated cross objects ─────────────────────────────────\n(cleanup!)\n\n(printf \"~n=== Build complete: ~a ===~n\" output)\n(system (format \"ls -lh ~a\" output))\n(system (format \"file ~a\" output))\n"} -{"text":";; FILE: jerboa-code/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} +{"text":";; FILE: jerboa-code/AGENTS.md\n## The Jerboa Language — Quick Reference\n\nJerboa is a Scheme dialect built on Chez Scheme. It is Gerbil-inspired but its own language. **All user-facing code is `.ss` files. Never write `.sls` files for the user** — those are internal implementation files.\n\n### File Structure\n\nEvery Jerboa file looks like this:\n\n```scheme\n(import (jerboa prelude)) ;; ONE import gives you the ENTIRE language\n;; Optional extra imports for modules NOT in the prelude:\n;; (import (std net request))\n\n(def (my-function x y)\n (+ x y))\n\n(displayln (my-function 1 2))\n```\n\nRun with: `scheme --libdirs lib --script file.ss`\n\n**NEVER** write `(library ...)` forms — that's `.sls` internal syntax.\n\n### Reader Syntax Extensions\n\n```\n[...] → plain parentheses — same as Gerbil and Chez Scheme\n{method obj args} → (~ obj 'method args) — method dispatch\nname: → keyword #:name\n:std/sort → (std sort) — Gerbil-style module path\n#<<END ... END → heredoc string\n```\n\nSquare brackets `[...]` are interchangeable with `(...)`, exactly like Gerbil and stock Chez Scheme. You can freely use them in bindings, match clauses, and anywhere you'd use parentheses:\n```scheme\n;; All of these are correct:\n(let ([x 1] [y 2]) (+ x y))\n(for/collect ([x (in-range 5)]) (* x x))\n(match val ([list a b] (+ a b)))\n(cond [(> x 0) \"positive\"] [else \"non-positive\"])\n```\n\n### CRITICAL: Things That DO NOT EXIST in Jerboa/Chez\n\nClaude frequently hallucinates these from Gerbil, Gambit, Racket, or R7RS training data.\n**NONE of them are real in Jerboa/Chez. STOP and use the correct form.**\n\n#### AI Compatibility Aliases (these now work in the prelude)\nThe following names from other Scheme dialects are aliased in `(jerboa prelude)`:\n- `hash-has-key?` → `hash-key?` (Racket)\n- `hash-table-set!` → `hash-put!` (Racket)\n- `directory-exists?` → `file-directory?` (Gambit)\n- `eql?` → `eqv?` (Common Lisp)\n- `random-integer` → `random` (Gambit)\n- `read-line` → `get-line` wrapper (Gambit) — works with or without port arg\n- `force-output` → `flush-output-port` wrapper (Gambit) — works with or without port arg\n- `string-map` → char-level map (Racket/R7RS) — `(string-map f str)`\n\n#### Hallucinated Functions (still do NOT exist)\n- `symbol<?` — use `(lambda (a b) (string<? (symbol->string a) (symbol->string b)))`\n- `string-contains?` — use `(string-contains str sub)` (returns index or #f, NOT boolean)\n- `define-struct` — use `(defstruct name (fields ...))`\n- `raise` with a string — use `(error 'who \"message\" irritants ...)`\n- `environment-bound?` — Gerbil-only. No direct Chez equivalent\n\n#### Gerbil/Gambit-isms (from training data — wrong in Jerboa)\n- `time->seconds` — use `(time-second (current-time))` for epoch seconds\n- `thread-sleep!` — Gambit. Use `(sleep (make-time 'time-duration 0 seconds))`\n- `thread-yield` — no Chez equivalent. Use `(sleep (make-time 'time-duration 0 0))` as workaround\n- `path-expand` with 2 args — Gerbil takes `(path-expand rel base)`. Jerboa takes 1 arg. Use `(path-join base rel)` for 2-arg version\n- `process-status` — Gerbil. Use `(std misc process)` API in Jerboa\n- `user-info-home` — Gerbil. Use `(getenv \"HOME\")`\n- `the-environment` — Gerbil. Use `(interaction-environment)` in Chez\n- `condition/report-string` — Gerbil. Use `(with-output-to-string (lambda () (display-condition c)))`\n- `make-class-type` — Gerbil. Use `(defstruct ...)` or `(defclass ...)` in Jerboa\n- `string-subst` — Gerbil. Not in prelude. Use `(string-replace str old new)` or implement manually\n- `open-fd-pair` — Gambit. Does not exist in Chez; requires different API\n\n#### R6RS/Racket-isms (wrong variant)\n- `make-equal-hashtable` — R6RS. Use `(make-hash-table)` from Jerboa prelude\n- `arithmetic-shift` — Racket. Use `(bitwise-arithmetic-shift n k)` or `(ash n k)` in Chez\n- `pregexp-match` — Racket. Use `(std text regex)` or `(std pregexp)` API in Jerboa\n\n### CRITICAL: Common Arity Mistakes\n\n- `(list-of? pred)` → returns a PREDICATE. It takes 1 arg. Use: `((list-of? number?) lst)`\n- `(maybe pred)` → returns a PREDICATE. It takes 1 arg. Use: `((maybe string?) val)`\n- `(in-range end)` or `(in-range start end)` or `(in-range start end step)` — NOT `(in-range start step end)`\n- `(hash-ref ht key)` or `(hash-ref ht key default)` — NOT `(hash-ref key ht)`\n- `(string-split str delimiter)` where delimiter is a CHAR: `(string-split \"a,b\" #\\,)`\n- `(make-rwlock)` — takes **0 args**, NOT `(make-rwlock 'name)` (Gerbil takes a name; Jerboa does not)\n- `(path-expand path)` — takes **1 arg**, NOT `(path-expand rel base)` (Gerbil takes 2; use `path-join` for 2-arg)\n- `(sort predicate list)` — Chez arg order. NOT `(sort list predicate)` which is Gerbil/SRFI order\n\n### Core Forms (all from `(import (jerboa prelude))`)\n\n#### Definitions\n```scheme\n(def x 42) ;; variable\n(def (f x y) (+ x y)) ;; function\n(def (f x (y 10)) body) ;; optional param with default\n(def (f x . rest) body) ;; rest args\n(def* f ((x) ...) ((x y) ...)) ;; multi-arity\n(defrule (name pat) template) ;; macro\n```\n\n#### Data Structures\n```scheme\n(defstruct point (x y)) ;; → make-point, point?, point-x, point-y, point-x-set!\n(defstruct (circle shape) (radius)) ;; inheritance (single only)\n(defmethod (area (self circle)) body) ;; method on type\n(~ obj 'method arg ...) ;; dispatch (or {method obj arg ...})\n(defrecord person (name age)) ;; struct + pretty-print + ->alist\n(define-enum color (red green blue)) ;; → color-red, color?, color->name\n```\n\n#### Pattern Matching\n```scheme\n(match value\n (42 \"exact\") ;; literal\n ((list a b c) (+ a b c)) ;; list destructure\n ((cons h t) h) ;; pair\n ((? number?) \"num\") ;; predicate\n ((? string? s) (string-upcase s)) ;; predicate + bind\n ((and (? number?) (? positive?)) \"positive number\")\n ((or \"yes\" \"y\") #t)\n ((=> string->number n) n) ;; view pattern\n (n (where (> n 0)) \"positive\") ;; guard\n (_ \"default\")) ;; wildcard\n```\n\n#### Error Handling\n```scheme\n(try expr (catch (e) handler) (finally cleanup))\n(try expr (catch (error? e) handler))\n(unwind-protect body cleanup)\n(with-resource (var init cleanup) body)\n```\n\n#### Result Type (Rust-inspired ok/err)\n```scheme\n(ok 42) (err \"bad\") (ok? r) (err? r)\n(unwrap (ok 42)) ;; → 42 (raises on err)\n(unwrap-or (err \"x\") 0) ;; → 0\n(map-ok f result) (map-err f result)\n(and-then result f) ;; monadic bind\n(try-result expr) ;; exceptions → (err condition)\n(try-result* expr) ;; exceptions → (err \"message string\")\n(sequence-results list-of-results) ;; → (ok list) or first (err)\n(->? (ok 10) (+ 5) (* 2)) ;; → (ok 30), short-circuits on err\n```\n\n#### Iterators\n```scheme\n(for ((x (in-range 5))) (displayln x))\n(for/collect ((x (in-range 5))) (* x x)) ;; → (0 1 4 9 16)\n(for/fold ((sum 0)) ((x (in-range 10))) (+ sum x)) ;; → 45\n(for/or ((x lst)) (and (pred? x) x)) ;; first truthy\n(for/and ((x lst)) (pred? x)) ;; all truthy\n\n;; Iterators: in-list, in-vector, in-string, in-range, in-hash-keys,\n;; in-hash-values, in-hash-pairs, in-naturals, in-indexed,\n;; in-port, in-lines, in-chars, in-bytes, in-producer\n```\n\n#### Threading Macros\n```scheme\n(-> x (f a) (g b)) ;; thread first: (g (f x a) b)\n(->> x (f a) (g b)) ;; thread last: (g b (f a x))\n(as-> x v (f v) (g v)) ;; named\n(some-> x (f) (g)) ;; short-circuit on #f\n(cond-> x test (f) t2 (g)) ;; conditional steps\n(->? (ok x) (f) (g)) ;; result-aware thread first\n```\n\n#### Ergo Typing\n```scheme\n(: expr pred?) ;; checked cast\n(using (p (make-point 1 2) : point?)\n (+ p.x p.y)) ;; dot-access → (point-x p) etc.\n((list-of? number?) '(1 2 3)) ;; predicate factory → #t\n((maybe string?) #f) ;; accepts #f or string → #t\n```\n\n#### Hash Tables\n```scheme\n(def ht (make-hash-table))\n(hash-put! ht \"key\" \"val\")\n(hash-ref ht \"key\") ;; error if missing\n(hash-ref ht \"key\" \"default\") ;; with default\n(hash-get ht \"key\") ;; → val or #f\n(hash-key? ht \"key\") ;; → #t/#f\n(hash-remove! ht \"key\")\n(hash->list ht) (hash-keys ht) (hash-values ht)\n(hash-for-each (lambda (k v) ...) ht)\n(list->hash-table '((\"a\" . 1) (\"b\" . 2)))\n```\n\n#### Strings\n```scheme\n(string-split \"a,b,c\" #\\,) ;; → (\"a\" \"b\" \"c\") NOTE: char delimiter\n(string-join '(\"a\" \"b\") \",\") ;; → \"a,b\"\n(string-trim \" hi \") ;; → \"hi\"\n(string-prefix? \"he\" \"hello\") ;; → #t\n(string-suffix? \"lo\" \"hello\") ;; → #t\n(string-contains \"hello\" \"ell\") ;; → 1 (index, not boolean!)\n(string-empty? \"\") ;; → #t\n(str \"age: \" 42 \"!\") ;; → \"age: 42!\" (auto-coerce)\n```\n\n#### Lists\n```scheme\n(flatten '(1 (2 (3)))) ;; → (1 2 3)\n(unique '(1 2 2 3)) ;; → (1 2 3)\n(take lst n) (drop lst n) (take-last lst n) (drop-last lst n)\n(every pred lst) (any pred lst) (filter-map f lst)\n(group-by f lst) (zip lst1 lst2) (frequencies lst)\n(partition pred lst) (interleave l1 l2) (mapcat f lst)\n(distinct lst) (keep f lst) (split-at lst n)\n(append-map f lst) (snoc lst elem)\n```\n\n#### Functional Combinators\n```scheme\n(compose f g) (comp f g) ;; (f (g x))\n(partial f arg ...) ;; partial application\n(complement pred) (negate pred) ;; logical not\n(identity x) (constantly v) ;; basic combinators\n(curry f arg) (flip f) ;; currying, arg swap\n(conjoin p1 p2) (disjoin p1 p2) ;; predicate AND/OR\n(juxt f g) ;; → (lambda (x) (list (f x) (g x)))\n(cut f <> y) ;; SRFI-26 partial: (lambda (x) (f x y))\n```\n\n#### JSON\n```scheme\n(string->json-object \"{\\\"key\\\":\\\"val\\\"}\") ;; → hash table\n(json-object->string ht) ;; → JSON string\n(read-json port) (write-json obj port)\n```\n\n#### CSV\n```scheme\n(csv->alists \"name,age\\nAlice,30\") ;; → (((name . \"Alice\") (age . \"30\")))\n(read-csv-file \"data.csv\") ;; → list of row lists\n(write-csv-file \"out.csv\" rows)\n```\n\n#### DateTime\n```scheme\n(datetime-now) (datetime-utc-now)\n(make-datetime 2026 3 27 12 0 0)\n(parse-datetime \"2026-03-27T12:00:00Z\")\n(datetime->iso8601 dt) (datetime->epoch dt)\n(datetime-add dt duration) (datetime-diff dt1 dt2)\n(datetime<? dt1 dt2) (day-of-week dt) (leap-year? 2024)\n```\n\n#### Paths\n```scheme\n(path-join \"/home\" \"user\" \"f.txt\") ;; → \"/home/user/f.txt\"\n(path-directory \"/a/b/f.txt\") ;; → \"/a/b\"\n(path-extension \"file.txt\") ;; → \"txt\"\n(path-absolute? \"/home\") ;; → #t\n```\n\n#### File I/O\n```scheme\n(read-file-string \"f.txt\") ;; → entire file\n(read-file-lines \"f.txt\") ;; → list of lines\n(write-file-string \"f.txt\" \"data\")\n```\n\n#### Pretty Printing\n```scheme\n(pp expr) (pp-to-string expr) (pprint expr)\n```\n\n#### Formatting\n```scheme\n(format \"~a is ~a\" \"Alice\" 30) ;; → \"Alice is 30\"\n(printf \"x = ~a\\n\" 42)\n(displayln \"hello\" \" \" \"world\")\n```\n\n#### Anaphoric / Conditional Binding\n```scheme\n(awhen (find x) (use it)) ;; binds result to `it`\n(aif (find x) (use it) (default))\n(when-let (x (find y)) (use x))\n(if-let (x (find y)) (use x) (default))\n```\n\n#### Loops\n```scheme\n(while test body ...)\n(until test body ...)\n(dotimes (i 10) body ...) ;; 0..9\n```\n\n#### Misc Sugar\n```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```\n\n### What's NOT in the Prelude (requires separate import)\n\n```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```\n\n### Chez Scheme Conflicts (handled by prelude)\n\nThe prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---\n\n## Repository Boundaries\n\nWhen working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---\n\n## Build & Verification\n\nAfter modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.\n\n### Stale Artifacts\n\nIf edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".\n\n## Jerboa MCP Tools — MANDATORY Usage\n\nJerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.\n\n### MANDATORY Workflow Order (for writing new code)\n\n1. **`jerboa_howto`** — BEFORE writing code, search cookbook for verified patterns\n2. **`jerboa_module_exports`** / **`jerboa_function_signature`** — confirm APIs exist and check arities\n3. Write the code\n4. **`jerboa_verify`** — combined syntax + compile + lint + arity + duplicate check (use instead of individual tools)\n5. **`jerboa_security_scan`** — for code involving FFI, shell commands, or file I/O\n\n### Essential Tools (use proactively)\n\n| When | Tool |\n|---|---|\n| Before writing ANY Jerboa code | `jerboa_howto` — cookbook has verified patterns with correct imports |\n| Check what a module exports | `jerboa_module_exports` — never guess function names |\n| Check function arity/args | `jerboa_function_signature` — prevents wrong-arg-count errors |\n| Validate your code | `jerboa_verify` — one-stop syntax+compile+lint+arity check |\n| Test expressions interactively | `jerboa_eval` — use `imports` param for modules, `env` for FFI paths |\n| Persistent interactive testing | `jerboa_repl_session` — maintains state across evaluations |\n| Debug an error message | `jerboa_explain_error` + `jerboa_error_fix_lookup` |\n| Understand unfamiliar code | `jerboa_file_summary` + `jerboa_document_symbols` |\n| Find where something is defined | `jerboa_find_definition` — source file, module, kind, arity |\n| Search for symbol by substring | `jerboa_apropos` or `jerboa_smart_complete` |\n| Build the project | `jerboa_build_and_report` or `jerboa_make` — prefer over bash `make` |\n| Run tests | `jerboa_run_tests` — prefer over bash `scheme --script` |\n| Check for stale .so artifacts | `jerboa_stale_static` — common cause of \"edit has no effect\" |\n| Macro expansion | `jerboa_expand_macro` / `jerboa_trace_macro` |\n| Inspect struct/class types | `jerboa_class_info` — fields, inheritance, constructor signature |\n| FFI work | `jerboa_ffi_scaffold` / `jerboa_ffi_type_check` / `jerboa_ffi_null_safety` |\n| Port Gerbil code | `jerboa_migration_check` + `jerboa_translate_scheme` |\n| Detect paren imbalance | `jerboa_check_balance` — use BEFORE `make build` after deep edits |\n| Full project audit | `jerboa_project_health_check` — balance, exports, cycles, duplicates |\n| Security audit | `jerboa_security_audit` + `jerboa_import_policy_check` |\n| Static build audit | `jerboa_static_symbol_audit` + `jerboa_boot_library_audit` |\n| Explore a module | `jerboa_module_catalog` (replaces multiple `jerboa_doc` calls) |\n| Look up any symbol | `jerboa_doc` — type, arity, qualified name, related symbols |\n| Read stdlib source | `jerboa_stdlib_source` — see internal implementations |\n\n### Cookbook & Knowledge Management\n\n- **`jerboa_howto`** / **`jerboa_howto_get`**: Search and retrieve verified recipes\n- **`jerboa_howto_add`**: Save new patterns to cookbook (MANDATORY when you discover something non-trivial)\n- **`jerboa_howto_run`** / **`jerboa_howto_verify`**: Validate recipes still work\n- **`jerboa_error_fix_add`**: Save error→fix mappings for common mistakes\n\n### Code Generation & Refactoring\n\n`jerboa_rename_symbol`, `jerboa_balanced_replace`, `jerboa_wrap_form`, `jerboa_splice_form`, `jerboa_scaffold_test`, `jerboa_generate_module`, `jerboa_translate_scheme`, `jerboa_project_template`, `jerboa_httpd_handler_scaffold`, `jerboa_db_pattern_scaffold`, `jerboa_actor_ensemble_scaffold`\n\n### Feature Suggestions\n\n- **`jerboa_list_features`** / **`jerboa_suggest_feature`** / **`jerboa_vote_feature`**: Track and submit tooling improvement ideas\n\n---\n\n## MANDATORY: Save What You Learn\n\nJerboa is niche — every non-trivial pattern you discover prevents future sessions from re-discovering it.\n\n### Save to cookbook (`jerboa_howto_add`) whenever you:\n- Discover a working pattern through `jerboa_eval` or trial-and-error\n- Figure out correct imports, arities, or calling conventions that weren't obvious\n- Find a workaround for a Jerboa quirk or undocumented behavior\n\n**Before saving**: check `jerboa_howto` to avoid duplicates. **Do NOT save**: trivial one-liners, project-specific logic, or existing recipes.\n\n**Recipe format**: `id` (kebab-case), `tags` (4-6 search keywords incl. module name), `imports` (all required), `code` (complete working example), `notes` (gotchas/alternatives).\n\n### Suggest tooling improvements (`jerboa_suggest_feature`) whenever you:\n- Make multiple sequential tool calls that could be one tool\n- Fall back to bash because an MCP tool is missing or insufficient\n\n**Before suggesting**: check `jerboa_list_features`; vote with `jerboa_vote_feature` if it already exists.\n\n### Save Discoveries Mechanisms\n- **`/save-discoveries` skill**: invoke anytime to review session and save patterns + suggestions\n- **PreCompact hook**: add `PreCompact` hook with `type: \"prompt\"` in `.claude/settings.json` to auto-save before context compaction\n\n---\n\n## Common Workflows\n\n- **Write new code**: `jerboa_howto` -> `jerboa_module_exports` -> write code -> `jerboa_verify` -> `jerboa_security_scan`\n- **Debug an error**: `jerboa_explain_error` -> follow suggested tools -> `jerboa_howto` for fix patterns\n- **Understand unfamiliar code**: `jerboa_file_summary` -> `jerboa_document_symbols` -> `jerboa_module_deps`\n- **Refactor a module**: `jerboa_check_exports` -> `jerboa_find_callers` -> `jerboa_rename_symbol` -> `jerboa_check_import_conflicts`\n- **Build project**: `jerboa_build_conflict_check` -> `jerboa_make` -> `jerboa_build_and_report`\n- **Port from Gerbil**: `jerboa_migration_check` -> `jerboa_translate_scheme` -> `jerboa_verify` -> `jerboa_check_syntax`\n- **Audit project quality**: `jerboa_verify` -> `jerboa_lint` -> `jerboa_dead_code` -> `jerboa_dependency_cycles`\n- **Debug a crash**: `jerboa_stale_static` -> `jerboa_bisect_crash` -> `jerboa_ffi_type_check`\n- **Learn a module**: `jerboa_stdlib_source` -> `jerboa_module_catalog` -> `jerboa_module_quickstart`\n- **Security audit**: `jerboa_security_audit` -> `jerboa_import_policy_check` -> `jerboa_unsafe_import_lint`\n- **Static build audit**: `jerboa_static_symbol_audit` -> `jerboa_boot_library_audit` -> `jerboa_rust_musl_build`\n- **Safe-by-default check**: `jerboa_safe_prelude_check` -> `jerboa_resource_leak_check` -> `jerboa_safe_prelude_generate`\n- **Debug editor command**: `jerboa_command_trace` with `project_path` and `buffer_type`\n\n## Workflow Conventions\n\nWhen implementing new features, always complete the documentation update in the same session. Document non-trivial solutions as howto recipes in the cookbook system.\n"} {"text":";; FILE: jerboa-code/build-jcode-musl.ss\n#!chezscheme\n;;; build-jcode-musl.ss — Build a fully static jcode binary using musl libc\n;;;\n;;; Usage: scheme -q --libdirs <jerboa-lib>:./lib:vendor/jerboa-sqlite/src < build-jcode-musl.ss\n;;;\n;;; This script:\n;;; 1. Compiles jcode modules (using stock scheme with glibc)\n;;; 2. Creates boot file + optimized program .so\n;;; 3. Generates C files with embedded boot data\n;;; 4. Compiles C with musl-gcc against musl-built Chez's scheme.h\n;;; 5. Links fully static binary with libkernel.a from musl-built Chez\n;;;\n;;; The resulting jcode-musl binary has zero runtime dependencies.\n\n(import\n (except (chezscheme) void box box? unbox set-box!\n andmap ormap iota last-pair find\n 1+ 1- fx/ fx1+ fx1-\n error error? raise with-exception-handler identifier?\n hash-table? make-hash-table)\n (jerboa build)\n (jerboa build musl))\n\n;; ========== Auto-bootstrap musl Chez if missing ==========\n;;\n;; The musl-static binary requires a libkernel.a built with musl-gcc.\n;; /usr/local Chez on Linux is glibc-built (its libkernel.a references\n;; __memcpy_chk / __fprintf_chk / __stack_chk_fail — glibc-fortify ABI\n;; symbols absent from musl) and therefore cannot satisfy a musl-static\n;; link. So we need a *separate* musl-built Chez prefix.\n;;\n;; We keep it in-tree as ~/mine/ChezScheme/musl-out so it's obviously a\n;; build artifact (not a system install) and stays version-locked to the\n;; source. If missing, build it via support/musl-chez-build.sh.\n\n(define jcode-musl-chez-prefix\n (or (getenv \"JERBOA_MUSL_CHEZ_PREFIX\")\n (format \"~a/mine/ChezScheme/musl-out\" (or (getenv \"HOME\") \"/root\"))))\n\n;; Tell (jerboa build musl) where the prefix lives. We respect\n;; JERBOA_MUSL_CHEZ_PREFIX (set by e.g. the jerboa21/jerboa Docker base\n;; image, which ships a pre-built musl Chez at /build/chez-musl) and\n;; otherwise default to an in-tree install. Overrides the default probe\n;; order so we don't accidentally pick up a stale ~/chez-musl from a\n;; previous setup.\n(musl-chez-prefix-set! jcode-musl-chez-prefix)\n\n(unless (file-directory? jcode-musl-chez-prefix)\n (let* ([home (or (getenv \"HOME\") \"/root\")]\n [chez-src (format \"~a/mine/ChezScheme\" home)]\n [bootstrap (format \"~a/mine/jerboa/support/musl-chez-build.sh\" home)])\n (printf \"~n=== musl Chez not found — auto-bootstrapping ===~n\")\n (printf \" source: ~a~n\" chez-src)\n (printf \" prefix: ~a~n~n\" jcode-musl-chez-prefix)\n (cond\n [(not (file-exists? \"/usr/bin/musl-gcc\"))\n (printf \"FATAL: musl-gcc not found. Install with: apt install musl-tools~n\")\n (exit 1)]\n [(not (file-directory? chez-src))\n (printf \"FATAL: Chez source not found at ~a~n\" chez-src)\n (printf \" git clone https://github.com/cisco/ChezScheme.git ~a~n\" chez-src)\n (exit 1)]\n [(not (file-exists? bootstrap))\n (printf \"FATAL: bootstrap script not found: ~a~n\" bootstrap)\n (exit 1)]\n [else\n (printf \"This takes ~~5-10 minutes; subsequent runs reuse it.~n~n\")\n (let ([rc (system (format \"bash '~a' '~a' '~a'\" bootstrap chez-src jcode-musl-chez-prefix))])\n (unless (= rc 0)\n (printf \"~nFATAL: musl Chez bootstrap failed (rc=~a)~n\" rc)\n (printf \"Run manually to inspect:~n bash ~a ~a ~a~n\" bootstrap chez-src jcode-musl-chez-prefix)\n (exit 1))\n (printf \"~n=== musl Chez bootstrap complete ===~n~n\"))])))\n\n;; ========== Validate musl setup ==========\n\n(let ([result (validate-musl-setup)])\n (unless (eq? (car result) 'ok)\n (printf \"Error: ~a~n\" (cdr result))\n (printf \"~nTo build Chez Scheme with musl:~n\")\n (printf \" cd ~/mine/ChezScheme~n\")\n (printf \" ./configure --threads --static CC=musl-gcc --installprefix=~a~n\"\n jcode-musl-chez-prefix)\n (printf \" make -j$(nproc) && make install~n\")\n (exit 1)))\n\n(printf \"musl Chez found: ~a~n~n\" (musl-chez-lib-dir))\n\n;; (Previously had a (scheme-version) vs csv-dir version-string check\n;; here. It was buggy — (scheme-version) returns \"Chez Scheme Version\n;; 10.4.0\" which can never equal the install-dir version \"10.4.0-pre-\n;; release.4\" — so it produced false positives. The scenario it was\n;; meant to catch (stale musl prefix vs newer host scheme) is now\n;; prevented structurally: Docker uses the base image's matched pair,\n;; and the native path auto-bootstraps musl Chez from the same source\n;; tree the host scheme was built from. Boot-file FASL mismatches will\n;; surface as a clear runtime error if they ever occur again.)\n\n;; ========== Locate directories ==========\n\n(define home-dir (or (getenv \"HOME\") \"/root\"))\n\n(define jerboa-dir\n (let ([jh (getenv \"JERBOA_HOME\")])\n (if jh\n (format \"~a/lib\" jh)\n (format \"~a/mine/jerboa/lib\" home-dir))))\n\n(define jerboa-dir-base\n (let ([jh (getenv \"JERBOA_HOME\")])\n (or jh (format \"~a/mine/jerboa\" home-dir))))\n\n(printf \"Jerboa lib: ~a~n\" jerboa-dir)\n\n(define build-dir \"/tmp/jerboa-musl-jcode-build\")\n(define obj-dir (format \"~a/obj\" build-dir))\n(define program-so (format \"~a/program.so\" obj-dir))\n\n(define (prepare-build-dir!)\n (system (format \"rm -rf '~a'\" build-dir))\n (system (format \"mkdir -p '~a'\" obj-dir)))\n\n(define (cleanup-build-dir!)\n (system (format \"rm -rf '~a'\" build-dir)))\n\n;; ========== Auto-discovery helpers ==========\n;;\n;; These helpers eliminate the hardcoded parallel lists of modules that\n;; historically drifted every time a new src/jcode/*.ss file was added.\n;; jcode-modules and external-libs are now derived from the filesystem.\n\n(define (find-files-with-suffix root suffix)\n ;; Recursively find all files under `root` whose name ends in `suffix`.\n ;; Returns an alphabetically sorted list of full paths.\n (if (and (string? root)\n (file-exists? root)\n (file-directory? root))\n (let loop ([dirs (list root)] [acc '()])\n (if (null? dirs)\n (sort string<? acc)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter\n (lambda (p)\n (and (not (file-directory? p))\n (let ([n (string-length p)]\n [sn (string-length suffix)])\n (and (>= n sn)\n (string=?\n suffix\n (substring p (- n sn) n))))))\n entries)]\n [subdirs (filter file-directory? entries)])\n (loop (append subdirs (cdr dirs)) (append files acc)))))\n '()))\n\n(define (strip-suffix s suffix)\n (let ([ls (string-length s)] [lsu (string-length suffix)])\n (if (and (>= ls lsu)\n (string=? suffix (substring s (- ls lsu) ls)))\n (substring s 0 (- ls lsu))\n s)))\n\n(define (assert-so-files-exist! who paths kind)\n ;; Strict replacement for the old silent `existing-so-files` filter.\n ;; Errors loudly if any entry is missing so drift surfaces immediately.\n (let ([missing (filter (lambda (p) (not (file-exists? p))) paths)])\n (cond\n [(null? missing) paths]\n [else\n (printf \"~n[ERROR] ~a: ~a of ~a ~a .so file(s) missing:~n\"\n who (length missing) (length paths) kind)\n (for-each (lambda (p) (printf \" - ~a~n\" p)) missing)\n (error who\n (format \"missing ~a .so file(s) — drift between source tree and build script\"\n kind))])))\n\n;; ========== Auto-discover jcode modules ==========\n;; lib/jcode/**/*.sls is generated by jerbuild (make gen) before this script\n;; runs. Walking the filesystem keeps this list perpetually in sync with the\n;; source tree.\n\n(define jcode-modules\n (map (lambda (sls-path) (strip-suffix sls-path \".sls\"))\n (find-files-with-suffix \"lib/jcode\" \".sls\")))\n\n(printf \"~n[discovery] Found ~a jcode modules under lib/jcode~n\"\n (length jcode-modules))\n(when (null? jcode-modules)\n (error 'build-jcode-musl\n \"No .sls files found under lib/jcode — run 'make gen' first\"))\n(for-each (lambda (m) (printf \" ~a~n\" m)) jcode-modules)\n\n;; libc symbols needed by std/net/* and std/os/* (already linked from musl).\n;; All are real libc functions, not macros — straight (void*)foo casts work.\n;; Variadic/macro ones (open/fcntl/ioctl/umask) are intentionally omitted;\n;; the modules that need them either run through the std/os shims (ffi_*)\n;; or call into the patched (load-shared-object) path that no longer fires.\n(define libc-symbols\n '(;; sockets — std/net/tcp, std/net/udp\n \"socket\" \"bind\" \"listen\" \"accept\" \"connect\" \"close\"\n \"setsockopt\" \"getsockopt\" \"getsockname\"\n \"htons\" \"ntohs\" \"inet_pton\" \"inet_addr\"\n \"read\" \"write\" \"recvfrom\" \"sendto\"\n ;; DNS resolver — std/net/resolve\n \"getaddrinfo\" \"freeaddrinfo\" \"inet_ntop\"\n ;; process / signals — std/misc/process, std/os/signal, aproc\n \"fork\" \"waitpid\" \"kill\" \"getpid\" \"getppid\"\n \"getpgid\" \"setpgid\" \"setsid\"\n \"getuid\" \"geteuid\" \"getgid\" \"getegid\"\n \"sigemptyset\" \"sigfillset\" \"sigaddset\" \"sigdelset\"\n \"sigismember\" \"sigprocmask\"\n ;; terminal / fd — TUI + REPL\n \"isatty\" \"tcgetattr\" \"tcsetattr\" \"tcgetpgrp\" \"tcsetpgrp\"\n \"pipe\" \"dup\" \"dup2\" \"lseek\"\n ;; env / misc — std/os/env, std/text/time\n \"setenv\" \"unsetenv\" \"strerror\" \"localtime\" \"strftime\"\n \"sysconf\" \"getpagesize\" \"getrlimit\"\n \"system\" \"getenv\" \"putenv\" \"_exit\" \"exit\" \"execvp\" \"execve\"\n ;; temporary files/directories — std/os/temp\n \"mkstemp\" \"mkdtemp\" \"unlink\" \"rmdir\"\n ;; errno location + Linux sandboxing\n \"__errno_location\" \"fcntl\" \"prctl\" \"syscall\"))\n\n;; FFI symbols that need Sforeign_symbol registration\n(define ffi-symbols\n '(;; jerboa-sqlite shim\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_clear_bindings\" \"jerboa_sqlite_step\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_name\"\n \"jerboa_sqlite_column_type\" \"jerboa_sqlite_column_int64\"\n \"jerboa_sqlite_column_double\" \"jerboa_sqlite_column_text\"\n \"jerboa_sqlite_column_bytes\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_bind_int64\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\"\n \"jerboa_sqlite_bind_null\" \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_SQLITE_ROW\" \"jerboa_SQLITE_DONE\" \"jerboa_SQLITE_OK\"\n ;; termbox2 TUI shim\n \"jcode_tb_init\" \"jcode_tb_shutdown\"\n \"jcode_tb_width\" \"jcode_tb_height\"\n \"jcode_tb_clear\" \"jcode_tb_present\"\n \"jcode_tb_set_cursor\" \"jcode_tb_hide_cursor\"\n \"jcode_tb_change_cell\" \"jcode_tb_set_clear_attrs\"\n \"jcode_tb_print\" \"jcode_tb_printf\"\n \"jcode_tb_set_input_mode\" \"jcode_tb_set_output_mode\"\n \"jcode_tb_poll_event\" \"jcode_tb_peek_event\"\n \"jcode_tb_event_type\" \"jcode_tb_event_mod\"\n \"jcode_tb_event_key\" \"jcode_tb_event_ch\"\n \"jcode_tb_event_w\" \"jcode_tb_event_h\"\n \"jcode_tb_event_x\" \"jcode_tb_event_y\"\n ;; jerboa-native (TLS/rustls)\n \"jerboa_tls_server_new\" \"jerboa_tls_server_new_mtls\"\n \"jerboa_tls_server_free\" \"jerboa_tls_accept\"\n \"jerboa_tls_connect\" \"jerboa_tls_connect_pinned\"\n \"jerboa_tls_connect_mtls\" \"jerboa_tls_close\"\n \"jerboa_tls_read\" \"jerboa_tls_write\" \"jerboa_tls_flush\"\n \"jerboa_tls_get_fd\" \"jerboa_tls_set_nonblock\"\n \"jerboa_last_error\"\n ;; jerboa-native (crypto/ring) — used by secrets.ss via (std crypto native-rust)\n \"jerboa_sha1\" \"jerboa_sha256\" \"jerboa_sha384\" \"jerboa_sha512\"\n \"jerboa_random_bytes\" \"jerboa_timing_safe_equal\"\n \"jerboa_hmac_sha256\" \"jerboa_hmac_sha256_verify\"\n \"jerboa_aead_seal\" \"jerboa_aead_open\"\n \"jerboa_chacha20_seal\" \"jerboa_chacha20_open\"\n \"jerboa_scrypt\"\n \"jerboa_pbkdf2_derive\" \"jerboa_pbkdf2_verify\"\n \"jerboa_argon2id_hash\" \"jerboa_argon2id_verify\"\n ;; jerboa-native (regex) — pulled in transitively via (jerboa prelude)\n ;; which imports (std regex). foreign-procedure forms run at library\n ;; visit time, so these have to exist even if jcode never matches a regex.\n \"jerboa_regex_compile\" \"jerboa_regex_is_match\"\n \"jerboa_regex_find\" \"jerboa_regex_replace_all\" \"jerboa_regex_free\"\n ;; jerboa-native (aproc) — used by (std os aproc) for bash tool\n \"jerboa_aproc_spawn\" \"jerboa_aproc_spawn_pty\"\n \"jerboa_aproc_set_nonblock\" \"jerboa_aproc_killpg\" \"jerboa_aproc_wait4\"\n ;; jerboa-native (sqlite) — used by (std db sqlite) via sqlite-native.sls\n \"jerboa_sqlite_open\" \"jerboa_sqlite_close\" \"jerboa_sqlite_exec\"\n \"jerboa_sqlite_prepare\" \"jerboa_sqlite_finalize\" \"jerboa_sqlite_reset\"\n \"jerboa_sqlite_step\" \"jerboa_sqlite_changes\" \"jerboa_sqlite_errmsg\"\n \"jerboa_sqlite_last_insert_rowid\"\n \"jerboa_sqlite_bind_int\" \"jerboa_sqlite_bind_double\"\n \"jerboa_sqlite_bind_text\" \"jerboa_sqlite_bind_blob\" \"jerboa_sqlite_bind_null\"\n \"jerboa_sqlite_column_count\" \"jerboa_sqlite_column_type\"\n \"jerboa_sqlite_column_int\" \"jerboa_sqlite_column_double\"\n \"jerboa_sqlite_column_text\" \"jerboa_sqlite_column_blob\"\n \"jerboa_sqlite_column_name\"\n ;; jerboa-native (net/io) — vectored I/O wrapper used by (std net io)\n \"jerboa_writev2\"\n ;; landlock-shim (support/landlock-shim.c)\n \"jerboa_landlock_sandbox\"\n \"jerboa_landlock_sandbox_ex\"\n \"jerboa_landlock_abi_version\"))\n\n;; ========== Step 0: Prepare isolated object output ==========\n\n(printf \"[0/7] Preparing isolated build/object directories...~n\")\n(prepare-build-dir!)\n\n;; Compile imported libraries into obj-dir while loading sources from the\n;; original --libdirs. This avoids modifying $JERBOA_HOME/lib, vendor/, or\n;; generated lib/jcode files during static builds.\n(library-directories\n (map (lambda (pair)\n (cons (if (pair? pair) (car pair) pair) obj-dir))\n (library-directories)))\n\n;; ========== Step 1: Compile all modules ==========\n\n(printf \"[1/7] Compiling all modules (optimize-level 3)...~n\")\n(parameterize ((compile-imported-libraries #t)\n (optimize-level 3)\n (cp0-effort-limit 500)\n (cp0-score-limit 50)\n (cp0-outer-unroll-limit 1)\n (commonization-level 4)\n (enable-unsafe-application #t)\n (enable-unsafe-variable-reference #t)\n (enable-arithmetic-left-associative #t)\n (debug-level 0)\n (generate-inspector-information #f))\n (compile-program \"main-binary.ss\" program-so))\n\n;; Fail loud if compile-program didn't actually produce the isolated program.\n;; Historically this failure was silent — the script would continue until\n;; step 5 died with a cryptic open-file-input-port failure.\n(unless (file-exists? program-so)\n (printf \"~n[ERROR] compile-program completed but program.so was not produced.~n\")\n (printf \" cwd: ~a~n\" (current-directory))\n (printf \" entry: main-binary.ss~n\")\n (printf \" This usually means an import in main-binary.ss could not be resolved~n\")\n (printf \" or the isolated object directory was not writable: ~a~n\" obj-dir)\n (error 'build-jcode-musl\n \"program.so not produced by compile-program\"))\n(printf \" → ~a (~a bytes)~n\"\n program-so\n (file-length (open-file-input-port program-so)))\n\n;; ========== Step 2: Skip WPO for musl builds ==========\n;; Use the direct program.so from compile-program.\n(printf \"[2/7] Skipping WPO (using isolated program.so directly)...~n\")\n\n;; ========== Step 3: Auto-discover compiled libraries ==========\n;;\n;; compile-program traversed main-binary.ss's import graph and wrote every\n;; imported library object into obj-dir. Embed all of those library objects in\n;; the boot image, excluding the entry program itself.\n\n(printf \"[3/7] Discovering libraries compiled under ~a...~n\" obj-dir)\n\n(define compiled-lib-paths\n (filter (lambda (p) (not (string=? p program-so)))\n (find-files-with-suffix obj-dir \".so\")))\n\n(printf \" Found ~a compiled library .so file(s)~n\" (length compiled-lib-paths))\n(when (null? compiled-lib-paths)\n (error 'build-jcode-musl\n (format \"No library .so files under ~a after compile-program\" obj-dir)))\n\n;; ========== Step 4: Create libs-only boot file ==========\n\n(printf \"[4/7] Creating libs-only boot file...~n\")\n(printf \" Boot file contents: ~a compiled library .so files~n\"\n (length compiled-lib-paths))\n\n(apply make-boot-file \"jcode.boot\" '(\"scheme\" \"petite\") compiled-lib-paths)\n\n;; ========== Step 5: Generate C with embedded boot files + program ==========\n\n(printf \"[5/7] Generating C with embedded boot files + program...~n\")\n\n(define musl-lib-dir (musl-chez-lib-dir))\n(define gcc (musl-gcc-path))\n(define scheme-h-dir musl-lib-dir)\n(define harden-cflags\n (string-append \"-ffile-prefix-map=\" (current-directory) \"=.\"\n \" -ffile-prefix-map=\" (or (getenv \"HOME\") \"/root\") \"=~\"))\n\n;; Get boot file paths from musl Chez installation\n(define musl-boots (musl-boot-files))\n(define petite-boot-path (cdr (assoc \"petite\" musl-boots)))\n(define scheme-boot-path (cdr (assoc \"scheme\" musl-boots)))\n\n;; Generate static_boot.c: embeds petite.boot + scheme.boot + jcode.boot\n(define static-boot-c (format \"~a/static_boot.c\" build-dir))\n(call-with-output-file static-boot-c\n (lambda (out)\n (display \"#include \\\"scheme.h\\\"\\n\\n\" out)\n (display (file->c-array petite-boot-path \"petite_boot\") out)\n (newline out)\n (display (file->c-array scheme-boot-path \"scheme_boot\") out)\n (newline out)\n (display (file->c-array \"jcode.boot\" \"jcode_boot\") out)\n (newline out)\n (display \"void static_boot_init(void) {\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"petite\\\", petite_boot, petite_boot_len);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"scheme\\\", scheme_boot, scheme_boot_len);\\n\" out)\n (display \" Sregister_boot_file_bytes(\\\"jcode\\\", jcode_boot, jcode_boot_len);\\n\" out)\n (display \"}\\n\" out))\n 'replace)\n\n;; Rust native library — build a project-specific musl static lib with ONLY\n;; the cargo features jcode actually uses. jcode's FFI surface is:\n;; - jerboa_tls_* (provider/provider.ss) => feature `tls`\n;; - sqlite3_* (via jerboa-sqlite shim) => feature `sqlite`\n;; That's it. `crypto`, `duckdb_feat`, `pcap`, `spidermonkey`, `wasm`,\n;; `postgres_feat` are not referenced from any jcode source.\n;;\n;; The old fall-back-to-glibc behaviour was the recurring source of \"works on\n;; Mac, breaks on Linux\": cargo build --release during normal jerboa dev\n;; rebuilds the glibc artifact, and the musl build silently picked it up\n;; (yielding __memcpy_chk / libstdc++ link errors at the final step).\n;;\n;; We force cargo to use the rustup-managed rustc — some PATH setups (e.g.\n;; Homebrew rust ahead of the rustup proxies) resolve `rustc` to a binary\n;; that has no musl target installed. Doing it via env (not `rustup run`) is\n;; critical, because `rustup run stable cargo build` only configures cargo's\n;; environment — cargo still launches whichever `rustc` appears first on\n;; PATH for the child compilations.\n;;\n;; A sentinel file under target/ records the exact feature set that produced\n;; the .a, so future builds rebuild iff features changed or any .rs source\n;; is newer than the .a (jerboa-shell uses the same pattern).\n(define jcode-cargo-features \"tls,sqlite,crypto\")\n(define native-lib-path\n (format \"~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/libjerboa_native.a\"\n jerboa-dir-base))\n(define native-features-sentinel\n (format \"~a/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/.built-with-~a\"\n jerboa-dir-base\n (let ([s (string-copy jcode-cargo-features)])\n (let loop ([i 0])\n (cond [(= i (string-length s)) s]\n [(char=? (string-ref s i) #\\,) (string-set! s i #\\-) (loop (+ i 1))]\n [else (loop (+ i 1))])))))\n\n(define (rs-source-newer-than? a-path)\n (let ([src-dir (format \"~a/jerboa-native-rs/src\" jerboa-dir-base)])\n (and (file-directory? src-dir)\n (file-exists? a-path)\n (let ([a-mtime (file-modification-time a-path)])\n (let walk ([dirs (list src-dir)])\n (and (pair? dirs)\n (let* ([d (car dirs)]\n [entries (map (lambda (e) (format \"~a/~a\" d e))\n (directory-list d))]\n [files (filter (lambda (p) (not (file-directory? p))) entries)]\n [subs (filter file-directory? entries)])\n (or (ormap (lambda (f)\n (and (let ([n (string-length f)])\n (and (> n 3)\n (string=? \".rs\" (substring f (- n 3) n))))\n (time>? (file-modification-time f) a-mtime)))\n files)\n (walk (append subs (cdr dirs)))))))))))\n\n(define (try-cargo-build cmd)\n (printf \" $ ~a~n\" cmd)\n (zero? (system cmd)))\n\n(define (rebuild-native-lib!)\n (let* ([nrs-dir (format \"~a/jerboa-native-rs\" jerboa-dir-base)]\n [rustup-active (string-append (getenv \"HOME\")\n \"/.rustup/toolchains/stable-x86_64-unknown-linux-gnu/bin\")]\n [cargo-args (format \"build --release --no-default-features --features ~a --target x86_64-unknown-linux-musl\"\n jcode-cargo-features)]\n [via-rustup\n (format \"cd '~a' && env PATH='~a:'$PATH RUSTC='~a/rustc' cargo ~a\"\n nrs-dir rustup-active rustup-active cargo-args)]\n [via-path\n (format \"cd '~a' && cargo ~a\" nrs-dir cargo-args)]\n [ok? (or (and (file-directory? rustup-active) (try-cargo-build via-rustup))\n (try-cargo-build via-path))])\n (unless (and ok? (file-exists? native-lib-path))\n (error 'build-jcode-musl\n (string-append\n \"failed to build jerboa-native-rs for x86_64-unknown-linux-musl. \"\n \"Required: `rustup target add x86_64-unknown-linux-musl`, musl-gcc, \"\n \"and musl headers at /usr/include/x86_64-linux-musl. Do NOT fall back \"\n \"to the glibc artifact at target/release/libjerboa_native.a — it \"\n \"references __memcpy_chk and libstdc++ symbols musl-gcc cannot link.\")\n native-lib-path))\n ;; Record the feature set this .a was built with.\n (call-with-output-file native-features-sentinel\n (lambda (out)\n (display jcode-cargo-features out)\n (newline out))\n 'truncate)))\n\n(cond\n [(not (file-exists? native-lib-path))\n (printf \"[0.2/7] Building jerboa-native-rs (musl, features=~a)...~n\" jcode-cargo-features)\n (rebuild-native-lib!)]\n [(not (file-exists? native-features-sentinel))\n (printf \"[0.2/7] Rebuilding jerboa-native-rs — sentinel missing (features=~a)...~n\" jcode-cargo-features)\n (rebuild-native-lib!)]\n [(rs-source-newer-than? native-lib-path)\n (printf \"[0.2/7] Rebuilding jerboa-native-rs — .rs source newer than .a...~n\")\n (rebuild-native-lib!)]\n [else\n (printf \"[0.2/7] jerboa-native-rs up to date (features=~a)~n\" jcode-cargo-features)])\n(define has-native-lib? #t)\n\n;; Generate jcode_main_musl.c\n(define program-c (format \"~a/jcode_main_musl.c\" build-dir))\n(call-with-output-file program-c\n (lambda (out)\n (display \"#define _GNU_SOURCE\\n\" out)\n (display \"#include <stdlib.h>\\n\" out)\n (display \"#include <string.h>\\n\" out)\n (display \"#include <stdio.h>\\n\" out)\n (display \"#include <unistd.h>\\n\" out)\n (display \"#include <sys/mman.h>\\n\" out)\n (display \"#include <sys/types.h>\\n\" out)\n (display \"#include <sys/stat.h>\\n\" out)\n (display \"#include <fcntl.h>\\n\" out)\n (display \"#include <signal.h>\\n\" out)\n (display \"#include <errno.h>\\n\" out)\n (display \"#include \\\"scheme.h\\\"\\n\\n\" out)\n ;; dlopen/dlsym stubs for static builds\n (display \"/* dlopen stubs — override musl's failing stubs in static builds */\\n\" out)\n (display \"void *dlopen(const char *filename, int flags) {\\n\" out)\n (display \" (void)flags; (void)filename;\\n\" out)\n (display \" return (void*)1; /* all symbols pre-registered via Sforeign_symbol */\\n\" out)\n (display \"}\\n\" out)\n (display \"void *dlsym(void *handle, const char *symbol) {\\n\" out)\n (display \" (void)handle; (void)symbol;\\n\" out)\n (display \" return NULL; /* symbols found via Sforeign_symbol */\\n\" out)\n (display \"}\\n\" out)\n (display \"int dlclose(void *handle) { (void)handle; return 0; }\\n\" out)\n (display \"char *dlerror(void) { return NULL; }\\n\\n\" out)\n ;; Embed program .so\n (display (file->c-array program-so \"jcode_program_data\") out)\n (newline out)\n ;; Declare static_boot_init\n (display \"extern void static_boot_init(void);\\n\\n\" out)\n ;; Declare FFI symbols (project-specific shims)\n (display \"/* FFI symbols */\\n\" out)\n (for-each\n (lambda (name) (fprintf out \"extern void ~a();\\n\" name))\n ffi-symbols)\n (newline out)\n ;; libc symbols — proper includes so prototypes match.\n ;; Adding a symbol to libc-symbols above usually requires bumping the\n ;; include set here too; otherwise the C compile fails with\n ;; \"implicit declaration\" or \"undeclared\".\n (display \"/* libc symbols for Sforeign_symbol registration */\\n\" out)\n (display \"#include <sys/socket.h>\\n\" out)\n (display \"#include <netinet/in.h>\\n\" out)\n (display \"#include <arpa/inet.h>\\n\" out)\n (display \"#include <netdb.h>\\n\" out) ;; getaddrinfo, freeaddrinfo\n (display \"#include <sys/wait.h>\\n\" out) ;; waitpid\n (display \"#include <sys/resource.h>\\n\" out) ;; getrlimit\n (display \"#include <sys/prctl.h>\\n\" out) ;; prctl\n (display \"#include <termios.h>\\n\" out) ;; tcgetattr/tcsetattr/tcgetpgrp/tcsetpgrp\n (display \"#include <signal.h>\\n\" out) ;; kill, sigemptyset/sigprocmask family\n (display \"#include <time.h>\\n\" out) ;; localtime, strftime\n (display \"#include <fcntl.h>\\n\" out) ;; fcntl\n (display \"#include <unistd.h>\\n\" out) ;; fork, dup, pipe, sysconf, ids, isatty\n (display \"#include <stdlib.h>\\n\" out) ;; setenv, unsetenv\n (display \"#include <string.h>\\n\" out) ;; strerror\n ;; __errno_location has no public header — declare it ourselves.\n (display \"extern int *__errno_location(void);\\n\" out)\n (newline out)\n ;; Register FFI symbols callback\n (display \"static void register_ffi(void) {\\n\" out)\n (for-each\n (lambda (name)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" name name))\n ffi-symbols)\n ;; Register libc symbols (already in static binary from musl)\n (for-each\n (lambda (name)\n (fprintf out \" Sforeign_symbol(\\\"~a\\\", (void*)~a);\\n\" name name))\n libc-symbols)\n (display \"}\\n\\n\" out)\n ;; Main\n (display \"int main(int argc, char *argv[]) {\\n\" out)\n (display \" /* Write program .so to temp file for Sscheme_script */\\n\" out)\n (display \" char prog_path[256];\\n\" out)\n (display \" const char *tmpdir = getenv(\\\"TMPDIR\\\");\\n\" out)\n (display \" if (!tmpdir) tmpdir = \\\"/tmp\\\";\\n\" out)\n (display \" snprintf(prog_path, sizeof(prog_path), \\\"%s/jcode-XXXXXX\\\", tmpdir);\\n\" out)\n (display \" int fd = mkstemp(prog_path);\\n\" out)\n (display \" if (fd < 0) { perror(\\\"mkstemp\\\"); return 1; }\\n\" out)\n (display \" if (write(fd, jcode_program_data, jcode_program_data_len)\\n\" out)\n (display \" != (ssize_t)jcode_program_data_len) {\\n\" out)\n (display \" perror(\\\"write\\\"); close(fd); unlink(prog_path); return 1;\\n\" out)\n (display \" }\\n\" out)\n (display \" close(fd);\\n\\n\" out)\n (display \" /* Tell jerboa stdlib libraries (std/net/*, std/os/*, std/db/*)\\n\" out)\n (display \" * we are statically linked. Without JERBOA_STATIC=1 their\\n\" out)\n (display \" * library visit-time code calls (load-shared-object #f) which\\n\" out)\n (display \" * raises in a static binary. Variable must be set BEFORE\\n\" out)\n (display \" * Sscheme_init since libraries are visited during heap build. */\\n\" out)\n (display \" setenv(\\\"JERBOA_STATIC\\\", \\\"1\\\", 1);\\n\" out)\n (display \"\\n\" out)\n (display \" Sscheme_init(NULL);\\n\" out)\n (display \" static_boot_init();\\n\" out)\n (display \" Sbuild_heap(NULL, register_ffi);\\n\" out)\n (display \" int status = Sscheme_script(prog_path, argc, (const char **)argv);\\n\" out)\n (display \" unlink(prog_path);\\n\" out)\n (display \" Sscheme_deinit();\\n\" out)\n (display \" return status;\\n\" out)\n (display \"}\\n\" out))\n 'replace)\n\n;; ========== Step 6: Compile C with musl-gcc ==========\n\n(printf \"[6/7] Compiling C with musl-gcc...~n\")\n\n(define (run-cmd cmd)\n (printf \" ~a~n\" cmd)\n (unless (= 0 (system cmd))\n (error 'build-jcode-musl \"Command failed\" cmd)))\n\n;; Compile static_boot.c\n(run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/static_boot.o' '~a'\"\n gcc harden-cflags scheme-h-dir\n build-dir static-boot-c))\n\n;; Compile jcode_main_musl.c\n(run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/jcode_main_musl.o' '~a'\"\n gcc harden-cflags scheme-h-dir\n build-dir program-c))\n\n;; Compile jerboa-sqlite shim\n;; Copy sqlite3.h to build dir (can't use -I/usr/include with musl-gcc — glibc conflict)\n(let ([shim-src \"vendor/jerboa-sqlite/jerboa_sqlite_shim.c\"]\n [sqlite3-h \"/usr/include/sqlite3.h\"])\n (if (file-exists? shim-src)\n (begin\n (when (file-exists? sqlite3-h)\n (system (format \"cp '~a' '~a/'\" sqlite3-h build-dir)))\n (run-cmd (format \"~a -c -O2 ~a -I'~a' -o '~a/jerboa-sqlite-shim.o' '~a' -Wall\"\n gcc harden-cflags build-dir build-dir shim-src)))\n (begin\n (printf \" Note: jerboa-sqlite shim not found — creating stub~n\")\n (system (format \"echo '' | ~a -c -x c -o '~a/jerboa-sqlite-shim.o' -\" gcc build-dir)))))\n\n;; Compile termbox2 TUI shim\n(run-cmd (format \"~a -c -O2 ~a -DTB_OPT_ATTR_W=32 -Ivendor/termbox2 -o '~a/jcode-tui-shim.o' src/jcode/ui/jcode_tui_shim.c -Wall\"\n gcc harden-cflags build-dir))\n\n;; Compile landlock shim from this repo.\n(let ([landlock-src \"support/landlock-shim.c\"])\n (if (file-exists? landlock-src)\n (run-cmd (format \"~a -c -O2 ~a -o '~a/landlock-shim.o' '~a' -Wall\"\n gcc harden-cflags build-dir landlock-src))\n (begin\n (printf \" Note: landlock-shim.c not found — creating stub~n\")\n (system (format \"echo '' | ~a -c -x c -o '~a/landlock-shim.o' -\" gcc build-dir)))))\n\n;; ========== Step 7: Link static binary ==========\n\n(printf \"[7/7] Linking static jcode-musl binary...~n\")\n\n(let ([link-cmd (apply musl-link-command\n \"jcode-musl\"\n (list (format \"~a/jcode_main_musl.o\" build-dir)\n (format \"~a/static_boot.o\" build-dir)\n (format \"~a/jerboa-sqlite-shim.o\" build-dir)\n (format \"~a/jcode-tui-shim.o\" build-dir)\n (format \"~a/landlock-shim.o\" build-dir))\n ;; Rust native lib includes sqlite3, TLS (rustls), regex, etc.\n (if has-native-lib?\n (list native-lib-path)\n (list \"/usr/lib/x86_64-linux-gnu/libsqlite3.a\"))\n '(no-harden: #t))])\n ;; GCC 13+ libgcc_eh.a references _dl_find_object (glibc 2.35+) which\n ;; doesn't exist in musl. Stub it out with --defsym.\n (run-cmd (string-append link-cmd\n \" -Wl,--allow-multiple-definition\"\n \" -Wl,--defsym=_dl_find_object=0\")))\n\n;; ========== Hardening: strip + integrity hash ==========\n\n(when (file-exists? \"jcode-musl\")\n (printf \"~n[harden] Stripping symbols...~n\")\n (let ([pre-size (file-length (open-file-input-port \"jcode-musl\"))])\n (run-cmd \"strip --strip-all jcode-musl\")\n (when (= 0 (system \"objcopy --strip-section-headers jcode-musl 2>/dev/null\"))\n (printf \" Section headers removed~n\"))\n (let ([post-size (file-length (open-file-input-port \"jcode-musl\"))])\n (printf \" Stripped: ~a → ~a bytes (~a% reduction)~n\"\n pre-size post-size\n (inexact->exact (round (* 100 (/ (- pre-size post-size) pre-size))))))))\n\n;; Compute SHA-256 integrity hash\n(when (file-exists? \"jcode-musl\")\n (printf \"[harden] Computing integrity hash...~n\")\n (system \"sha256sum jcode-musl | cut -d' ' -f1 | tr -d '\\\\n' > /tmp/_jcode_hash.txt\")\n (let ([hash-hex (call-with-input-file \"/tmp/_jcode_hash.txt\" get-string-all)])\n (system \"rm -f /tmp/_jcode_hash.txt\")\n (printf \" SHA-256: ~a~n\" hash-hex)\n (when (= (string-length hash-hex) 64)\n (let ([bv (make-bytevector 32)])\n (do ([i 0 (+ i 1)])\n ((= i 32))\n (bytevector-u8-set! bv i\n (string->number (substring hash-hex (* i 2) (+ (* i 2) 2)) 16)))\n (let ([port (open-file-output-port \"jcode-musl.sha256\" (file-options no-fail))])\n (put-bytevector port bv)\n (close-port port))\n (printf \" Wrote jcode-musl.sha256 (32 bytes)~n\")))))\n\n;; ========== Cleanup isolated build files ==========\n\n(printf \"~n[cleanup] Removing isolated build directory...~n\")\n(cleanup-build-dir!)\n(for-each (lambda (f)\n (when (file-exists? f) (delete-file f)))\n '(\"jcode.boot\"))\n\n;; Summary\n(printf \"~n========================================~n\")\n(printf \"Static binary created: jcode-musl~n~n\")\n(system \"ls -lh jcode-musl\")\n(printf \"~n\")\n(system \"file jcode-musl\")\n(printf \"~nTest: ./jcode-musl --help~n\")\n"} {"text":";; FILE: jerboa-code/CLAUDE.md\n# jerboa-code — Project Instructions\n\n## MANDATORY: Editing .ss Files\n\n**ALWAYS use `jerboa_balanced_replace` (MCP tool) instead of `Edit` when modifying `.ss` Scheme source files.**\n\nIt validates parenthesis balance before AND after the change, rejecting edits that break balance. This prevents the most common class of bug in this project.\n\n```\n# Workflow for every .ss edit:\n1. jerboa_balanced_replace (dry_run: true) — preview\n2. jerboa_balanced_replace (dry_run: false) — apply\n3. jerboa_check_balance — confirm file is clean\n```\n\nIf you need to add a new top-level `def`/`def`/`defstruct` form, prefer appending with `jerboa_balanced_replace` on a known anchor string rather than writing free-form code with `Edit`.\n\nAfter ALL edits to .ss files, run `jerboa_check_balance` on every modified file before attempting `make build`.\n\n## NEVER COMMIT THESE FILES\n\n**`jcode.json` contains live API keys. It is in `.gitignore`. NEVER stage or commit it.**\n\nDo not commit any file matching: `*.json` in the project root, `.env`, `*secret*`, `*key*`, `*token*` unless you have read its full contents and confirmed it has no credentials.\n\nWhen committing, always run `git diff --cached` and scan for key-shaped strings (`sk-`, `AIza`, `Bearer `) before confirming.\n\n## Build\n\n```bash\nmake build # compiles src/ → lib/ via jerbuild\nmake test # runs test/run.ss\nmake run # interactive agent REPL\n```\n\nEntry point: `main.ss`. Source lives under `src/jcode/`.\n\n## Architecture\n\n```\nsrc/jcode/\n core/ agent.ss config.ss log.ss message.ss session.ss\n provider/ provider.ss\n tool/ registry.ss file.ss bash.ss web.ss batch.ss\n ui/ cli.ss\n```\n\n## Language\n\nThis is Jerboa Scheme compiled by jerbuild. Files are `.ss`. Never write `.sls` — those are generated output in `lib/`. See `~/.claude/CLAUDE.md` for the full Jerboa language reference.\n\n## Act First, Read Less\n\nWhen making changes, read only what you need to make the edit, then make it.\nDo not read more than 3 files before acting. Do not re-read files you already\nread. Do not verify things you already know. If you have enough context to make\na change, make it. The user will interrupt you if you are wrong.\n"} {"text":";; FILE: jerboa-code/test/run.ss\n#!/usr/bin/env scheme --script\n;;; jcode test suite\n\n(import (chezscheme)\n (jcode core log)\n (jcode core agent-defs)\n (jcode tool task)\n (jcode core builtin-skills)\n (jcode core message)\n (jcode core grok-auth)\n (jcode core config)\n (jcode core escalation)\n (jcode core agent)\n (jcode core models)\n (jcode core secrets-import)\n (jcode provider provider)\n (jcode tool registry)\n (jcode tool file)\n (jcode tool bash)\n (jcode tool todo)\n (jcode tool external-llm)\n (jcode tool verified)\n (jcode guardrails nudge)\n (jcode guardrails error-tracker)\n (jcode guardrails message-type)\n (jcode guardrails rescue)\n (jcode guardrails validator)\n (jcode guardrails respond)\n (jcode guardrails guardrails)\n (jcode core errors)\n (jcode provider sampling)\n (jcode core hardware)\n (jcode core compaction)\n (jcode core compaction-strategy)\n (jcode core workflow)\n (jcode core steps)\n (jcode guardrails step-enforcer)\n (jcode core workflow-runner)\n (jcode core verified)\n (jcode core best-of-k)\n (jcode core verified-run)\n (jcode proxy convert)\n (jcode proxy handler)\n (jcode ui tui-message)\n (jcode core slot-worker)\n (jcode proxy server)\n (jcode eval scenario)\n (jcode eval ablation)\n (jcode eval runner)\n (std text json)\n (std net tcp))\n\n;; ── Helpers ──────────────────────────────────────────────────────\n\n(define pass-count 0)\n(define fail-count 0)\n\n(define (check! desc result expected)\n (if (equal? result expected)\n (begin (set! pass-count (+ pass-count 1))\n (printf \" PASS: ~a~n\" desc))\n (begin (set! fail-count (+ fail-count 1))\n (printf \" FAIL: ~a~n expected: ~s~n got: ~s~n\" desc expected result))))\n\n(define (check-pred! desc result pred)\n (if (pred result)\n (begin (set! pass-count (+ pass-count 1))\n (printf \" PASS: ~a~n\" desc))\n (begin (set! fail-count (+ fail-count 1))\n (printf \" FAIL: ~a~n got: ~s~n\" desc result))))\n\n(define (section name) (printf \"~n~a~n\" name))\n\n;; Build an args hashtable from flat key/value pairs\n(define (args . pairs)\n (let ([h (make-hashtable equal-hash equal?)])\n (let loop ([p pairs])\n (unless (null? p)\n (hashtable-set! h (car p) (cadr p))\n (loop (cddr p))))\n h))\n\n(define (str-contains? s needle)\n (let ([slen (string-length s)] [nlen (string-length needle)])\n (let loop ([i 0])\n (cond [(> (+ i nlen) slen) #f]\n [(string=? (substring s i (+ i nlen)) needle) #t]\n [else (loop (+ i 1))]))))\n\n(define (str-prefix? p s)\n (and (>= (string-length s) (string-length p))\n (string=? (substring s 0 (string-length p)) p)))\n\n(define (string-trim-right s)\n (let loop ([i (string-length s)])\n (if (and (> i 0) (char-whitespace? (string-ref s (- i 1))))\n (loop (- i 1))\n (substring s 0 i))))\n\n(define (condition->string thunk)\n (guard (e [(condition? e)\n (with-output-to-string (lambda () (display-condition e)))])\n (call-with-values thunk (lambda vals #f))))\n\n(define (msg-block-plain-text m)\n (apply string-append\n (map (lambda (line)\n (apply string-append (map car line)))\n (msg-block-lines m))))\n\n(define (read-test-http-request in)\n (let header-loop ([content-length 0])\n (let ([line (get-line in)])\n (cond\n [(eof-object? line) (void)]\n [(or (string=? line \"\") (string=? line \"\\r\"))\n (let ([body (open-output-string)])\n (let drain ([remaining content-length])\n (when (> remaining 0)\n (let ([c (read-char in)])\n (unless (eof-object? c)\n (write-char c body)\n (drain (- remaining 1))))))\n (get-output-string body))]\n [else\n (let ([clean (string-trim-right line)])\n (header-loop\n (if (str-prefix? \"Content-Length: \" clean)\n (or (string->number\n (substring clean (string-length \"Content-Length: \")\n (string-length clean)))\n content-length)\n content-length)))]))))\n\n(define (serve-one-chunked-500! srv body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (read-test-http-request in)\n (let ([chunk-size (number->string (string-length body) 16)])\n (put-string out\n (string-append\n \"HTTP/1.1 500 Internal Server Error\\r\\n\"\n \"Content-Type: application/json\\r\\n\"\n \"Transfer-Encoding: chunked\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n chunk-size \"\\r\\n\"\n body \"\\r\\n\"\n \"0\\r\\n\"\n \"\\r\\n\"))\n (flush-output-port out)))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n(define (serve-one-captured-sse! srv captured-body body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (vector-set! captured-body 0 (read-test-http-request in))\n (put-string out\n (string-append\n \"HTTP/1.1 200 OK\\r\\n\"\n \"Content-Type: text/event-stream\\r\\n\"\n \"Content-Length: \" (number->string (string-length body)) \"\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n body))\n (flush-output-port out))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n(define (serve-one-captured-json! srv captured-body status body)\n (fork-thread\n (lambda ()\n (let-values ([(in out) (tcp-accept srv)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (vector-set! captured-body 0 (read-test-http-request in))\n (put-string out\n (string-append\n \"HTTP/1.1 \" (number->string status) \" OK\\r\\n\"\n \"Content-Type: application/json\\r\\n\"\n \"Content-Length: \" (number->string (string-length body)) \"\\r\\n\"\n \"Connection: close\\r\\n\"\n \"\\r\\n\"\n body))\n (flush-output-port out))\n (lambda ()\n (close-port out)\n (close-port in)))))))\n\n;; ── Setup ─────────────────────────────────────────────────────────\n\n(current-log-level 'warn)\n(init-file-tools)\n(init-bash-tool)\n(init-todo-tool)\n\n;; ── Message tests ─────────────────────────────────────────────────\n\n(section \"=== message ===\")\n\n(let ([m (make-user-message \"hello\")])\n (check! \"user role\" (message-role m) \"user\")\n (check! \"user content\" (message-content m) \"hello\")\n (check! \"user no tcs\" (message-tool-calls m) #f))\n\n(let ([m (make-assistant-message \"hi\")])\n (check! \"assistant role\" (message-role m) \"assistant\")\n (check! \"assistant content\" (message-content m) \"hi\"))\n\n(let* ([tc (make-tool-call \"read\" \"{\\\"path\\\":\\\"foo\\\"}\")]\n [m (make-assistant-message #f (list tc))]\n [j (message->json m)])\n (check! \"assistant tool-call json content\" (hashtable-ref j \"content\" #f) \"\")\n (check-pred! \"assistant tool-call json tcs\" (hashtable-ref j \"tool_calls\" #f) pair?))\n\n(let* ([tc-empty (make-tool-call \"verify\" '())]\n [tc-assoc (make-tool-call \"edit\" '((\"path\" . \"x.ss\") (\"content\" . \"body\")))]\n [m (make-assistant-message #f (list tc-empty tc-assoc))]\n [j (message->json m)]\n [tcs (hashtable-ref j \"tool_calls\" #f)]\n [empty-fn (hashtable-ref (car tcs) \"function\" #f)]\n [assoc-fn (hashtable-ref (cadr tcs) \"function\" #f)]\n [assoc-args (string->json-object (hashtable-ref assoc-fn \"arguments\" \"\"))])\n (check! \"assistant tool-call empty args object\"\n (hashtable-ref empty-fn \"arguments\" #f) \"{}\")\n (check! \"assistant tool-call assoc args path\"\n (hashtable-ref assoc-args \"path\" #f) \"x.ss\")\n (check! \"assistant tool-call assoc args content\"\n (hashtable-ref assoc-args \"content\" #f) \"body\"))\n\n(let ([tc (make-tool-call \"read\" \"{\\\"path\\\":\\\"foo\\\"}\")])\n (check! \"tool-call name\" (tool-call-name tc) \"read\")\n (check! \"tool-call args\" (tool-call-arguments tc) \"{\\\"path\\\":\\\"foo\\\"}\")\n (check-pred! \"tool-call id non-empty\" (tool-call-id tc)\n (lambda (s) (> (string-length s) 0))))\n\n(let ([tc (restore-tool-call \"my-id\" \"bash\" \"{}\")])\n (check! \"restore-tool-call id\" (tool-call-id tc) \"my-id\"))\n\n(let ([m (make-tool-result \"call-123\" \"result\")])\n (check! \"tool-result role\" (message-role m) \"tool\")\n (check! \"tool-result content\" (message-content m) \"result\")\n (check! \"tool-result call-id\" (message-tool-call-id m) \"call-123\"))\n\n;; ── File tool tests ───────────────────────────────────────────────\n\n(section \"=== file tools ===\")\n\n;; write + read round-trip\n(let* ([tmp \"/tmp/jcode-test-write.txt\"]\n [data \"hello\\nworld\\n\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" data))]\n [r (tool-execute \"read\" (args \"path\" tmp))])\n (check! \"write+read round-trip\" r data))\n\n;; read missing file\n(let ([r (tool-execute \"read\" (args \"path\" \"/tmp/jcode-no-such-file-xyz-abc\"))])\n (check-pred! \"read missing returns error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; edit\n(let* ([tmp \"/tmp/jcode-test-edit.txt\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" \"foo bar baz\"))]\n [_ (tool-execute \"edit\" (args \"path\" tmp \"old_str\" \"bar\" \"new_str\" \"QUX\"))]\n [r (tool-execute \"read\" (args \"path\" tmp))])\n (check! \"edit replaces string\" r \"foo QUX baz\"))\n\n;; edit missing string\n(let* ([tmp \"/tmp/jcode-test-edit2.txt\"]\n [_ (tool-execute \"write\" (args \"path\" tmp \"content\" \"abc\"))]\n [r (tool-execute \"edit\" (args \"path\" tmp \"old_str\" \"zzz\" \"new_str\" \"q\"))])\n (check-pred! \"edit missing string returns error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; generated artifact guard is workspace-aware\n(let ([root (format \"/tmp/jcode-artifact-generated-~a\" (random 100000000))])\n (mkdir root)\n (parameterize ([current-directory root])\n (tool-execute \"write\" (args \"path\" \"src/pkg/foo.ss\" \"content\" \"source\"))\n (let ([r (tool-execute \"write\" (args \"path\" \"lib/pkg/foo.sls\" \"content\" \"generated\"))])\n (check-pred! \"generated .sls with src counterpart refused\" r\n (lambda (s) (and (str-prefix? \"Error:\" s)\n (str-contains? s \"src/pkg/foo.ss\")))))))\n\n(let ([root (format \"/tmp/jcode-artifact-source-~a\" (random 100000000))])\n (mkdir root)\n (parameterize ([current-directory root])\n (let ([r (tool-execute \"write\" (args \"path\" \"lib/pkg/foo.sls\" \"content\" \"source-sls\"))])\n (check-pred! \"source .sls without src counterpart allowed\" r\n (lambda (s) (str-prefix? \"Successfully wrote\" s))))\n (check! \"source .sls write persisted\"\n (tool-execute \"read\" (args \"path\" \"lib/pkg/foo.sls\"))\n \"source-sls\")))\n\n;; glob\n(let ([r (tool-execute \"glob\" (args \"pattern\" \"*.ss\" \"path\" (current-directory)))])\n (check-pred! \"glob finds root .ss files\" r\n (lambda (s) (str-contains? s \"main.ss\"))))\n\n(let ([r (tool-execute \"glob\" (args \"pattern\" \"**/*.ss\" \"path\" (current-directory)))])\n (check-pred! \"glob finds src .ss files\" r\n (lambda (s) (str-contains? s \".ss\"))))\n\n;; ls\n(let ([r (tool-execute \"ls\" (args \"path\" \".\"))])\n (check-pred! \"ls lists src dir\" r (lambda (s) (str-contains? s \"src\")))\n (check-pred! \"ls marks dirs with /\" r (lambda (s) (str-contains? s \"src/\"))))\n\n(let ([r (tool-execute \"ls\" (args \"path\" \"/tmp/no-such-dir-xyz\"))])\n (check-pred! \"ls missing dir error\" r (lambda (s) (str-prefix? \"Error:\" s))))\n\n;; grep\n(let ([r (tool-execute \"grep\" (args \"pattern\" \"cli-main\"\n \"path\" \"src/jcode/ui/cli.ss\"))])\n (check-pred! \"grep finds pattern\" r (lambda (s) (str-contains? s \"cli-main\"))))\n\n(let ([r (tool-execute \"grep\" (args \"pattern\" \"zzz_not_found_zzz\"\n \"path\" \"src/jcode/ui/cli.ss\"))])\n (check! \"grep no match\" r \"No matches found\"))\n\n;; ── Bash tool tests ───────────────────────────────────────────────\n\n(section \"=== bash tool ===\")\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"echo hello\"))])\n (check! \"bash echo\" (string-trim-right r) \"hello\"))\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"echo -n abc && echo def\"))])\n (check-pred! \"bash multi-cmd\" r (lambda (s) (str-contains? s \"abc\"))))\n\n(let ([r (tool-execute \"bash\" (args \"command\" \"exit 42\"))])\n (check-pred! \"bash non-zero exit shown\" r (lambda (s) (str-contains? s \"Exit code\"))))\n\n(let* ([todo1 (args \"content\" \"Inspect sidebar\" \"status\" \"completed\")]\n [todo2 (args \"content\" \"Wire todo list\" \"status\" \"in_progress\")]\n [r (tool-execute \"todowrite\" (args \"todos\" (list todo1 todo2)))])\n (check-pred! \"todowrite progress summary\"\n r\n (lambda (s) (str-contains? s \"1 of 2 complete\"))))\n\n;; ── TUI rendering ─────────────────────────────────────────────────\n\n(section \"=== tui rendering ===\")\n\n(let* ([esc (integer->char #x1b)]\n [colored (string-append \"Error: \"\n (string esc) \"[91m\"\n (string esc) \"[1mboom\"\n (string esc) \"[0m ok\")]\n [m (msg-block-assistant colored)])\n (check! \"assistant strips ansi escapes\"\n (msg-block-plain-text m)\n \"Error: boom ok\"))\n\n;; ── Text-form tool call recovery ──────────────────────────────────\n;; Local Ollama-hosted GGUF models (fine-tuned Qwen/Hermes etc.) often\n;; emit tool calls as text in the content stream instead of via the\n;; structured tool_calls field. extract-text-tool-calls lifts those.\n\n(section \"=== text-form tool call recovery ===\")\n(printf \"DEBUG model-rejects-tools? = ~s~n\" model-rejects-tools?)\n(printf \"DEBUG extract-text-tool-calls = ~s~n\" extract-text-tool-calls)\n\n(define (extract-call s)\n ;; Returns (list stripped count name args) for the first recovered call.\n (call-with-values\n (lambda () (extract-text-tool-calls s))\n (lambda (stripped extras)\n (list stripped (length extras)\n (and (pair? extras) (tool-call-name (car extras)))\n (and (pair? extras) (tool-call-arguments (car extras)))))))\n\n(let ([r (extract-call\n \"Sure:\\n```json\\n{\\\"name\\\":\\\"grep\\\",\\\"arguments\\\":{\\\"pattern\\\":\\\"defstruct\\\",\\\"path\\\":\\\"src\\\"}}\\n```\\nDone.\")])\n (check! \"md-fence count\" (list-ref r 1) 1)\n (check! \"md-fence name\" (list-ref r 2) \"grep\")\n (check-pred! \"md-fence args has pattern\" (list-ref r 3)\n (lambda (s) (str-contains? s \"defstruct\"))))\n\n(let ([r (extract-call\n \"<tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call>\")])\n (check! \"qwen tag count\" (list-ref r 1) 1)\n (check! \"qwen tag name\" (list-ref r 2) \"ls\"))\n\n(let ([r (extract-call \"Just a normal answer with no tool call.\")])\n (check! \"no-match count\" (list-ref r 1) 0)\n (check! \"no-match stripped\" (list-ref r 0) \"Just a normal answer with no tool call.\"))\n\n;; A code block that *isn't* a tool call (no name+arguments) must stay put.\n(let ([r (extract-call \"```json\\n{\\\"foo\\\":1,\\\"bar\\\":2}\\n```\")])\n (check! \"non-tc fence kept\" (list-ref r 1) 0)\n (check-pred! \"non-tc fence content intact\" (list-ref r 0)\n (lambda (s) (str-contains? s \"\\\"foo\\\":1\"))))\n\n;; Multiple calls in one response, with surrounding text.\n(let ([r (call-with-values\n (lambda ()\n (extract-text-tool-calls\n (string-append\n \"First:\\n<tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call>\"\n \"\\nThen:\\n<tool_call>{\\\"name\\\":\\\"grep\\\",\\\"arguments\\\":{\\\"pattern\\\":\\\"x\\\"}}</tool_call>\")))\n list)])\n (check! \"two-call count\" (length (cadr r)) 2)\n (check! \"two-call names\"\n (map tool-call-name (cadr r))\n '(\"ls\" \"grep\")))\n\n;; recover-text-tool-calls on a message must merge into the structured list.\n(let* ([orig (make-assistant-message\n \"Reply:\\n```json\\n{\\\"name\\\":\\\"bash\\\",\\\"arguments\\\":{\\\"command\\\":\\\"ls\\\"}}\\n```\")]\n [fixed (recover-text-tool-calls orig)])\n (check-pred! \"recover: tool-calls populated\" (message-tool-calls fixed)\n (lambda (lst) (and (list? lst) (= (length lst) 1))))\n (check! \"recover: tool-call name\"\n (tool-call-name (car (message-tool-calls fixed))) \"bash\"))\n\n;; ── Guardrails: nudges ────────────────────────────────────────────\n;; Verbatim port of forge's nudge templates. Texts must be byte-for-byte\n;; identical to forge — these checks lock that down.\n\n(section \"=== guardrails: nudges ===\")\n\n(check! \"retry-nudge-text verbatim\"\n (retry-nudge-text \"anything\")\n (string-append\n \"Your previous response was not a valid tool call. \"\n \"You must respond with a tool call, not free text. \"\n \"Please try again with a valid tool call.\"))\n\n(let ([n (make-retry-nudge \"junk\")])\n (check! \"retry nudge role\" (nudge-role n) \"user\")\n (check! \"retry nudge kind\" (nudge-kind n) \"retry\")\n (check! \"retry nudge tier\" (nudge-tier n) 0))\n\n(check! \"unknown-tool-nudge-text verbatim\"\n (unknown-tool-nudge-text \"foo\" '(\"a\" \"b\"))\n \"Tool 'foo' does not exist. Available tools: a, b. Call one of them.\")\n\n(check! \"unknown-tool nudge kind\"\n (nudge-kind (make-unknown-tool-nudge \"foo\" '(\"a\" \"b\"))) \"unknown_tool\")\n\n(check! \"step-nudge tier 1 verbatim\"\n (step-nudge-text \"respond\" '(\"read\") 1)\n (string-append\n \"You cannot call respond yet. \"\n \"You must first complete these required steps: read. \"\n \"Call one of them now.\"))\n\n(check! \"step-nudge tier 2 verbatim\"\n (step-nudge-text \"respond\" '(\"read\" \"grep\") 2)\n \"You must call one of these tools now: read, grep. Pick one.\")\n\n(check! \"step-nudge tier 3 verbatim\"\n (step-nudge-text \"respond\" '(\"read\") 3)\n (string-append\n \"STOP. You MUST call one of: read. \"\n \"Do NOT call respond. \"\n \"Your next response MUST be a tool call to one of: read.\"))\n\n;; tier clamps to 1..3\n(check! \"step-nudge tier 0 clamps to 1\"\n (step-nudge-text \"respond\" '(\"read\") 0)\n (step-nudge-text \"respond\" '(\"read\") 1))\n(check! \"step-nudge tier 9 clamps to 3\"\n (step-nudge-text \"respond\" '(\"read\") 9)\n (step-nudge-text \"respond\" '(\"read\") 3))\n\n(let ([n (make-step-nudge \"respond\" '(\"read\") 2)])\n (check! \"step nudge kind\" (nudge-kind n) \"step\")\n (check! \"step nudge tier preserved\" (nudge-tier n) 2))\n\n(check! \"prerequisite-nudge-text verbatim\"\n (prerequisite-nudge-text \"write\" '(\"read\"))\n \"You cannot call write yet. You must first call: read. Call the prerequisite tool now.\")\n\n(check! \"prerequisite nudge kind\"\n (nudge-kind (make-prerequisite-nudge \"write\" '(\"read\"))) \"prerequisite\")\n\n;; ── Guardrails: error tracker ─────────────────────────────────────\n;; Exhaustion is strict `>`: a budget of N tolerates N, the (N+1)th trips it.\n\n(section \"=== guardrails: error tracker ===\")\n\n(let ([t (make-error-tracker 3 2)])\n (check! \"fresh retries 0\" (error-tracker-consecutive-retries t) 0)\n (check! \"fresh tool-errs 0\" (error-tracker-consecutive-tool-errors t) 0)\n (check! \"fresh not exhausted\" (error-tracker-retries-exhausted? t) #f)\n\n ;; 3 retries == budget, not yet exhausted (3 > 3 is false)\n (error-tracker-record-retry! t)\n (error-tracker-record-retry! t)\n (error-tracker-record-retry! t)\n (check! \"retries at budget count\" (error-tracker-consecutive-retries t) 3)\n (check! \"retries at budget ok\" (error-tracker-retries-exhausted? t) #f)\n ;; 4th trips it\n (error-tracker-record-retry! t)\n (check! \"retries over budget\" (error-tracker-retries-exhausted? t) #t)\n ;; reset clears\n (error-tracker-reset-retries! t)\n (check! \"retries reset\" (error-tracker-retries-exhausted? t) #f)\n (check! \"retries reset to 0\" (error-tracker-consecutive-retries t) 0))\n\n(let ([t (make-error-tracker 3 2)])\n ;; success never increments\n (error-tracker-record-result! t #t)\n (check! \"success no tool-err\" (error-tracker-consecutive-tool-errors t) 0)\n ;; soft errors do not count\n (error-tracker-record-result! t #f #t)\n (check! \"soft-err no count\" (error-tracker-consecutive-tool-errors t) 0)\n ;; 2 hard errors == budget, not exhausted\n (error-tracker-record-result! t #f)\n (error-tracker-record-result! t #f)\n (check! \"tool-errs at budget\" (error-tracker-consecutive-tool-errors t) 2)\n (check! \"tool-errs at budget ok\" (error-tracker-tool-errors-exhausted? t) #f)\n ;; 3rd trips it\n (error-tracker-record-result! t #f)\n (check! \"tool-errs over budget\" (error-tracker-tool-errors-exhausted? t) #t)\n ;; clean batch resets\n (error-tracker-reset-errors! t)\n (check! \"tool-errs reset\" (error-tracker-tool-errors-exhausted? t) #f))\n\n;; ── Guardrails: message types ─────────────────────────────────────\n\n(section \"=== guardrails: message types ===\")\n\n(check! \"mt system_prompt\" message-type-system-prompt \"system_prompt\")\n(check! \"mt tool_call\" message-type-tool-call \"tool_call\")\n(check! \"mt retry_nudge\" message-type-retry-nudge \"retry_nudge\")\n(check! \"mt summary\" message-type-summary \"summary\")\n(check! \"message-type? valid\" (message-type? \"tool_result\") #t)\n(check! \"message-type? invalid\" (message-type? \"bogus\") #f)\n(check! \"kind retry->retry_nudge\"\n (nudge-kind->message-type \"retry\") \"retry_nudge\")\n(check! \"kind unknown_tool->retry_nudge\"\n (nudge-kind->message-type \"unknown_tool\") \"retry_nudge\")\n(check! \"kind step->step_nudge\"\n (nudge-kind->message-type \"step\") \"step_nudge\")\n(check! \"kind prerequisite->prerequisite_nudge\"\n (nudge-kind->message-type \"prerequisite\") \"prerequisite_nudge\")\n(check! \"kind unknown->#f\"\n (nudge-kind->message-type \"wat\") #f)\n\n;; ── Guardrails: rescue ────────────────────────────────────────────\n;; Canonical 4-strategy tool-call rescue from free text. Args are stored as\n;; a JSON string (jcode convention).\n\n(section \"=== guardrails: rescue ===\")\n\n(define (rescue1 text tools)\n ;; (count . name . args) for the first recovered call\n (let ([calls (rescue-tool-call text tools)])\n (list (length calls)\n (and (pair? calls) (tool-call-name (car calls)))\n (and (pair? calls) (tool-call-arguments (car calls))))))\n\n;; strip-think-tags\n(check! \"strip <think>\"\n (strip-think-tags \"before<think>secret</think>after\") \"beforeafter\")\n(check! \"strip [THINK]\"\n (strip-think-tags \"a[THINK]x[/THINK]b\") \"ab\")\n(check! \"strip unterminated think left intact\"\n (strip-think-tags \"keep <think> this\") \"keep <think> this\")\n\n;; strategy 1: JSON (forge style + OpenAI style + fences + tags + prose)\n(let ([r (rescue1 \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{\\\"pattern\\\":\\\"x\\\"}}\" '(\"grep\"))])\n (check! \"json forge-style count\" (list-ref r 0) 1)\n (check! \"json forge-style name\" (list-ref r 1) \"grep\")\n (check-pred! \"json forge-style args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"pattern\"))))\n\n(let ([r (rescue1 \"```json\\n{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}\\n```\" '(\"ls\"))])\n (check! \"json openai+fence count\" (list-ref r 0) 1)\n (check! \"json openai+fence name\" (list-ref r 1) \"ls\"))\n\n(let ([r (rescue1 \"Sure: <tool_call>{\\\"name\\\":\\\"ls\\\",\\\"arguments\\\":{\\\"path\\\":\\\".\\\"}}</tool_call> done\" '(\"ls\"))])\n (check! \"json in <tool_call> tag\" (list-ref r 1) \"ls\"))\n\n(let ([calls (rescue-tool-call\n \"{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}} then {\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\"\n '(\"ls\" \"grep\"))])\n (check! \"json multi count\" (length calls) 2)\n (check! \"json multi names\" (map tool-call-name calls) '(\"ls\" \"grep\")))\n\n(check! \"json unknown tool → none\"\n (length (rescue-tool-call \"{\\\"tool\\\":\\\"nope\\\",\\\"args\\\":{}}\" '(\"ls\"))) 0)\n(check! \"non-tool json → none\"\n (length (rescue-tool-call \"{\\\"foo\\\":1,\\\"bar\\\":2}\" '(\"ls\"))) 0)\n\n;; think block is stripped before rescue (a call inside it is ignored)\n(let ([r (rescue1 \"<think>{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}}</think>{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\"\n '(\"ls\" \"grep\"))])\n (check! \"think-block call ignored, body wins\" (list-ref r 1) \"grep\"))\n\n;; strategy 2: rehearsal name[ARGS]{...}\n(let ([r (rescue1 \"Let me call grep[ARGS]{\\\"pattern\\\":\\\"defstruct\\\"}\" '(\"grep\"))])\n (check! \"rehearsal count\" (list-ref r 0) 1)\n (check! \"rehearsal name\" (list-ref r 1) \"grep\")\n (check-pred! \"rehearsal args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"defstruct\"))))\n\n;; strategy 3: Qwen Coder XML\n(let ([r (rescue1 \"<function=ls><parameter=path>.</parameter></function>\" '(\"ls\"))])\n (check! \"qwen-xml count\" (list-ref r 0) 1)\n (check! \"qwen-xml name\" (list-ref r 1) \"ls\")\n (check-pred! \"qwen-xml args has path\" (list-ref r 2)\n (lambda (s) (str-contains? s \"path\"))))\n\n;; Qwen newline stripping: one leading + one trailing newline removed\n(let ([r (rescue1 \"<function=write><parameter=content>\\nhello\\n</parameter></function>\" '(\"write\"))])\n (check-pred! \"qwen-xml value newline-stripped\" (list-ref r 2)\n (lambda (s) (str-contains? s \"hello\"))))\n\n;; strategy 4: Mistral [TOOL_CALLS]name{...}\n(let ([r (rescue1 \"[TOOL_CALLS]grep{\\\"pattern\\\":\\\"x\\\"}\" '(\"grep\"))])\n (check! \"mistral count\" (list-ref r 0) 1)\n (check! \"mistral name\" (list-ref r 1) \"grep\"))\n\n(let ([r (rescue1 \"[TOOL_CALLS]grep {\\\"pattern\\\":\\\"x\\\"}\" '(\"grep\"))])\n (check! \"mistral whitespace before brace\" (list-ref r 1) \"grep\"))\n\n;; string-aware brace scan: a '}' inside a JSON string must not close early\n(let ([r (rescue1 \"[TOOL_CALLS]bash{\\\"command\\\":\\\"echo }\\\"}\" '(\"bash\"))])\n (check! \"mistral string-aware count\" (list-ref r 0) 1)\n (check-pred! \"mistral string-aware args\" (list-ref r 2)\n (lambda (s) (str-contains? s \"command\"))))\n\n;; strategy ordering: JSON present → strategy 1 wins, rehearsal not double-counted\n(let ([r (rescue1 \"{\\\"tool\\\":\\\"ls\\\",\\\"args\\\":{}} and grep[ARGS]{\\\"pattern\\\":\\\"x\\\"}\"\n '(\"ls\" \"grep\"))])\n (check! \"ordering: json wins\" (list-ref r 1) \"ls\"))\n\n;; nothing parseable\n(check! \"no tool call → empty\"\n (length (rescue-tool-call \"Just a normal answer.\" '(\"ls\" \"grep\"))) 0)\n\n;; ── guardrails: validator ──────────────────────────────────────────\n(section \"=== guardrails: validator ===\")\n\n(define v (make-response-validator '(\"ls\" \"grep\") #t))\n\n;; structured valid tool calls pass through\n(let ([r (validate-response v #f (list (make-tool-call \"ls\" \"{}\")))])\n (check! \"validator valid: no retry\" (validation-result-needs-retry? r) #f)\n (check! \"validator valid: tool-calls returned\"\n (length (validation-result-tool-calls r)) 1))\n\n;; unknown tool name -> retry nudge (unknown_tool kind)\n(let ([r (validate-response v #f (list (make-tool-call \"nope\" \"{}\")))])\n (check! \"validator unknown: needs retry\" (validation-result-needs-retry? r) #t)\n (check! \"validator unknown: no tool-calls\" (validation-result-tool-calls r) #f)\n (check! \"validator unknown: nudge kind\"\n (nudge-kind (validation-result-nudge r)) \"unknown_tool\"))\n\n;; bare text that contains a rescuable call -> recovered, no retry\n(let ([r (validate-response v \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{\\\"pattern\\\":\\\"x\\\"}}\" '())])\n (check! \"validator rescue: no retry\" (validation-result-needs-retry? r) #f)\n (check! \"validator rescue: name\"\n (tool-call-name (car (validation-result-tool-calls r))) \"grep\"))\n\n;; bare prose -> retry nudge (retry kind)\n(let ([r (validate-response v \"I think the answer is 42.\" '())])\n (check! \"validator prose: needs retry\" (validation-result-needs-retry? r) #t)\n (check! \"validator prose: nudge kind\"\n (nudge-kind (validation-result-nudge r)) \"retry\"))\n\n;; rescue disabled -> a rescuable bare text still retries\n(let* ([v2 (make-response-validator '(\"grep\") #f)]\n [r (validate-response v2 \"{\\\"tool\\\":\\\"grep\\\",\\\"args\\\":{}}\" '())])\n (check! \"validator rescue-disabled: needs retry\" (validation-result-needs-retry? r) #t))\n\n;; ── guardrails: respond ────────────────────────────────────────────\n(section \"=== guardrails: respond ===\")\n\n(check! \"respond tool name\" respond-tool-name \"respond\")\n(check-pred! \"respond description non-empty\" respond-description\n (lambda (s) (> (string-length s) 0)))\n\n(let ([rc (make-tool-call \"respond\" \"{\\\"message\\\":\\\"all done\\\"}\")]\n [other (make-tool-call \"ls\" \"{}\")]\n [empty (make-tool-call \"respond\" \"{}\")])\n (check! \"respond-call? yes\" (respond-call? rc) #t)\n (check! \"respond-call? no\" (respond-call? other) #f)\n (check! \"respond-call->text extracts message\" (respond-call->text rc) \"all done\")\n (check! \"respond-call->text missing arg -> empty\" (respond-call->text empty) \"\")\n (check! \"respond-call->text on non-respond -> #f\" (respond-call->text other) #f))\n\n;; ── guardrails: facade ─────────────────────────────────────────────\n(section \"=== guardrails: facade ===\")\n\n;; execute path: valid structured calls\n(let* ([g (make-guardrails '(\"ls\" \"grep\"))]\n [cr (guardrails-check g #f (list (make-tool-call \"ls\" \"{}\")))])\n (check! \"facade execute action\" (check-result-action cr) \"execute\")\n (check! \"facade execute returns calls\"\n (length (check-result-tool-calls cr)) 1))\n\n;; retry path: unknown tool, within budget\n(let* ([g (make-guardrails '(\"ls\") 3 2 #t)]\n [cr (guardrails-check g #f (list (make-tool-call \"nope\" \"{}\")))])\n (check! \"facade retry action\" (check-result-action cr) \"retry\")\n (check-pred! \"facade retry nudge present\" (check-result-nudge cr)\n (lambda (n) (and n #t))))\n\n;; fatal path: budget 1 tolerates one bad response; the second trips it\n(let ([g (make-guardrails '(\"ls\") 1 2 #t)])\n (guardrails-check g \"prose one\" '())\n (let ([cr (guardrails-check g \"prose two\" '())])\n (check! \"facade fatal action\" (check-result-action cr) \"fatal\")\n (check-pred! \"facade fatal reason\" (check-result-reason cr)\n (lambda (s) (str-contains? s \"consecutive\")))))\n\n;; a good response resets the retry budget\n(let ([g (make-guardrails '(\"ls\") 1 2 #t)])\n (guardrails-check g \"prose\" '())\n (guardrails-check g #f (list (make-tool-call \"ls\" \"{}\")))\n (let ([cr (guardrails-check g \"prose again\" '())])\n (check! \"facade budget resets on success\" (check-result-action cr) \"retry\")))\n\n;; record: clean batch returns #f when no terminal tool configured\n(let ([g (make-guardrails '(\"ls\"))])\n (check! \"facade record no terminal\" (guardrails-record g '(\"ls\")) #f))\n\n;; record: terminal tool reached returns #t\n(let ([g (make-guardrails '(\"ls\" \"respond\") 3 2 #t '(\"respond\"))])\n (check! \"facade record terminal reached\" (guardrails-record g '(\"respond\")) #t))\n\n;; ── sampling defaults ──────────────────────────────────────────────\n(section \"=== sampling defaults ===\")\n\n;; jcode hashes are raw Chez equal? hashtables (the get-/apply- functions\n;; return them, and bodies are built the same way the `args` helper does), so\n;; inspect them with the Chez hashtable API.\n\n;; pure lookup: known model returns its card row\n(let ([row (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (check! \"sampling known: temperature\" (hashtable-ref row \"temperature\" #f) 0.6)\n (check! \"sampling known: top_p\" (hashtable-ref row \"top_p\" #f) 0.95)\n (check! \"sampling known: top_k int\" (hashtable-ref row \"top_k\" #f) 20)\n (check! \"sampling known: min_p\" (hashtable-ref row \"min_p\" #f) 0.0))\n\n;; unknown model: empty map, never raises\n(check! \"sampling unknown: empty\"\n (hashtable-size (get-sampling-defaults \"gpt-4o\")) 0)\n\n;; known? predicate\n(check! \"sampling known? yes\" (model-sampling-known? \"Qwen3-8B-Q4_K_M\") #t)\n(check! \"sampling known? no\" (model-sampling-known? \"no-such-model\") #f)\n\n;; lookup returns a fresh copy — mutating it must not corrupt the map\n(let ([r1 (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (hashtable-set! r1 \"temperature\" 99.0)\n (let ([r2 (get-sampling-defaults \"qwen3:8b-q4_K_M\")])\n (check! \"sampling fresh copy each call\"\n (and (not (eq? r1 r2)) (hashtable-ref r2 \"temperature\" #f)) 0.6)))\n\n;; nested chat_template_kwargs preserved (gpt-oss reasoning_effort)\n(let* ([row (get-sampling-defaults \"gpt-oss:120b-q4_K_M\")]\n [ctk (hashtable-ref row \"chat_template_kwargs\" #f)])\n (check! \"sampling nested top_k zero\" (hashtable-ref row \"top_k\" #f) 0)\n (check-pred! \"sampling nested ctk is hash\" ctk hashtable?)\n (check! \"sampling nested reasoning_effort\"\n (hashtable-ref ctk \"reasoning_effort\" #f) \"medium\"))\n\n;; boolean values survive in nested kwargs (nemotron enable_thinking)\n(let* ([row (get-sampling-defaults \"Nemotron-3-Nano-30B-A3B-Q4_K_M\")]\n [ctk (hashtable-ref row \"chat_template_kwargs\" #f)])\n (check! \"sampling nested boolean #t\" (hashtable-ref ctk \"enable_thinking\" #f) #t))\n\n;; 4-quadrant policy\n(check! \"sampling policy strict+known: temperature\"\n (hashtable-ref (apply-sampling-defaults \"qwen3:8b-q4_K_M\" #t) \"temperature\" #f) 0.6)\n(check! \"sampling policy nonstrict+known: empty\"\n (hashtable-size (apply-sampling-defaults \"qwen3:8b-q4_K_M\" #f)) 0)\n(check! \"sampling policy nonstrict+unknown: empty\"\n (hashtable-size (apply-sampling-defaults \"no-such-model\" #f)) 0)\n(check! \"sampling policy strict+unknown: raises\"\n (guard (e [(unsupported-model-error? e) 'raised] [#t 'other])\n (apply-sampling-defaults \"no-such-model\" #t))\n 'raised)\n(check! \"sampling policy strict+unknown: error carries model\"\n (guard (e [(unsupported-model-error? e) (unsupported-model-error-model e)] [#t #f])\n (apply-sampling-defaults \"no-such-model\" #t))\n \"no-such-model\")\n;; unsupported-model is a member of the forge-error family\n(check! \"sampling unsupported-model is a forge-error\"\n (guard (e [(forge-error? e) #t] [#t #f])\n (apply-sampling-defaults \"no-such-model\" #t))\n #t)\n\n;; body application under the session policy\n;; 'on + known: splat the card profile onto the body\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"qwen3:8b-q4_K_M\" \"mlx\"))\n (check! \"body on+known: temperature\" (hashtable-ref body \"temperature\" #f) 0.6)\n (check! \"body on+known: top_k\" (hashtable-ref body \"top_k\" #f) 20))\n\n;; 'on + unknown mlx model: mlx safety net (0.6 / 0.95 / top_k 20 / rep 1.1).\n;; Raised from the old near-greedy 0.3/1.05 net in 566e65c — see the comment on\n;; apply-sampling-to-body! for why (Qwen3 endless-repetition under greedy decode).\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"jerboa-mlx-lora\" \"mlx\"))\n (check! \"body on+unknown mlx: temp net\" (hashtable-ref body \"temperature\" #f) 0.6)\n (check! \"body on+unknown mlx: rep net\"\n (hashtable-ref body \"repetition_penalty\" #f) 1.1))\n\n;; 'on + unknown cloud model: nothing applied (no mlx net)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'on])\n (apply-sampling-to-body! body \"gpt-4o\" \"openai\"))\n (check! \"body on+unknown cloud: untouched\" (hashtable-size body) 0))\n\n;; 'off: forge card sampling not applied even for a known model (cloud\n;; provider, so the mlx safety net cannot confound the assertion)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'off])\n (apply-sampling-to-body! body \"qwen3:8b-q4_K_M\" \"openai\"))\n (check! \"body off+known: untouched\" (hashtable-size body) 0))\n\n;; the mlx LoRA safety net is policy-independent: it still fires under 'off\n;; for an mlx provider with no card row (degenerate-output guard)\n(let ([body (make-hashtable equal-hash equal?)])\n (parameterize ([forge-sampling-policy 'off])\n (apply-sampling-to-body! body \"jerboa-mlx-lora\" \"mlx\"))\n (check! \"body off+mlx: net still fires\" (hashtable-ref body \"temperature\" #f) 0.6))\n\n;; ── compaction strategies (Phase 4) ────────────────────────────────\n(section \"=== compaction strategies ===\")\n\n(check! \"effective budget small reserves overhead\" (effective-compaction-budget 3072) 572)\n(check! \"effective budget large unchanged\" (effective-compaction-budget 128000) 128000)\n(check! \"small compaction stays off for fresh prompt\"\n (should-compact?\n (list (make-system-message (make-string 1600 #\\s))\n (make-user-message \"find bugs\"))\n \"/Users/user/models/qwen3-coder-next-mlx\")\n #f)\n(check! \"small compaction triggers after one bulky tool result\"\n (should-compact?\n (list (make-system-message (make-string 1600 #\\s))\n (make-user-message \"find bugs\")\n (make-assistant-message \"\" (list (make-tool-call \"read\" \"{}\")))\n (make-tool-result \"read-1\" (make-string 768 #\\r)))\n \"/Users/user/models/qwen3-coder-next-mlx\")\n #t)\n\n(define (asst-tc content)\n (make-assistant-message content (list (make-tool-call \"read\" \"{}\"))))\n\n;; Type derivation from message shape\n(check! \"type: system\" (message-derived-type (make-system-message \"s\")) message-type-system-prompt)\n(check! \"type: user\" (message-derived-type (make-user-message \"q\")) message-type-user-input)\n(check! \"type: tool\" (message-derived-type (make-tool-result \"id\" \"r\")) message-type-tool-result)\n(check! \"type: tool_call\" (message-derived-type (asst-tc \"\")) message-type-tool-call)\n(check! \"type: text_response\" (message-derived-type (make-assistant-message \"hi\")) message-type-text-response)\n(let ([m (make-assistant-message \"\")])\n (message-thinking-set! m \"pondering\")\n (check! \"type: reasoning (thinking+empty content)\" (message-derived-type m) message-type-reasoning))\n\n;; estimate = message content plus tool-call bytes, divided by 4\n(check! \"estimate-tokens content/4\"\n (strategy-estimate-tokens (list (make-user-message (make-string 400 #\\x)))) 100)\n\n;; A 7-message history: sys,user,(tc,result)x2,final\n(define hist1\n (list (make-system-message \"sys\") (make-user-message \"q\")\n (asst-tc \"a1\") (make-tool-result \"id1\" \"r1\")\n (asst-tc \"a2\") (make-tool-result \"id2\" \"r2\")\n (make-assistant-message \"final\")))\n(check! \"step indices\" (derive-step-indices hist1) (list #f #f 1 1 2 2 3))\n(check! \"eligible-end keep=3 (nothing eligible)\" (find-eligible-end hist1 3) 2)\n(check! \"eligible-end keep=2\" (find-eligible-end hist1 2) 4)\n(check! \"eligible-end keep=1\" (find-eligible-end hist1 1) 6)\n\n;; NoCompact: always passthrough, phase 0\n(let* ([s (make-no-compact)] [r (s hist1 1000)])\n (check! \"no-compact phase 0\" (cdr r) 0)\n (check! \"no-compact length unchanged\" (length (car r)) 7))\n\n;; A big history for sliding/tiered: 11 msgs, 5 token-bearing (1000 chars each)\n;; indices: 0 sys 1 user | 2 tc 3 tool(1000) 4 text(1000) 5 tc 6 tool(1000)\n;; 7 text(1000) 8 tc 9 tool(1000) 10 final(\"final\")\n(define hist-tier\n (list (make-system-message \"\") (make-user-message \"\")\n (asst-tc \"\") (make-tool-result \"t1\" (make-string 1000 #\\T))\n (make-assistant-message (make-string 1000 #\\X))\n (asst-tc \"\") (make-tool-result \"t2\" (make-string 1000 #\\T))\n (make-assistant-message (make-string 1000 #\\X))\n (asst-tc \"\") (make-tool-result \"t3\" (make-string 1000 #\\T))\n (make-assistant-message \"final\")))\n(check! \"tier step indices\" (derive-step-indices hist-tier) (list #f #f 1 1 2 3 3 4 5 5 6))\n(check! \"tier eligible-end keep=1\" (find-eligible-end hist-tier 1) 10)\n;; original estimate includes three tool-call overheads: (5005 + 90)//4 = 1273\n(check! \"tier original estimate\" (strategy-estimate-tokens hist-tier) 1273)\n\n;; SlidingWindow keep=1: below threshold → phase 0; above → keep head+protected tail\n(let* ([s (make-sliding-window 1 0.75)] [r (s hist-tier 10000)])\n (check! \"sliding below threshold phase 0\" (cdr r) 0))\n(let* ([s (make-sliding-window 1 0.75)] [r (s hist-tier 400)])\n (check! \"sliding fires phase 1\" (cdr r) 1)\n (check! \"sliding keeps sys+user+protected\" (length (car r)) 3)\n (check! \"sliding head is system\" (message-role (car (car r))) \"system\"))\n(let ([r (run-configured-compaction hist-tier 572)])\n (check! \"configured small budget uses sliding\" (length r) 5))\n\n;; Tiered phase transitions (keep=1, uniform 0.75 threshold).\n;; budgets: 4000→t3000 (p0), 1200→t900 (p1), 800→t600 (p2), 600→t450 (p3)\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 4000)])\n (check! \"tiered below all thresholds phase 0\" (cdr r) 0)\n (check! \"tiered phase 0 length unchanged\" (length (car r)) 11))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 1200)])\n (check! \"tiered phase 1\" (cdr r) 1)\n (check! \"tiered phase 1 keeps all msgs (truncate only)\" (length (car r)) 11)\n (check-pred! \"tiered phase 1 truncated a tool result\"\n (message-content (list-ref (car r) 3)) (lambda (c) (str-contains? c \"[Truncated\"))))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 800)])\n (check! \"tiered phase 2\" (cdr r) 2)\n (check! \"tiered phase 2 drops 3 tool results\" (length (car r)) 8))\n(let* ([s (make-tiered 1 0.75 #f)] [r (s hist-tier 600)])\n (check! \"tiered phase 3\" (cdr r) 3)\n (check! \"tiered phase 3 keeps only skeleton\" (length (car r)) 6)\n (check! \"tiered phase 3 preserves system\" (message-role (car (car r))) \"system\")\n (check! \"tiered phase 3 preserves protected tail\"\n (message-content (list-ref (car r) 5)) \"final\"))\n\n;; JcodeLegacy: still a valid strategy (wraps compact-messages)\n(let* ([s (make-jcode-legacy)] [r (s hist1 1000)])\n (check-pred! \"legacy returns a list\" (car r) list?)\n (check! \"legacy phase 1\" (cdr r) 1))\n\n;; Dispatcher default is tiered\n(check! \"default strategy name\" (configured-compaction-strategy-name) \"tiered\")\n(check-pred! \"by-name tiered is callable\" (compaction-strategy-by-name \"tiered\" 2 0.75) procedure?)\n(check-pred! \"by-name none is callable\" (compaction-strategy-by-name \"none\" 2 0.75) procedure?)\n\n;; ── hardware / VRAM tiers (Phase 4) ─────────────────────────────────\n(section \"=== hardware VRAM tiers ===\")\n\n(check! \"tier #f → 4096\" (vram-tier-budget-for-gb #f) 4096)\n(check! \"tier 12 → 4096\" (vram-tier-budget-for-gb 12.0) 4096)\n(check! \"tier 23.9 → 4096\" (vram-tier-budget-for-gb 23.9) 4096)\n(check! \"tier 24 → 32768\" (vram-tier-budget-for-gb 24.0) 32768)\n(check! \"tier 30 → 32768\" (vram-tier-budget-for-gb 30.0) 32768)\n(check! \"tier 48 → 262144\" (vram-tier-budget-for-gb 48.0) 262144)\n(check! \"tier 80 → 262144\" (vram-tier-budget-for-gb 80.0) 262144)\n\n(let ([p (make-hardware-profile \"Test GPU\" 24576 \"nvidia\" \"discrete\")])\n (check! \"profile vram gb\" (hardware-profile-vram-total-gb p) 24.0)\n (check! \"profile gpu name\" (hardware-profile-gpu-name p) \"Test GPU\")\n (check! \"profile → 32768 tier\"\n (vram-tier-budget-for-gb (hardware-profile-vram-total-gb p)) 32768))\n\n(check! \"quant bpw Q4_K_M\" (quant-bpw-ref \"Q4_K_M\") 4.83)\n(check! \"quant bpw F16\" (quant-bpw-ref \"F16\") 16.0)\n(check! \"quant bpw unknown → #f\" (quant-bpw-ref \"nope\") #f)\n\n;; Live probe: must not crash; returns #f or a profile, budget an int ≥ 4096.\n(parameterize ([current-log-level 'error])\n (check-pred! \"detect-hardware: #f or profile\"\n (detect-hardware) (lambda (x) (or (not x) (hardware-profile? x))))\n (check-pred! \"vram-tier-budget: int ≥ 4096\"\n (vram-tier-budget) (lambda (x) (and (integer? x) (>= x 4096)))))\n\n;; ── Workflow / steps / step-enforcer / runner (Phase 5) ───────────\n\n(define (raises? thunk) (guard (e [#t #t]) (thunk) #f))\n(define (raises-pred? thunk pred) (guard (e [(pred e) #t] [#t #f]) (thunk) #f))\n\n(define (scripted-responder responses)\n (let ([i 0] [v (list->vector responses)])\n (lambda (messages tool-specs step)\n (let ([r (if (< i (vector-length v)) (vector-ref v i)\n (make-text-response \"exhausted\"))])\n (set! i (+ i 1)) r))))\n\n;; search (required) → answer (terminal, prereq search). lookup is optional.\n(define (mk-research-wf)\n (make-workflow \"research\" \"Search then answer.\"\n (list\n (make-tool-def (make-tool-spec \"search\" \"s\" '((\"type\" . \"object\"))) (lambda (a) \"search results\") '())\n (make-tool-def (make-tool-spec \"lookup\" \"l\" '((\"type\" . \"object\"))) (lambda (a) \"looked\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\"))) (lambda (a) \"ANSWER delivered\") '(\"search\")))\n '(\"search\") \"answer\" \"You are an agent. {extra}\"))\n\n;; write requires read; finish terminal; no required steps.\n(define (mk-prereq-wf)\n (make-workflow \"prq\" \"Read then write.\"\n (list\n (make-tool-def (make-tool-spec \"read\" \"r\" '((\"type\" . \"object\"))) (lambda (a) \"read-ok\") '())\n (make-tool-def (make-tool-spec \"write\" \"w\" '((\"type\" . \"object\"))) (lambda (a) \"wrote\") '(\"read\"))\n (make-tool-def (make-tool-spec \"finish\" \"f\" '((\"type\" . \"object\"))) (lambda (a) \"FINISHED\") '()))\n '() \"finish\" \"p\"))\n\n(section \"=== workflow construction ===\")\n(let ([w (mk-research-wf)])\n (check! \"tool names\" (workflow-tool-names w) '(\"search\" \"lookup\" \"answer\"))\n (check! \"required steps\" (workflow-required-steps w) '(\"search\"))\n (check! \"terminal tools\" (workflow-terminal-tools w) '(\"answer\"))\n (check! \"terminal? answer\" (workflow-terminal-tool? w \"answer\") #t)\n (check! \"terminal? search\" (workflow-terminal-tool? w \"search\") #f)\n (check! \"get-tool-def name\" (tool-def-name (workflow-get-tool-def w \"answer\")) \"answer\")\n (check! \"get-callable runs\" ((workflow-get-callable w \"search\") '()) \"search results\")\n (check! \"tool-specs count\" (length (workflow-get-tool-specs w)) 3)\n (check! \"tool-prerequisites\" (workflow-tool-prerequisites w) '((\"answer\" . (\"search\"))))\n (check-pred! \"build-system-prompt subst\"\n (workflow-build-system-prompt w '((\"extra\" . \"Be terse.\")))\n (lambda (s) (str-contains? s \"Be terse.\")))\n (check! \"prereq-name string\" (prerequisite-name \"search\") \"search\")\n (check! \"prereq-name pair\" (prerequisite-name (cons \"open\" \"file\")) \"open\"))\n\n(let ([sp (tool-spec-from-json-schema \"n\" \"d\" '((\"type\" . \"object\")))])\n (check! \"tool-spec name\" (tool-spec-name sp) \"n\")\n (check! \"tool-spec schema round-trip\" (tool-spec-get-json-schema sp) '((\"type\" . \"object\"))))\n\n(section \"=== workflow validation ===\")\n(define (mk-bad tools req term) (lambda () (make-workflow \"x\" \"d\" tools req term \"p\")))\n(check! \"dup tool name raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '())\n (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '() \"a\")) #t)\n(check! \"required ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '(\"nope\") \"a\")) #t)\n(check! \"terminal ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '() \"zzz\")) #t)\n(check! \"terminal also required raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '()))\n '(\"a\") \"a\")) #t)\n(check! \"prereq ∉ tools raises\"\n (raises? (mk-bad (list (make-tool-def (make-tool-spec \"a\" \"\" '()) (lambda (x) 1) '(\"ghost\")))\n '() \"a\")) #t)\n\n(section \"=== step tracker ===\")\n(let ([t (make-step-tracker '(\"a\" \"b\"))])\n (check! \"fresh not satisfied\" (step-tracker-satisfied? t) #f)\n (check! \"fresh pending\" (step-tracker-pending t) '(\"a\" \"b\"))\n (check! \"fresh hint\" (step-tracker-summary-hint t) \"[No steps completed yet]\")\n (step-tracker-record! t \"a\" '())\n (check! \"after a not satisfied\" (step-tracker-satisfied? t) #f)\n (check! \"after a pending\" (step-tracker-pending t) '(\"b\"))\n (step-tracker-record! t \"b\" '())\n (check! \"after b satisfied\" (step-tracker-satisfied? t) #t)\n (check! \"after b pending\" (step-tracker-pending t) '())\n (step-tracker-record! t \"a\" '())\n (check! \"record dedups completed\" (step-tracker-completed t) '(\"a\" \"b\"))\n (check! \"hint lists completed\" (step-tracker-summary-hint t) \"[Steps completed: a, b]\"))\n\n;; name-only prereq\n(let ([t (make-step-tracker '())])\n (step-tracker-record! t \"x\" '())\n (check! \"name-only satisfied\"\n (prerequisite-check-satisfied (step-tracker-check-prerequisites t \"y\" '() '(\"x\"))) #t)\n (check! \"name-only missing\"\n (prerequisite-check-missing (step-tracker-check-prerequisites t \"y\" '() '(\"z\"))) '(\"z\")))\n\n;; arg-matched prereq\n(let ([t (make-step-tracker '())])\n (step-tracker-record! t \"open\" '((\"file\" . \"a.txt\")))\n (check! \"arg-match satisfied\"\n (prerequisite-check-satisfied\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"a.txt\")) (list (cons \"open\" \"file\")))) #t)\n (check! \"arg-match mismatch missing\"\n (prerequisite-check-missing\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"b.txt\")) (list (cons \"open\" \"file\")))) '(\"open\"))\n (check! \"arg-match tool-never-called missing\"\n (prerequisite-check-missing\n (step-tracker-check-prerequisites t \"edit\" '((\"file\" . \"a.txt\")) (list (cons \"save\" \"file\")))) '(\"save\")))\n\n(section \"=== step enforcer ===\")\n(let ([e (make-step-enforcer '(\"search\") '(\"answer\") '((\"answer\" . (\"search\"))))])\n (check! \"non-terminal batch ok\"\n (step-check-needs-nudge (step-enforcer-check e (list (make-wtool-call \"search\" '() #f)))) #f)\n (let ([sc (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))])\n (check! \"premature terminal nudged\" (step-check-needs-nudge sc) #t)\n (check! \"premature nudge kind\" (nudge-kind (step-check-nudge sc)) \"step\")\n (check! \"premature tier 1\" (nudge-tier (step-check-nudge sc)) 1))\n (check! \"premature attempts=1\" (step-enforcer-premature-attempts e) 1)\n (check! \"not exhausted at 1\" (step-enforcer-premature-exhausted? e) #f)\n (step-enforcer-record! e \"search\" '())\n (check! \"satisfied after search\" (step-enforcer-satisfied? e) #t)\n (check! \"terminal not nudged once satisfied\"\n (step-check-needs-nudge (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))) #f)\n (check! \"terminal-reached? true\"\n (step-enforcer-terminal-reached? e (list (make-wtool-call \"answer\" '() #f))) #t)\n (step-enforcer-reset-premature! e)\n (check! \"reset zeroes premature\" (step-enforcer-premature-attempts e) 0))\n\n;; premature exhaustion: max-premature default 3, exhausted at attempt 4 (>3)\n(let ([e (make-step-enforcer '(\"search\") '(\"answer\") '())])\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (check! \"3 premature not exhausted\" (step-enforcer-premature-exhausted? e) #f)\n (step-enforcer-check e (list (make-wtool-call \"answer\" '() #f)))\n (check! \"4 premature exhausted\" (step-enforcer-premature-exhausted? e) #t))\n\n;; prerequisites via enforcer\n(let ([e (make-step-enforcer '() '(\"finish\") '((\"write\" . (\"read\"))))])\n (let ([sc (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))])\n (check! \"prereq violation nudged\" (step-check-needs-nudge sc) #t)\n (check! \"prereq nudge kind\" (nudge-kind (step-check-nudge sc)) \"prerequisite\"))\n (check! \"prereq violations=1\" (step-enforcer-prereq-violations e) 1)\n (step-enforcer-record! e \"read\" '())\n (check! \"prereq ok after read\"\n (step-check-needs-nudge (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))) #f))\n\n(let ([e (make-step-enforcer '() '(\"finish\") '((\"write\" . (\"read\"))))])\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (check! \"2 prereq violations not exhausted\" (step-enforcer-prereq-exhausted? e) #f)\n (step-enforcer-check-prerequisites e (list (make-wtool-call \"write\" '() #f)))\n (check! \"3 prereq violations exhausted\" (step-enforcer-prereq-exhausted? e) #t))\n\n(section \"=== workflow runner ===\")\n;; happy path: search then answer → terminal value\n(let* ([w (mk-research-wf)]\n [msgs '()]\n [resp (scripted-responder\n (list (list (make-wtool-call \"search\" '((\"q\" . \"j\")) \"search first\"))\n (list (make-wtool-call \"answer\" '((\"text\" . \"done\")) \"now answer\"))))]\n [result (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6)\n (cons 'on-message (lambda (m) (set! msgs (cons m msgs))))))])\n (check! \"happy terminal value\" result \"ANSWER delivered\")\n (let ([ordered (reverse msgs)])\n (check! \"first msg system\" (message-role (car ordered)) \"system\")\n (check! \"second msg user\" (message-role (cadr ordered)) \"user\")\n (check-pred! \"emitted ≥ 6 messages\" (length ordered) (lambda (n) (>= n 6)))))\n\n;; text response consumes an iteration, then tools proceed\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (list (make-text-response \"thinking out loud\")\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"text-then-tools reaches terminal\" result \"ANSWER delivered\"))\n\n;; premature terminal recovered (not exhausted): answer, then search, then answer\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"answer\" '() #f))\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"premature recovered → terminal\" result \"ANSWER delivered\"))\n\n;; StepEnforcementError when premature exhausted\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder\n (make-list 6 (list (make-wtool-call \"answer\" '() #f))))])\n (check! \"premature exhausted raises StepEnforcementError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n step-enforcement-error?) #t))\n\n;; prereq happy: read, write, finish\n(let* ([w (mk-prereq-wf)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"read\" '() #f))\n (list (make-wtool-call \"write\" '() #f))\n (list (make-wtool-call \"finish\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)))])\n (check! \"prereq happy → FINISHED\" result \"FINISHED\"))\n\n;; PrerequisiteError when prereq violations exhausted (write without read)\n(let* ([w (mk-prereq-wf)]\n [resp (scripted-responder (make-list 5 (list (make-wtool-call \"write\" '() #f))))])\n (check! \"prereq exhausted raises PrerequisiteError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n prerequisite-error?) #t))\n\n;; MaxIterationsError: all text, never a tool\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder (make-list 5 (make-text-response \"no tools here\")))])\n (check! \"max iterations raises MaxIterationsError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 3))))\n max-iterations-error?) #t))\n\n;; ToolExecutionError: a tool that always raises, error budget exhausted\n(let* ([w (make-workflow \"err\" \"d\"\n (list (make-tool-def (make-tool-spec \"boom\" \"b\" '()) (lambda (a) (error 'boom \"kaboom\")) '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '()) (lambda (a) \"OK\") '()))\n '() \"answer\" \"p\")]\n [resp (scripted-responder (make-list 5 (list (make-wtool-call \"boom\" '() #f))))])\n (check! \"tool errors exhausted raises ToolExecutionError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 10))))\n tool-execution-error?) #t))\n\n;; ToolResolutionError is privileged: no error-budget hit, model retries to success\n(let* ([calls 0]\n [w (make-workflow \"res\" \"d\"\n (list (make-tool-def (make-tool-spec \"answer\" \"a\" '())\n (lambda (a) (set! calls (+ calls 1))\n (if (= calls 1) (raise-tool-resolution-error \"no data\" \"answer\") \"RESOLVED-OK\"))\n '()))\n '() \"answer\" \"p\")]\n [resp (scripted-responder\n (list (list (make-wtool-call \"answer\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 6)\n (cons 'max-tool-errors 1)))])\n (check! \"resolution-error privileged → eventual success\" result \"RESOLVED-OK\")\n (check! \"resolution retried exactly twice\" calls 2))\n\n;; Unknown workflow tools are surfaced as privileged ToolResolutionError\n;; results so local models can recover instead of crashing the runner.\n(let* ([w (mk-research-wf)]\n [tool-results '()]\n [resp (scripted-responder\n (list (list (make-wtool-call \"run\" '((\"command\" . \"ls\")) #f))\n (list (make-wtool-call \"search\" '() #f))\n (list (make-wtool-call \"answer\" '() #f))))]\n [result (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6)\n (cons 'max-tool-errors 0)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results)))))))])\n (check! \"unknown workflow tool recovers → terminal\" result \"ANSWER delivered\")\n (check-pred! \"unknown workflow tool emits resolution result\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"[ToolResolutionError] Unknown tool 'run'\")))))\n\n;; cancellation\n(let* ([w (mk-research-wf)]\n [resp (scripted-responder (list (list (make-wtool-call \"search\" '() #f))))])\n (check! \"cancel? thunk raises WorkflowCancelledError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'cancel? (lambda () #t)))))\n workflow-cancelled-error?) #t))\n\n;; ════════════════════════════════════════════════════════════════\n;; Phase 6 — OpenAI-compatible proxy (convert / handler / slot-worker /\n;; dispatch). Bodies are built from JSON-string literals via\n;; string->json-object so the representation matches a real request.\n;; ════════════════════════════════════════════════════════════════\n\n(define (p6-choice0 c) (car (hashtable-ref c \"choices\" '())))\n(define (p6-finish c) (hashtable-ref (p6-choice0 c) \"finish_reason\" #f))\n(define (p6-msg c) (hashtable-ref (p6-choice0 c) \"message\" #f))\n(define (p6-content c) (hashtable-ref (p6-msg c) \"content\" #f))\n(define (p6-tcs c) (hashtable-ref (p6-msg c) \"tool_calls\" #f))\n(define (p6-last xs) (list-ref xs (- (length xs) 1)))\n(define (p6-chunk-finish ch)\n (hashtable-ref (car (hashtable-ref ch \"choices\" '())) \"finish_reason\" #f))\n(define (p6-specs-have? specs name)\n (let loop ([s specs])\n (cond [(null? s) #f]\n [(equal? (tool-spec-name (car s)) name) #t]\n [else (loop (cdr s))])))\n\n(section \"=== proxy convert: openai->messages ===\")\n(let* ([omsgs (string->json-object \"[{\\\"role\\\":\\\"system\\\",\\\"content\\\":\\\"sys\\\"},{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"},{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"reasoning\\\",\\\"tool_calls\\\":[{\\\"id\\\":\\\"call_1\\\",\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"arguments\\\":\\\"{\\\\\\\"q\\\\\\\":\\\\\\\"x\\\\\\\"}\\\"}}]},{\\\"role\\\":\\\"tool\\\",\\\"tool_call_id\\\":\\\"call_1\\\",\\\"content\\\":\\\"result\\\"}]\")]\n [cmsgs (openai->messages omsgs)])\n (check! \"msgs count\" (length cmsgs) 4)\n (check! \"msg0 system\" (message-role (car cmsgs)) \"system\")\n (check! \"msg0 content\" (message-content (car cmsgs)) \"sys\")\n (check! \"msg1 user\" (message-role (cadr cmsgs)) \"user\")\n (check! \"msg2 assistant\" (message-role (caddr cmsgs)) \"assistant\")\n (let ([tcs (message-tool-calls (caddr cmsgs))])\n (check-pred! \"assistant 1 tool call\" tcs (lambda (x) (and (pair? x) (= (length x) 1))))\n (check! \"tool call name\" (tool-call-name (car tcs)) \"search\")\n (check! \"tool call args preserved\" (tool-call-arguments (car tcs)) \"{\\\"q\\\":\\\"x\\\"}\"))\n (check! \"msg3 tool role\" (message-role (cadddr cmsgs)) \"tool\")\n (check! \"msg3 tool_call_id\" (message-tool-call-id (cadddr cmsgs)) \"call_1\"))\n\n;; content as a block list flattens to a newline-joined string\n(let ([blk (openai->messages (string->json-object \"[{\\\"role\\\":\\\"user\\\",\\\"content\\\":[{\\\"type\\\":\\\"text\\\",\\\"text\\\":\\\"a\\\"},{\\\"type\\\":\\\"text\\\",\\\"text\\\":\\\"b\\\"}]}]\"))])\n (check! \"block content flattened\" (message-content (car blk)) \"a\\nb\"))\n\n(section \"=== proxy convert: outbound ===\")\n(let ([tco (tool-calls->openai\n (list (make-wtool-call \"search\" '((\"q\" . \"jb\")) \"reasoning text\")\n (make-wtool-call \"answer\" '((\"a\" . \"1\")) #f)) \"m1\")])\n (check! \"tco finish\" (p6-finish tco) \"tool_calls\")\n (check! \"tco content = first reasoning\" (p6-content tco) \"reasoning text\")\n (let ([entries (p6-tcs tco)])\n (check! \"tco 2 entries\" (length entries) 2)\n (let ([fn (hashtable-ref (car entries) \"function\" #f)])\n (check! \"tco entry name\" (hashtable-ref fn \"name\" #f) \"search\")\n (check! \"tco entry args roundtrip\"\n (hashtable-ref (string->json-object (hashtable-ref fn \"arguments\" #f)) \"q\" #f) \"jb\"))))\n(let ([tro (text-response->openai \"the answer\" \"m1\")])\n (check! \"tro finish stop\" (p6-finish tro) \"stop\")\n (check! \"tro content\" (p6-content tro) \"the answer\"))\n(let ([sse (text->sse-events \"hello\" \"m1\")])\n (check-pred! \"text sse is a list\" sse list?)\n (check! \"text sse last finish stop\" (p6-chunk-finish (p6-last sse)) \"stop\"))\n(let ([sse (tool-calls->sse-events (list (make-wtool-call \"search\" '((\"q\" . \"x\")) \"r\")) \"m1\")])\n (check! \"tool sse last finish tool_calls\" (p6-chunk-finish (p6-last sse)) \"tool_calls\"))\n\n(section \"=== proxy handler: extraction ===\")\n(check! \"extract-sampling present\"\n (hashtable-ref (extract-sampling (string->json-object \"{\\\"temperature\\\":0.6,\\\"top_p\\\":0.9}\")) \"temperature\" #f) 0.6)\n(check! \"extract-sampling absent → #f\"\n (extract-sampling (string->json-object \"{\\\"messages\\\":[]}\")) #f)\n(let ([especs (extract-tool-specs (string->json-object \"[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{\\\"type\\\":\\\"object\\\"}}}]\"))])\n (check! \"extract-tool-specs count\" (length especs) 1)\n (check! \"extract-tool-specs name\" (tool-spec-name (car especs)) \"search\"))\n\n(section \"=== proxy handler: completion paths ===\")\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}]}\")\n (lambda (msgs specs samp) (make-text-response \"plain answer\")))])\n (check! \"no-tools finish stop\" (p6-finish h) \"stop\")\n (check! \"no-tools content\" (p6-content h) \"plain answer\"))\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{\\\"type\\\":\\\"object\\\"}}}]}\")\n (lambda (msgs specs samp) (list (make-wtool-call \"search\" '((\"q\" . \"x\")) \"thinking\"))))])\n (check! \"tools finish tool_calls\" (p6-finish h) \"tool_calls\")\n (check! \"tools entry name\"\n (hashtable-ref (hashtable-ref (car (p6-tcs h)) \"function\" #f) \"name\" #f) \"search\"))\n;; respond is injected into the offered specs (and the original tool retained)\n(let ([seen #f])\n (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (set! seen specs) (make-text-response \"x\")))\n (check! \"respond injected into specs\" (p6-specs-have? seen \"respond\") #t)\n (check! \"original tool retained\" (p6-specs-have? seen \"search\") #t))\n;; a pure respond() call is stripped and returned as a normal text answer\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (list (make-wtool-call \"respond\" '((\"message\" . \"final words\")) #f))))])\n (check! \"respond-only finish stop\" (p6-finish h) \"stop\")\n (check! \"respond-only content = message\" (p6-content h) \"final words\"))\n;; retries exhausted (&tool-call-error) → return last raw text for the client\n(let ([h (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"q\\\"}],\\\"tools\\\":[{\\\"type\\\":\\\"function\\\",\\\"function\\\":{\\\"name\\\":\\\"search\\\",\\\"description\\\":\\\"d\\\",\\\"parameters\\\":{}}}]}\")\n (lambda (msgs specs samp) (raise-tool-call-error \"exhausted\" \"raw text fallback\")))])\n (check! \"tool-call-error finish stop\" (p6-finish h) \"stop\")\n (check! \"tool-call-error returns raw\" (p6-content h) \"raw text fallback\"))\n;; stream:true → handler returns a list of chunk objects\n(check-pred! \"stream handler returns chunk list\"\n (handle-chat-completions\n (string->json-object \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}],\\\"stream\\\":true}\")\n (lambda (msgs specs samp) (make-text-response \"streamed\")))\n list?)\n\n(section \"=== slot-worker: scheduling policy ===\")\n(check! \"priority lower int first\" (slot-priority<? 0 5 1 0) #t)\n(check! \"priority equal → lower seq\" (slot-priority<? 0 1 0 2) #t)\n(check! \"priority equal → higher seq not first\" (slot-priority<? 0 2 0 1) #f)\n(check! \"priority higher int not first\" (slot-priority<? 1 0 0 5) #f)\n(check! \"preempt: strictly higher\" (slot-should-preempt? 5 1) #t)\n(check! \"no preempt: lower\" (slot-should-preempt? 1 5) #f)\n(check! \"no preempt: equal\" (slot-should-preempt? 3 3) #f)\n(check! \"no preempt: idle slot\" (slot-should-preempt? #f 1) #f)\n(let ([w (make-slot-worker (scripted-responder '()))])\n (check! \"fresh worker is slot-worker?\" (slot-worker? w) #t)\n (check! \"fresh worker pending 0\" (slot-worker-pending w) 0)\n (check! \"fresh worker no running priority\" (slot-worker-running-priority w) #f))\n;; end-to-end: start, submit a one-step workflow, get its terminal value\n(let* ([wf (make-workflow \"r\" \"d\"\n (list (make-tool-def (make-tool-spec \"done\" \"d\" '()) (lambda (a) \"DONE-VAL\") '()))\n '() \"done\" \"p\")]\n [w (make-slot-worker (scripted-responder (list (list (make-wtool-call \"done\" '() #f)))))])\n (slot-worker-start! w)\n (let ([result (slot-submit! w wf \"go\" (list (cons 'max-iterations 4)))])\n (slot-worker-stop! w)\n (check! \"slot-submit! returns terminal value\" result \"DONE-VAL\")))\n\n(section \"=== proxy dispatch: routing ===\")\n(define p6-backend (lambda (msgs specs samp) (make-text-response \"pong\")))\n(let ([r (proxy-dispatch \"GET\" \"/health\" \"\" p6-backend)])\n (check! \"health status 200\" (presp-status r) 200)\n (check-pred! \"health body has ok\" (presp-body r) (lambda (b) (str-contains? b \"ok\"))))\n(let ([r (proxy-dispatch \"GET\" \"/v1/models\" \"\" p6-backend)])\n (check! \"models status 200\" (presp-status r) 200)\n (check-pred! \"models body has forge\" (presp-body r) (lambda (b) (str-contains? b \"forge\"))))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\"\n \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}]}\" p6-backend)])\n (check! \"chat status 200\" (presp-status r) 200)\n (check! \"chat content-type json\" (presp-content-type r) \"application/json\")\n (check! \"chat finish stop\" (p6-finish (string->json-object (presp-body r))) \"stop\"))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\"\n \"{\\\"messages\\\":[{\\\"role\\\":\\\"user\\\",\\\"content\\\":\\\"hi\\\"}],\\\"stream\\\":true}\" p6-backend)])\n (check! \"stream content-type sse\" (presp-content-type r) \"text/event-stream\")\n (check-pred! \"stream body has [DONE]\" (presp-body r) (lambda (b) (str-contains? b \"data: [DONE]\"))))\n(let ([r (proxy-dispatch \"POST\" \"/v1/chat/completions\" \"not json at all\" p6-backend)])\n (check! \"bad json → 400\" (presp-status r) 400))\n(let ([r (proxy-dispatch \"GET\" \"/nope\" \"\" p6-backend)])\n (check! \"unknown route → 404\" (presp-status r) 404))\n(let ([r (proxy-dispatch \"POST\" \"/health\" \"\" p6-backend)])\n (check! \"wrong method → 405\" (presp-status r) 405))\n\n(section \"=== eval: scenario + check-substrings ===\")\n(check! \"check-substrings all present\" (check-substrings \"The Quick Brown Fox\" '(\"quick\" \"fox\")) #t)\n(check! \"check-substrings missing\" (check-substrings \"hello world\" '(\"hello\" \"moon\")) #f)\n(check! \"check-substrings empty required\" (check-substrings \"anything\" '()) #t)\n(check! \"check-substrings comma-stripped\" (check-substrings \"total: 1,000 units\" '(\"1000\")) #t)\n(check! \"check-substrings case-insensitive\" (check-substrings \"RESULT\" '(\"result\")) #t)\n(let ([s (make-eval-scenario \"n\" \"d\" (lambda () #f) \"um\" (lambda () #f) #f)])\n (check! \"scenario name\" (eval-scenario-name s) \"n\")\n (check! \"scenario default max-iterations 15\" (eval-scenario-max-iterations s) 15)\n (check! \"scenario default max-retries 5\" (eval-scenario-max-retries-per-step s) 5)\n (check! \"scenario default max-tool-errors 2\" (eval-scenario-max-tool-errors s) 2)\n (check! \"scenario default tags\" (eval-scenario-tags s) '()))\n(let ([s (make-eval-scenario \"n\" \"d\" (lambda () #f) \"um\" (lambda () #f) #f\n (list (cons 'max-iterations 3) (cons 'tags '(\"a\"))))])\n (check! \"scenario opt max-iterations\" (eval-scenario-max-iterations s) 3)\n (check! \"scenario opt tags\" (eval-scenario-tags s) '(\"a\")))\n(let ([r (make-run-result \"n\" #t #t 4 '((\"k\" . \"v\")) #f #f '())])\n (check! \"run-result accuracy\" (run-result-accuracy r) #t)\n (check! \"run-result iters\" (run-result-iterations-used r) 4))\n\n(section \"=== eval: ablation presets ===\")\n(check! \"preset count\" (length *ablation-preset-order*) 7)\n(let ([r (ablation-preset-ref \"reforged\")])\n (check! \"reforged step-enf on\" (ablation-config-step-enforcement-enabled r) #t)\n (check! \"reforged rescue on\" (ablation-config-rescue-enabled r) #t)\n (check! \"reforged max-retries 5\" (ablation-config-max-retries-per-step r) 5)\n (check! \"reforged max-tool-errors 2\" (ablation-config-max-tool-errors r) 2))\n(check! \"no_steps step-enf off\"\n (ablation-config-step-enforcement-enabled (ablation-preset-ref \"no_steps\")) #f)\n(check! \"no_recovery max-tool-errors 0\"\n (ablation-config-max-tool-errors (ablation-preset-ref \"no_recovery\")) 0)\n(check! \"no_nudge max-retries 0\"\n (ablation-config-max-retries-per-step (ablation-preset-ref \"no_nudge\")) 0)\n(let ([b (ablation-preset-ref \"bare\")])\n (check! \"bare rescue off\" (ablation-config-rescue-enabled b) #f)\n (check! \"bare step-enf off\" (ablation-config-step-enforcement-enabled b) #f)\n (check! \"bare compaction off\" (ablation-config-compaction-enabled b) #f))\n(check! \"preset-ref unknown → #f\" (ablation-preset-ref \"nope\") #f)\n(check! \"make-ablation-config default compaction\"\n (ablation-config-compaction-enabled (make-ablation-config \"x\")) #t)\n\n(section \"=== eval: instrument-workflow ===\")\n(let* ([cap (vector 'none)]\n [wf (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"fin\" \"f\" '()) (lambda (a) \"done\") '()))\n '() \"fin\" \"p\")]\n [inst (instrument-workflow wf #t cap)])\n ((workflow-get-callable inst \"fin\") '((\"k\" . \"v\")))\n (check! \"instrument captures terminal args\" (cdr (assoc \"k\" (vector-ref cap 0))) \"v\"))\n(let ([wf (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"s\" \"s\" '()) (lambda (a) \"r\") '())\n (make-tool-def (make-tool-spec \"fin\" \"f\" '()) (lambda (a) \"done\") '()))\n '(\"s\") \"fin\" \"p\")])\n (check! \"instrument keeps required when enf on\"\n (workflow-required-steps (instrument-workflow wf #t (vector 'none))) '(\"s\"))\n (check! \"instrument strips required when enf off\"\n (workflow-required-steps (instrument-workflow wf #f (vector 'none))) '()))\n\n(section \"=== eval: error-type classification ===\")\n(check! \"eval-error-type max-iterations\"\n (eval-error-type (guard (e [#t e]) (raise-max-iterations 5 '() '(\"x\")))) \"max_iterations\")\n(check! \"eval-error-type step-enforcement\"\n (eval-error-type (guard (e [#t e]) (raise-step-enforcement \"t\" 3 '(\"s\")))) \"step_enforcement\")\n(check! \"eval-error-type prerequisite\"\n (eval-error-type (guard (e [#t e]) (raise-prerequisite-error \"t\" 2 '(\"s\")))) \"prerequisite\")\n(check! \"eval-error-type tool-execution\"\n (eval-error-type (guard (e [#t e]) (raise-tool-execution-error \"t\" \"boom\"))) \"tool_execution\")\n(check! \"eval-error-type non-condition\" (eval-error-type \"oops\") \"error\")\n\n(section \"=== eval: analyze-messages ===\")\n(let* ([msgs (list\n (make-system-message \"sys\")\n (make-user-message \"u\")\n (make-assistant-message \"thinking out loud\")\n (make-assistant-message \"\" (list (make-tool-call \"search\" '())\n (make-tool-call \"search\" '())))\n (make-tool-result \"id1\" \"[StepEnforcementError] nudge\")\n (make-tool-result \"id2\" \"[ToolError] boom\")\n (make-tool-result \"id3\" \"ok result\")\n (make-assistant-message \"\" (list (make-tool-call \"answer\" '()))))]\n [st (analyze-messages msgs)])\n (check! \"analyze total tool-calls\" (history-stats-total-tool-calls st) 3)\n (check! \"analyze unique tools\" (history-stats-unique-tools st) 2)\n (check! \"analyze step nudges\" (history-stats-step-nudges st) 1)\n (check! \"analyze tool errors\" (history-stats-tool-errors st) 1)\n (check! \"analyze reasoning msgs\" (history-stats-reasoning-messages st) 1))\n\n(section \"=== eval: run-eval-scenario + ablation ===\")\n;; demo: scripted model answers before searching; step enforcement nudges it.\n(define (eval-demo-scenario)\n (make-eval-scenario\n \"demo\" \"premature answer nudged to search\"\n (lambda ()\n (let ([searched (vector #f)])\n (cons\n (make-workflow \"research\" \"search then answer\"\n (list\n (make-tool-def (make-tool-spec \"search\" \"s\" '((\"type\" . \"object\")))\n (lambda (a) (vector-set! searched 0 #t) \"results\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\")))\n (lambda (a) \"answered\") '()))\n '(\"search\") \"answer\" \"p\")\n (lambda () (vector-ref searched 0)))))\n \"look it up\"\n (lambda ()\n (scripted-responder\n (list (list (make-wtool-call \"answer\" '((\"text\" . \"early\")) #f))\n (list (make-wtool-call \"search\" '((\"q\" . \"x\")) #f))\n (list (make-wtool-call \"answer\" '((\"text\" . \"final\")) #f)))))\n (lambda (args) (and args (assoc \"text\" args) #t))\n '((max-iterations . 8))))\n(let ([on (run-eval-scenario (eval-demo-scenario))])\n (check! \"demo reforged completeness\" (run-result-completeness on) #t)\n (check! \"demo reforged accuracy\" (run-result-accuracy on) #t)\n (check! \"demo reforged iters 3\" (run-result-iterations-used on) 3)\n (check! \"demo reforged error-type #f\" (run-result-error-type on) #f)\n (check! \"demo reforged terminal text=final\"\n (cdr (assoc \"text\" (run-result-terminal-args on))) \"final\"))\n(let ([off (run-eval-scenario (eval-demo-scenario)\n (list (cons 'ablation (ablation-preset-ref \"no_steps\"))))])\n (check! \"demo no_steps completeness\" (run-result-completeness off) #t)\n (check! \"demo no_steps accuracy #f (ungrounded)\" (run-result-accuracy off) #f)\n (check! \"demo no_steps iters 1\" (run-result-iterations-used off) 1)\n (check! \"demo no_steps answered immediately\"\n (cdr (assoc \"text\" (run-result-terminal-args off))) \"early\"))\n;; never-terminating scenario → max_iterations\n(let ([r (run-eval-scenario\n (make-eval-scenario \"loop\" \"never terminates\"\n (lambda ()\n (make-workflow \"w\" \"d\"\n (list (make-tool-def (make-tool-spec \"noop\" \"n\" '()) (lambda (a) \"ok\") '())\n (make-tool-def (make-tool-spec \"done\" \"d\" '()) (lambda (a) \"x\") '()))\n '() \"done\" \"p\"))\n \"go\"\n (lambda () (scripted-responder (list (list (make-wtool-call \"noop\" '() #f)))))\n #f\n (list (cons 'max-iterations 3))))])\n (check! \"loop scenario not complete\" (run-result-completeness r) #f)\n (check! \"loop scenario error-type max_iterations\" (run-result-error-type r) \"max_iterations\")\n (check! \"loop scenario accuracy #f\" (run-result-accuracy r) #f))\n;; ablation sweep + pass-rate aggregation\n(let* ([rows (run-ablation (eval-demo-scenario)\n (list (ablation-preset-ref \"reforged\") (ablation-preset-ref \"no_steps\")))]\n [rates (ablation-pass-rates rows)])\n (check! \"ablation rows count\" (length rows) 2)\n (check! \"ablation reforged passed\" (run-result-accuracy (cdr (assoc \"reforged\" rows))) #t)\n (check! \"ablation no_steps failed\" (run-result-accuracy (cdr (assoc \"no_steps\" rows))) #f)\n (check! \"pass-rate reforged 1/1\" (cdr (assoc \"reforged\" rates)) '(1 . 1))\n (check! \"pass-rate no_steps 0/1\" (cdr (assoc \"no_steps\" rates)) '(0 . 1)))\n\n(section \"=== verify-gate: ATLAS verify+repair on forge primitives ===\")\n;; A small model that tries to finish on UNWRITTEN code. make-verified-workflow\n;; sets required-steps (edit verify) and a verify callable that RAISES on\n;; failure, so the terminal stays gated until verify actually passes. The script\n;; below tries done first, then writes buggy code, verifies (fails), repairs,\n;; verifies (passes), and finishes — shipping correct code. Strip step\n;; enforcement (no_steps) and the premature done ships UNWRITTEN code: accuracy\n;; flips #t → #f. This is ATLAS's self-verified-repair win on existing machinery.\n(define (verify-gate-scenario)\n (make-eval-scenario\n \"verify-gate\" \"premature done forced through verify+repair\"\n (lambda ()\n (let ([code (vector \"UNWRITTEN\")])\n (cons\n (make-verified-workflow \"vcode\" \"edit, verify, done\"\n (make-tool-def (make-tool-spec \"edit\" \"write code\" '((\"type\" . \"object\")))\n (lambda (a)\n (vector-set! code 0 (let ([p (assoc \"content\" a)]) (if p (cdr p) \"\")))\n \"edited\")\n '())\n (make-tool-def (make-tool-spec \"verify\" \"run tests\" '((\"type\" . \"object\")))\n (make-verify-callable\n (lambda (a)\n (if (equal? (vector-ref code 0) \"correct\")\n (cons #t \"all tests passed\")\n (cons #f \"test_basic FAILED: wrong output\"))))\n '())\n (make-tool-def (make-tool-spec \"done\" \"finish\" '((\"type\" . \"object\")))\n (lambda (a) (let ([p (assoc \"summary\" a)]) (if p (cdr p) \"done\")))\n '()))\n (lambda () (equal? (vector-ref code 0) \"correct\")))))\n \"implement the feature\"\n (lambda ()\n (scripted-responder\n (list (list (make-wtool-call \"done\" '((\"summary\" . \"all set\")) #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"fixed+verified\")) #f)))))\n (lambda (args) (and args #t))\n '((max-iterations . 12))))\n(let ([on (run-eval-scenario (verify-gate-scenario))])\n (check! \"verify-gate reforged completeness\" (run-result-completeness on) #t)\n (check! \"verify-gate reforged accuracy (correct code shipped)\" (run-result-accuracy on) #t)\n (check! \"verify-gate reforged iters 6\" (run-result-iterations-used on) 6)\n (let ([st (analyze-messages (run-result-messages on))])\n (check! \"verify-gate repair fired (1 tool error)\" (history-stats-tool-errors st) 1)\n (check! \"verify-gate gate fired (1 step nudge)\" (history-stats-step-nudges st) 1)))\n(let ([off (run-eval-scenario (verify-gate-scenario)\n (list (cons 'ablation (ablation-preset-ref \"no_steps\"))))])\n (check! \"verify-gate no_steps completeness\" (run-result-completeness off) #t)\n (check! \"verify-gate no_steps accuracy #f (unwritten shipped)\" (run-result-accuracy off) #f)\n (check! \"verify-gate no_steps iters 1\" (run-result-iterations-used off) 1))\n;; the headline: the gate converts a wrong outcome into a right one.\n(let* ([rows (run-ablation (verify-gate-scenario)\n (list (ablation-preset-ref \"reforged\") (ablation-preset-ref \"no_steps\")))]\n [rates (ablation-pass-rates rows)])\n (check! \"verify-gate flip reforged 1/1\" (cdr (assoc \"reforged\" rates)) '(1 . 1))\n (check! \"verify-gate flip no_steps 0/1\" (cdr (assoc \"no_steps\" rates)) '(0 . 1)))\n\n(section \"=== best-of-k: ATLAS diverse-gen, verify selects ===\")\n;; Two candidates for one task. Candidate 0 writes buggy code and never gets it\n;; past verify within the iteration budget — run-workflow RAISES, so the\n;; candidate is rejected. Candidate 1 (a diverse re-sample) writes correct code,\n;; verifies, and finishes. best-of-1 sees only the buggy candidate and fails;\n;; best-of-2 resamples and the verify-gate selects the passing trajectory. This\n;; is ATLAS's Phase-1 diverse-generation win composed with the verify-gate.\n(define (bok-workflow code)\n (make-verified-workflow \"bok\" \"edit, verify, done\"\n (make-tool-def (make-tool-spec \"edit\" \"write code\" '((\"type\" . \"object\")))\n (lambda (a)\n (vector-set! code 0 (let ([p (assoc \"content\" a)]) (if p (cdr p) \"\")))\n \"edited\")\n '())\n (make-tool-def (make-tool-spec \"verify\" \"run tests\" '((\"type\" . \"object\")))\n (make-verify-callable\n (lambda (a)\n (if (equal? (vector-ref code 0) \"correct\")\n (cons #t \"all tests passed\")\n (cons #f \"test_basic FAILED: wrong output\"))))\n '())\n (make-tool-def (make-tool-spec \"done\" \"finish\" '((\"type\" . \"object\")))\n (lambda (a) \"SHIPPED\") '())))\n;; A factory thunk: successive calls return candidate 0, then candidate 1, …\n(define (bok-factory)\n (let ([attempt -1])\n (lambda ()\n (set! attempt (+ attempt 1))\n (if (= attempt 0)\n (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))))\n (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"fixed\")) #f))))))))\n(define bok-opts (list (cons 'max-iterations 5) (cons 'max-tool-errors 10)))\n;; best-of-1: only the buggy candidate → never verifies → run-workflow raises.\n(check! \"best-of-1 fails (buggy candidate, no selection)\"\n (raises? (lambda () (run-best-of-k (bok-workflow (vector \"UNWRITTEN\"))\n \"go\" (bok-factory) 1 bok-opts))) #t)\n;; best-of-2: candidate 1 verifies → returned as the selected trajectory.\n(check! \"best-of-2 succeeds (verify selects the passing resample)\"\n (run-best-of-k (bok-workflow (vector \"UNWRITTEN\")) \"go\" (bok-factory) 2 bok-opts)\n \"SHIPPED\")\n;; k<1 is clamped to a single attempt.\n(check! \"best-of-0 clamps to 1 (still fails on the buggy candidate)\"\n (raises? (lambda () (run-best-of-k (bok-workflow (vector \"UNWRITTEN\"))\n \"go\" (bok-factory) 0 bok-opts))) #t)\n\n(section \"=== no-progress breaker: ATLAS cheap loop breaker ===\")\n;; A model stuck calling the same executed tool forever. The error budget never\n;; trips (the call succeeds) and the terminal is never reached, so without a\n;; breaker it silently burns the whole iteration budget → MaxIterationsError.\n;; The opt-in max-repeated-calls breaker detects the identical-batch loop and\n;; breaks early with NoProgressError, wasting far less compute. (look has no\n;; prerequisite and is not a required step, so each call genuinely executes.)\n(define (mk-stuck-wf)\n (make-workflow \"stuck\" \"Look, then answer.\"\n (list\n (make-tool-def (make-tool-spec \"look\" \"l\" '((\"type\" . \"object\"))) (lambda (a) \"looked\") '())\n (make-tool-def (make-tool-spec \"answer\" \"a\" '((\"type\" . \"object\"))) (lambda (a) \"ANSWER\") '()))\n '() \"answer\" \"p\"))\n;; Without the breaker: 6 identical looks burn all 6 iterations → MaxIterations.\n(let* ([w (mk-stuck-wf)]\n [calls (vector 0)]\n [base (scripted-responder (make-list 10 (list (make-wtool-call \"look\" '() #f))))]\n [resp (lambda (m s i) (vector-set! calls 0 (+ (vector-ref calls 0) 1)) (base m s i))])\n (check! \"no breaker: stuck loop raises MaxIterationsError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp (list (cons 'max-iterations 6))))\n max-iterations-error?) #t)\n (check! \"no breaker burned all 6 iterations\" (vector-ref calls 0) 6))\n;; With the breaker (3): breaks at the 3rd identical executed batch → NoProgress.\n(let* ([w (mk-stuck-wf)]\n [calls (vector 0)]\n [base (scripted-responder (make-list 10 (list (make-wtool-call \"look\" '() #f))))]\n [resp (lambda (m s i) (vector-set! calls 0 (+ (vector-ref calls 0) 1)) (base m s i))])\n (check! \"breaker: stuck loop raises NoProgressError\"\n (raises-pred? (lambda () (run-workflow w \"go\" resp\n (list (cons 'max-iterations 6) (cons 'max-repeated-calls 3))))\n no-progress-error?) #t)\n (check! \"breaker fired at 3 calls, not 6 (half the wasted compute)\"\n (vector-ref calls 0) 3))\n;; The breaker only counts identical *executed* batches: a real edit→verify→edit\n;; repair cycle alternates tools, so it never trips even with a tight threshold.\n(let* ([code (vector \"UNWRITTEN\")]\n [w (bok-workflow code)]\n [resp (scripted-responder\n (list (list (make-wtool-call \"edit\" '((\"content\" . \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"edit\" '((\"content\" . \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"ok\")) #f))))]\n [result (run-workflow w \"go\" resp (list (cons 'max-iterations 8)\n (cons 'max-repeated-calls 2)))])\n (check! \"breaker leaves real edit/verify repair alone\" result \"SHIPPED\"))\n\n(section \"=== agent chat no-progress breaker ===\")\n;; Sub-agents use agent-chat-messages, not agent-run. This tests the lower-level\n;; per-turn breaker directly: repeated glob misses separated by ls calls must\n;; still trip on the third identical tool-call signature.\n(let ([glob-bin (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"bin/**/*.ss\\\",\\\"path\\\":\\\"/repo\\\"}\"))]\n [ls-bin (list (make-tool-call \"ls\" \"{\\\"path\\\":\\\"/repo/bin\\\"}\"))])\n (parameterize ([forge-max-repeated-calls 3]\n [forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker first glob ok\" (forge-no-progress? glob-bin) #f)\n (check! \"agent breaker interleaved ls ok\" (forge-no-progress? ls-bin) #f)\n (check! \"agent breaker second glob ok\" (forge-no-progress? glob-bin) #f)\n (check! \"agent breaker second ls ok\" (forge-no-progress? ls-bin) #f)\n (check! \"agent breaker non-consecutive third glob trips\"\n (forge-no-progress? glob-bin) #t)))\n(let ([glob-src (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"*.ss\\\",\\\"path\\\":\\\"/repo/src\\\"}\"))]\n [glob-lib (list (make-tool-call \"glob\" \"{\\\"pattern\\\":\\\"*.ss\\\",\\\"path\\\":\\\"/repo/lib\\\"}\"))])\n (parameterize ([forge-max-repeated-calls 3]\n [forge-max-similar-search-calls 2]\n [forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker first similar glob ok\" (forge-no-progress? glob-src) #f)\n (check! \"agent breaker second same-pattern glob trips\"\n (forge-no-progress? glob-lib) #t)))\n(parameterize ([forge-breaker-state (make-forge-breaker-state)])\n (check! \"agent breaker nudge initially unused\" (forge-no-progress-nudge-used?) #f)\n (forge-mark-no-progress-nudged!)\n (check! \"agent breaker nudge marked used\" (forge-no-progress-nudge-used?) #t))\n\n(section \"=== expert escalation ===\")\n;; Guessed paths during repository exploration are normal recovery steps for a\n;; local model. They should not consume expert budget as a tool-error streak,\n;; while real tool failures still should.\n(let* ([msgs (list (make-tool-result \"r1\" \"Error: File not found: /repo/src/jcode/agent.ss\")\n (make-tool-result \"r2\" \"Error: Path not found: /repo/bin\")\n (make-tool-result \"r3\" \"Error: Not a directory: /repo/README.md\"))]\n [resp (make-assistant-message \"I'll keep looking.\")])\n (check! \"escalation ignores lookup misses\"\n (should-escalate? msgs resp '()) #f))\n\n(let* ([msgs (list (make-tool-result \"r1\" \"Error: command failed: exit 1\")\n (make-tool-result \"r2\" \"Error: sandbox denied\")\n (make-tool-result \"r3\" \"MCP Error: server disconnected\"))]\n [resp (make-assistant-message \"I'll keep looking.\")]\n [reason (should-escalate? msgs resp '())])\n (check! \"escalation keeps real tool-error streak\"\n (and reason (cdr (assq 'signal reason))) 'tool-error-streak))\n\n(section \"=== verified-run: coding workflow on a REAL file + REAL shell verify ===\")\n;; The verify-gate/best-of-k tests above use mock callables. This one drives the\n;; live-model bridge's genuinely new code — do-edit (real write-file-string),\n;; run-verify-command (real /bin/sh shell-out → exit-code → pass?), and\n;; coding-workflow's gate wiring — with a scripted responder standing in for the\n;; model. verify is `grep -q correct <file>`: it FAILS on \"buggy\" (exit 1) and\n;; PASSES on \"correct\" (exit 0). The script edits buggy, verifies (fails), then\n;; tries to done — that premature done must be GATED because the failed verify\n;; RAISED (make-verify-callable) and was never recorded. Only after a repair edit\n;; and a passing verify does done go through. result == \"verified-and-done\"\n;; (never \"shipped-buggy\") proves the real shell verify actually gates the\n;; terminal; the file ending in \"correct\" proves do-edit wrote real bytes.\n(let* ([vr-dir \"/tmp\"]\n [vr-name \"jcode-verified-run-test.txt\"]\n [vr-path (string-append vr-dir \"/\" vr-name)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))]\n [tool-results '()])\n (guard (e [#t (void)]) (delete-file vr-path)) ; clean any stale file\n (let* ([wf (coding-workflow (string-append \"grep -q correct \" vr-name) vr-dir)]\n [resp (scripted-responder\n (list\n (list (make-wtool-call \"edit\" (list (cons \"path\" vr-name) (cons \"content\" \"buggy\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"shipped-buggy\")) #f))\n (list (make-wtool-call \"edit\" (list (cons \"path\" vr-name) (cons \"content\" \"correct\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"verified-and-done\")) #f))))]\n [result (run-workflow wf \"implement the feature\" resp\n (list\n (cons 'max-iterations 12)\n (cons 'on-message\n\t (lambda (m)\n\t (when (equal? (message-role m) \"tool\")\n\t (set! tool-results\n\t (cons (message-content m)\n\t tool-results)))))))])\n (when (not (equal? result \"verified-and-done\"))\n (for-each (lambda (s) (printf \" trace: ~a~n\" s))\n (reverse tool-results)))\n (check! \"verified-run: gate held — done after passing verify, not the buggy one\"\n result \"verified-and-done\")\n (check! \"verified-run: do-edit wrote the repaired bytes to the real file\"\n (slurp vr-path) \"correct\"))\n (guard (e [#t (void)]) (delete-file vr-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [allowed \"jcode-verified-scope-allowed.txt\"]\n [denied \"jcode-verified-scope-denied.txt\"]\n [allowed-path (string-append vr-dir \"/\" allowed)]\n [denied-path (string-append vr-dir \"/\" denied)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file allowed-path))\n (guard (e [#t (void)]) (delete-file denied-path))\n (let* ([scope (parse-write-scope allowed)]\n [wf (coding-workflow (string-append \"grep -q scoped \" allowed) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list (make-wtool-call \"edit\" (list (cons \"path\" denied) (cons \"content\" \"bad\")) #f))\n (list (make-wtool-call \"edit\" (list (cons \"path\" allowed) (cons \"content\" \"scoped\")) #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"scope-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"write within scope\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: scoped edit can still complete after refused out-of-scope edit\"\n result \"scope-ok\")\n (check! \"verified-run: out-of-scope edit did not create file\"\n (file-exists? denied-path) #f)\n (check! \"verified-run: in-scope edit wrote file\"\n (slurp allowed-path) \"scoped\"))\n (guard (e [#t (void)]) (delete-file allowed-path))\n (guard (e [#t (void)]) (delete-file denied-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-heredoc.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q heredoc \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"run\"\n (list (cons \"bash\"\n (string-append\n \"cat > \" target \" << 'EOF'\\n\"\n \"heredoc\\n\"\n \"EOF\")))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"heredoc-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"write heredoc safely\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: cat heredoc alias writes through scoped edit\"\n result \"heredoc-ok\")\n (check! \"verified-run: heredoc content was written\"\n (slurp target-path) \"heredoc\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([wf (coding-workflow \"true\" \"/tmp\")]\n [tool-results '()]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"run\"\n '((\"bash\" . \"which jerbuild || echo \\\"jerbuild not found\\\"\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"which-ok\")) #f))))]\n [result (run-workflow wf \"probe then verify\" resp\n (list (cons 'max-iterations 8)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results)))))))])\n (check! \"verified-run: which probe still reaches verified done\"\n result \"which-ok\")\n (check-pred! \"verified-run: which probe gets edit/verify guidance\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"Environment probing is unnecessary\")))))\n\n (let* ([wf (coding-workflow \"true\" \"/tmp\")]\n [target \"jcode-verified-read-range.txt\"]\n [target-path (string-append \"/tmp/\" target)]\n [tool-results '()]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"read\"\n (list (cons \"path\" target)\n (cons \"line\" 2)\n (cons \"end\" 3))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"read-range-ok\")) #f))))]\n [result (begin\n (call-with-output-file target-path\n (lambda (o) (display \"one\\ntwo\\nthree\\nfour\\n\" o))\n 'replace)\n (run-workflow wf \"inspect a line range\" resp\n (list (cons 'max-iterations 8)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: read line range reaches verified done\"\n result \"read-range-ok\")\n (check! \"verified-run: read line/end returns selected span\"\n (car (reverse tool-results)) \"two\\nthree\"))\n (guard (e [#t (void)]) (delete-file \"/tmp/jcode-verified-read-range.txt\"))\n\n (let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-edit-file-alias.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"file\" \"alias-content\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"file-alias-ok\")) #f))))]\n [wf (coding-workflow (string-append \"grep -q alias-content \" target) vr-dir)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let ([result (run-workflow wf \"write using file alias\" resp\n (list (cons 'max-iterations 8)))])\n (check! \"verified-run: edit accepts file content alias\"\n result \"file-alias-ok\")\n (check! \"verified-run: file content alias writes bytes\"\n (slurp target-path) \"alias-content\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-def.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(define (keep) \\\"keep\\\")\\n\\n(define (broken x)\\n (+ x 1))\\n\"]\n [replacement \"(define (broken x)\\n (+ x 2))\\n\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q \\\"(+ x 2)\\\" \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"replace_def\"\n (list (cons \"path\" target)\n (cons \"name\" \"broken\")\n (cons \"content\" replacement))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-def-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"replace one function\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace_def reaches verified done\"\n result \"replace-def-ok\")\n (check-pred! \"verified-run: replace_def changed only named function\"\n (slurp target-path)\n (lambda (s)\n (and (str-contains? s \"(define (keep) \\\"keep\\\")\")\n (str-contains? s \"(+ x 2)\")\n (not (str-contains? s \"(+ x 1)\"))))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-range.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(import (jerboa prelude))\\n(define (bad)\\n (displayln \\\"bad\\\")\\n\\n(define (ok) 1)\\n\"]\n [replacement \"(define (bad)\\n (displayln \\\"fixed\\\"))\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q fixed \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"replace_range\"\n (list (cons \"path\" target)\n (cons \"start\" 2)\n (cons \"end\" 4)\n (cons \"content\" replacement))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-range-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"replace unbalanced span\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace_range reaches verified done\"\n result \"replace-range-ok\")\n (check-pred! \"verified-run: replace_range repairs unbalanced span\"\n (slurp target-path)\n (lambda (s)\n (and (str-contains? s \"(displayln \\\"fixed\\\")\")\n (str-contains? s \"(define (ok) 1)\")\n (not (str-contains? s \"(displayln \\\"bad\\\")\"))))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-syntax-guard.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [bad \"(import (jerboa prelude))\\n(define *score* 0)\\n(set!*score* 1)\\n\"]\n [good \"(import (jerboa prelude))\\n(define *score* 0)\\n(set! *score* 1)\\n\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [tool-results '()]\n [wf (coding-workflow (string-append \"test -s \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"content\" bad))\n #f))\n (list\n (make-wtool-call\n \"run\"\n '((\"path\" . \".\"))\n #f))\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"content\" good))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"syntax-guard-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"reject bad generated syntax\" resp\n (list (cons 'max-iterations 8)\n (cons 'max-tool-errors 3)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: syntax guard rejects then accepts repaired write\"\n result \"syntax-guard-ok\")\n (check! \"verified-run: syntax guard accepted corrected set! spacing\"\n (slurp target-path) good)\n\t (check-pred! \"verified-run: syntax guard explains missing whitespace\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (and (pair? xs)\n\t (str-contains? (car xs) \"missing whitespace after set!\"))))\n\t (check-pred! \"verified-run: rejected create redirects run back to edit\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (let loop ([ys xs])\n\t (cond\n\t [(null? ys) #f]\n\t [(and (str-contains? (car ys) \"file still does not exist\")\n\t (str-contains? (car ys) \"Next tool call must be edit\"))\n\t #t]\n\t [else (loop (cdr ys))])))))\n\t (guard (e [#t (void)]) (delete-file target-path)))\n\n\t(let* ([vr-dir \"/tmp\"]\n\t [target \"jcode-verified-snippet-create.ss\"]\n\t [target-path (string-append vr-dir \"/\" target)]\n\t [snippet \"(define (main) 1)\\n\"]\n\t [full \"(import (jerboa prelude))\\n(define (main) 1)\\n\"]\n\t [tool-results '()]\n\t [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n\t (guard (e [#t (void)]) (delete-file target-path))\n\t (let* ([scope (parse-write-scope target)]\n\t [wf (coding-workflow (string-append \"test -s \" target) vr-dir\n\t (list (cons 'write-scope scope)))]\n\t [resp (scripted-responder\n\t (list\n\t (list\n\t (make-wtool-call\n\t \"edit\"\n\t (list (cons \"path\" target)\n\t (cons \"old_str\" \"missing\")\n\t (cons \"new_str\" snippet))\n\t #f))\n\t (list\n\t (make-wtool-call\n\t \"edit\"\n\t (list (cons \"path\" target)\n\t (cons \"content\" full))\n\t #f))\n\t (list (make-wtool-call \"verify\" '() #f))\n\t (list (make-wtool-call \"done\" '((\"summary\" . \"snippet-create-guard\")) #f))))]\n\t [result (parameterize ((current-write-scope scope))\n\t (run-workflow wf \"reject snippet create for ss\" resp\n\t (list (cons 'max-iterations 8)\n\t (cons 'max-tool-errors 3)\n\t (cons 'on-message\n\t (lambda (m)\n\t (when (equal? (message-role m) \"tool\")\n\t (set! tool-results\n\t (cons (message-content m) tool-results))))))))])\n\t (check! \"verified-run: .ss replacement create rejects snippets\"\n\t result \"snippet-create-guard\")\n\t (check! \"verified-run: .ss snippet create eventually writes full file\"\n\t (slurp target-path) full)\n\t (check-pred! \"verified-run: .ss snippet create explains full-file requirement\"\n\t (reverse tool-results)\n\t (lambda (xs)\n\t (and (pair? xs)\n\t (str-contains? (car xs) \"missing .ss target requires complete file contents\")))))\n\t (guard (e [#t (void)]) (delete-file target-path)))\n\n\t(let* ([vr-dir \"/tmp\"]\n\t [target \"jcode-verified-syntax-guard-replace.ss\"]\n [target-path (string-append vr-dir \"/\" target)]\n [initial \"(import (jerboa prelude))\\n(define *window* #f)\\n(define (show) (qt-widget-show! *window*))\\n\"]\n [bad \"(qt-widget-show!*window*)\"]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (call-with-output-file target-path\n (lambda (o) (display initial o))\n 'replace)\n (let* ([scope (parse-write-scope target)]\n [tool-results '()]\n [wf (coding-workflow (string-append \"grep -q \\\"qt-widget-show!\\\" \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"(qt-widget-show! *window*)\")\n (cons \"new_str\" bad))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"syntax-guard-preserved\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"reject bad replacement syntax\" resp\n (list (cons 'max-iterations 8)\n (cons 'max-tool-errors 3)\n (cons 'on-message\n (lambda (m)\n (when (equal? (message-role m) \"tool\")\n (set! tool-results\n (cons (message-content m) tool-results))))))))])\n (check! \"verified-run: syntax guard rejected replacement but workflow recovered\"\n result \"syntax-guard-preserved\")\n (check! \"verified-run: rejected replacement preserved original file\"\n (slurp target-path) initial)\n (check-pred! \"verified-run: syntax guard explains qt missing whitespace\"\n (reverse tool-results)\n (lambda (xs)\n (and (pair? xs)\n (str-contains? (car xs) \"missing whitespace after qt-widget-show!\")))))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-empty-oldstr-create.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q created \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"\")\n (cons \"new_str\" \"created\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"empty-oldstr-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"create with empty old_str\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: empty old_str on missing file creates scoped file\"\n result \"empty-oldstr-ok\")\n (check! \"verified-run: empty old_str create wrote new_str\"\n (slurp target-path) \"created\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n(let* ([vr-dir \"/tmp\"]\n [target \"jcode-verified-replace-create.txt\"]\n [target-path (string-append vr-dir \"/\" target)]\n [slurp (lambda (p) (call-with-input-file p (lambda (i) (get-string-all i))))])\n (guard (e [#t (void)]) (delete-file target-path))\n (let* ([scope (parse-write-scope target)]\n [wf (coding-workflow (string-append \"grep -q replacement-created \" target) vr-dir\n (list (cons 'write-scope scope)))]\n [resp (scripted-responder\n (list\n (list\n (make-wtool-call\n \"edit\"\n (list (cons \"path\" target)\n (cons \"old_str\" \"missing-template\")\n (cons \"new_str\" \"replacement-created\"))\n #f))\n (list (make-wtool-call \"verify\" '() #f))\n (list (make-wtool-call \"done\" '((\"summary\" . \"replace-create-ok\")) #f))))]\n [result (parameterize ((current-write-scope scope))\n (run-workflow wf \"create with replace args\" resp\n (list (cons 'max-iterations 8))))])\n (check! \"verified-run: replace args on missing file create scoped file\"\n result \"replace-create-ok\")\n (check! \"verified-run: replace-create wrote new_str\"\n (slurp target-path) \"replacement-created\"))\n (guard (e [#t (void)]) (delete-file target-path)))\n\n;; ── grok-auth ─────────────────────────────────────────────────────\n;; Hermetic: drive the pure *-from helpers with JSON parsed from strings\n;; (string->json-object yields the same hashtables read-json produces), so no\n;; ~/.grok fixture files are needed.\n\n(section \"=== grok-auth ===\")\n\n;; iso8601->epoch: valid → number, ordering preserved, junk → #f.\n(check-pred! \"iso8601 valid → number\" (iso8601->epoch \"2026-05-28T02:15:10.5Z\") number?)\n(check! \"iso8601 junk → #f\" (iso8601->epoch \"not-a-date\") #f)\n(check! \"iso8601 non-string → #f\" (iso8601->epoch 12345) #f)\n(check! \"iso8601 ordering past<future\"\n (< (iso8601->epoch \"2020-01-01T00:00:00Z\")\n (iso8601->epoch \"2026-01-01T00:00:00Z\"))\n #t)\n\n;; auth.json: single fresh token.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-fresh\\\",\\\"expires_at\\\":\\\"2999-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: single fresh\" (grok-auth-token-from d) \"tok-fresh\")\n (check! \"grok expired?: fresh\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: expired token still returned (proxy will 401), expired? = #t.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-old\\\",\\\"expires_at\\\":\\\"2000-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: expired returned\" (grok-auth-token-from d) \"tok-old\")\n (check! \"grok expired?: expired\" (grok-auth-expired-from? d) #t))\n\n;; auth.json: multiple entries → prefer the non-expired one regardless of order.\n(let ([d (string->json-object\n \"{\\\"https://auth.x.ai::a\\\":{\\\"key\\\":\\\"tok-old\\\",\\\"expires_at\\\":\\\"2000-01-01T00:00:00Z\\\"},\\\"https://auth.x.ai::b\\\":{\\\"key\\\":\\\"tok-new\\\",\\\"expires_at\\\":\\\"2999-01-01T00:00:00Z\\\"}}\")])\n (check! \"grok token: prefer non-expired\" (grok-auth-token-from d) \"tok-new\")\n (check! \"grok expired?: multi has fresh\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: empty key is unusable; missing file / empty object → #f.\n(check! \"grok token: empty key → #f\"\n (grok-auth-token-from (string->json-object \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"\\\"}}\")) #f)\n(check! \"grok token: #f data → #f\" (grok-auth-token-from #f) #f)\n(check! \"grok token: empty object → #f\" (grok-auth-token-from (string->json-object \"{}\")) #f)\n\n;; auth.json: missing expires_at is conservatively NOT expired.\n(let ([d (string->json-object \"{\\\"https://auth.x.ai::u1\\\":{\\\"key\\\":\\\"tok-x\\\"}}\")])\n (check! \"grok token: no expires_at returned\" (grok-auth-token-from d) \"tok-x\")\n (check! \"grok expired?: no expires_at → #f\" (grok-auth-expired-from? d) #f))\n\n;; auth.json: non-prefixed key still usable as a fallback.\n(check! \"grok token: non-prefixed fallback\"\n (grok-auth-token-from (string->json-object \"{\\\"other\\\":{\\\"key\\\":\\\"tok-fb\\\"}}\")) \"tok-fb\")\n\n;; models_cache.json: full grok-build info.\n(let ([info (grok-model-info-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"model\\\":\\\"grok-build\\\",\\\"base_url\\\":\\\"https://cli-chat-proxy.grok.com/v1\\\",\\\"name\\\":\\\"Grok Build\\\",\\\"api_backend\\\":\\\"responses\\\",\\\"auth_scheme\\\":\\\"bearer\\\",\\\"context_window\\\":512000}}}}\")\n \"grok-build\")])\n (check! \"grok info base_url\" (grok-model-info-ref info \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\")\n (check! \"grok info api_backend\" (grok-model-info-ref info \"api_backend\" #f) \"responses\")\n (check! \"grok info auth_scheme\" (grok-model-info-ref info \"auth_scheme\" #f) \"bearer\")\n (check! \"grok info context_window\" (grok-model-info-ref info \"context_window\" #f) 512000)\n (check! \"grok info name\" (grok-model-info-ref info \"name\" #f) \"Grok Build\"))\n\n;; models_cache.json: missing fields fall back to hardcoded defaults.\n(let ([info (grok-model-info-from\n (string->json-object \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{}}}}\") \"grok-build\")])\n (check! \"grok info ctx fallback\" (grok-model-info-ref info \"context_window\" #f) 512000)\n (check! \"grok info backend fallback\" (grok-model-info-ref info \"api_backend\" #f) \"responses\")\n (check! \"grok info base_url fallback\" (grok-model-info-ref info \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\"))\n\n(check! \"grok info: missing model → #f\"\n (grok-model-info-from (string->json-object \"{\\\"models\\\":{}}\") \"grok-build\") #f)\n(check! \"grok info: #f data → #f\" (grok-model-info-from #f \"grok-build\") #f)\n\n;; The hardcoded fallback matches the observed grok-build metadata.\n(let ([fb (grok-fallback-model-info)])\n (check! \"grok fallback base_url\" (grok-model-info-ref fb \"base_url\" #f) \"https://cli-chat-proxy.grok.com/v1\")\n (check! \"grok fallback api_backend\" (grok-model-info-ref fb \"api_backend\" #f) \"responses\")\n (check! \"grok fallback context_window\" (grok-model-info-ref fb \"context_window\" #f) 512000))\n\n;; models_cache.json → (id . display) list; hidden models excluded; absent → ().\n(check! \"grok models-from list\"\n (grok-models-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"name\\\":\\\"Grok Build\\\"}}}}\"))\n '((\"grok-build\" . \"Grok Build\")))\n(check! \"grok models-from hides hidden\"\n (grok-models-from\n (string->json-object\n \"{\\\"models\\\":{\\\"grok-build\\\":{\\\"info\\\":{\\\"name\\\":\\\"Grok Build\\\"}},\\\"sekret\\\":{\\\"info\\\":{\\\"name\\\":\\\"Sekret\\\",\\\"hidden\\\":true}}}}\"))\n '((\"grok-build\" . \"Grok Build\")))\n(check! \"grok models-from #f → ()\" (grok-models-from #f) '())\n\n;; ── config: grok provider-key layers + detect order ──────────────\n;; The live config-get-provider-key reads real env / store / config / ~/.grok,\n;; so we test the *pure* helpers it dispatches through: provider-key-layers\n;; (precedence) and detect-provider-from-list (auto-detect order).\n\n(section \"=== config: grok provider key ===\")\n\n;; *provider-env-vars* maps both grok and xai to XAI_API_KEY (env-key-for-provider\n;; layers GROK_CODE_XAI_API_KEY on top for grok only).\n(check! \"env-vars: grok → XAI_API_KEY\"\n (cdr (assoc \"grok\" *provider-env-vars*)) \"XAI_API_KEY\")\n(check! \"env-vars: xai still → XAI_API_KEY\"\n (cdr (assoc \"xai\" *provider-env-vars*)) \"XAI_API_KEY\")\n\n;; provider-key-layers precedence: env > store > config > grok-fn (grok only).\n(check! \"layers: env wins\"\n (provider-key-layers \"grok\"\n (lambda (p) \"env-k\") (lambda (p) \"store-k\") (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"env-k\")\n(check! \"layers: store wins when env #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) \"store-k\") (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"store-k\")\n(check! \"layers: config wins when env+store #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) \"cfg-k\") (lambda () \"tok\"))\n \"cfg-k\")\n(check! \"layers: grok-fn last (only for grok)\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () \"tok\"))\n \"tok\")\n(check! \"layers: grok-fn NOT used for xai\"\n (provider-key-layers \"xai\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () \"tok\"))\n #f)\n(check! \"layers: nothing keyed → #f\"\n (provider-key-layers \"grok\"\n (lambda (p) #f) (lambda (p) #f) (lambda (p) #f) (lambda () #f))\n #f)\n\n;; detect-provider-from-list: grok is last so existing keyed providers win.\n(check! \"detect order: grok at the tail\"\n (car (reverse *detect-provider-order*)) \"grok\")\n(check! \"detect: skip until anthropic keyed\"\n (detect-provider-from-list *detect-provider-order*\n (lambda (p) (equal? p \"anthropic\")))\n \"anthropic\")\n(check! \"detect: grok picked when nothing else keyed\"\n (detect-provider-from-list *detect-provider-order*\n (lambda (p) (equal? p \"grok\")))\n \"grok\")\n(check! \"detect: nothing keyed → #f\"\n (detect-provider-from-list *detect-provider-order* (lambda (p) #f)) #f)\n\n;; ── models: grok metadata ─────────────────────────────────────────\n;; provider-default-models for \"grok\" returns whatever\n;; ~/.grok/models_cache.json holds, falling back to grok-models-fallback.\n;; Tests assert \"grok-build\" is present in both paths without depending on\n;; the user's actual ~/.grok contents.\n\n(section \"=== models: grok metadata ===\")\n\n(check-pred! \"all-providers contains grok\" (all-providers) (lambda (l) (member \"grok\" l)))\n(check-pred! \"all-providers still contains groq\" (all-providers) (lambda (l) (member \"groq\" l)))\n(check-pred! \"all-providers still contains xai\" (all-providers) (lambda (l) (member \"xai\" l)))\n\n(let* ([cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [mlx2 (make-hashtable equal-hash equal?)])\n (hashtable-set! mlx2 \"base_url\" \"http://192.168.6.84:8000/v1\")\n (hashtable-set! providers \"mlx2\" mlx2)\n (hashtable-set! cfg \"providers\" providers)\n (register-configured-providers! cfg)\n (check-pred! \"all-providers includes configured mlx2\"\n (all-providers)\n (lambda (l) (member \"mlx2\" l)))\n (check! \"provider-kind mlx2 = mlx\" (provider-kind \"mlx2\") \"mlx\")\n (check! \"local-provider? mlx2\" (local-provider? \"mlx2\") #t)\n (check! \"display name mlx2 aliases MLX\"\n (provider-display-name \"mlx2\") \"MLX (local) (mlx2)\")\n (register-configured-providers! (make-hashtable equal-hash equal?)))\n\n(let ([models '((\"anthropic/claude-sonnet-4\" . \"Claude Sonnet 4\")\n (\"openai/gpt-4o\" . \"GPT-4o\")\n (\"google/gemini-2.5-flash\" . \"Gemini 2.5 Flash\"))])\n (check! \"filter-models empty query returns all\"\n (filter-models models \"\")\n models)\n (check! \"filter-models matches id/display case-insensitively\"\n (map car (filter-models models \"CLAUDE sonnet\"))\n '(\"anthropic/claude-sonnet-4\"))\n (check! \"filter-models matches provider id\"\n (map car (filter-models models \"google flash\"))\n '(\"google/gemini-2.5-flash\")))\n\n(check! \"display name grok = Grok CLI\" (provider-display-name \"grok\") \"Grok CLI\")\n(check! \"display name xai unchanged\" (provider-display-name \"xai\") \"xAI (Grok)\")\n(check! \"default model grok = grok-build\" (provider-default-model \"grok\") \"grok-build\")\n(check! \"default model xai unchanged\" (provider-default-model \"xai\") \"grok-3-mini\")\n\n(check-pred! \"default models grok includes grok-build\"\n (provider-default-models \"grok\")\n (lambda (ms) (assoc \"grok-build\" ms)))\n\n(check! \"ctx window grok-build = 512000\" (model-context-window \"grok-build\") 512000)\n(check! \"ctx window grok-3 unaffected (no clause)\" (model-context-window \"grok-3\") #f)\n(check! \"ctx window qwen3-coder-next mlx conservative\"\n (model-context-window \"/Users/user/models/qwen3-coder-next-mlx\") 3072)\n(check! \"ctx window generic qwen3 remains 32768\"\n (model-context-window \"qwen3:8b-q4_K_M\") 32768)\n\n;; ── provider: grok Responses adapter ──────────────────────────────\n;; All hermetic — tests drive the pure helpers exported by the provider\n;; module (responses-{headers,body,parse-response}, message->responses-input,\n;; grok-backend-from, grok-list-models). No live HTTP.\n\n(section \"=== provider: grok Responses ===\")\n\n;; grok-backend-from: cache says responses by default; chat_completions when set.\n(check! \"grok-backend-from default → responses\" (grok-backend-from '()) \"responses\")\n(check! \"grok-backend-from chat_completions\"\n (grok-backend-from '((\"api_backend\" . \"chat_completions\"))) \"chat_completions\")\n(check! \"grok-backend-from responses\"\n (grok-backend-from '((\"api_backend\" . \"responses\"))) \"responses\")\n\n;; responses-headers: Bearer token; no secret in the table key/value besides\n;; the Authorization line.\n(let ([h (responses-headers (make-provider \"grok\" \"abc123\" \"grok-build\" \"https://x/v1\"))])\n (check! \"responses-headers content-type\"\n (cdr (assoc \"Content-Type\" h)) \"application/json\")\n (check! \"responses-headers bearer\"\n (cdr (assoc \"Authorization\" h)) \"Bearer abc123\"))\n\n;; message->responses-input: role + content; tool maps to user (no tools yet).\n(let ([u (message->responses-input (make-user-message \"hi\"))])\n (check! \"msg→resp role=user\" (hashtable-ref u \"role\" #f) \"user\")\n (check! \"msg→resp content=hi\" (hashtable-ref u \"content\" #f) \"hi\"))\n(let ([a (message->responses-input (make-assistant-message \"out\"))])\n (check! \"msg→resp role=assistant\" (hashtable-ref a \"role\" #f) \"assistant\")\n (check! \"msg→resp content=out\" (hashtable-ref a \"content\" #f) \"out\"))\n(let ([s (message->responses-input (make-system-message \"sys\"))])\n (check! \"msg→resp role=system\" (hashtable-ref s \"role\" #f) \"system\"))\n(let ([t (message->responses-input (make-tool-result \"cid\" \"result-text\"))])\n (check! \"msg→resp tool→user\" (hashtable-ref t \"role\" #f) \"user\")\n (check! \"msg→resp tool content\" (hashtable-ref t \"content\" #f) \"result-text\"))\n\n;; responses-body: model + input present; tools deliberately NOT serialized\n;; (first-pass scope — Responses tool spec unverified against cli-chat-proxy).\n(let* ([p (make-provider \"grok\" \"k\" \"grok-build\" \"https://x/v1\")]\n [b (responses-body p (list (make-user-message \"hi\")) '())])\n (check! \"responses-body model\" (hashtable-ref b \"model\" #f) \"grok-build\")\n (check-pred! \"responses-body input list\" (hashtable-ref b \"input\" #f) list?)\n (check! \"responses-body no tools (empty tools)\"\n (hashtable-ref b \"tools\" #f) #f))\n(let* ([p (make-provider \"grok\" \"k\" \"grok-build\" \"https://x/v1\")]\n [b (responses-body p '() (list (make-hashtable equal-hash equal?)))])\n (check! \"responses-body no tools (non-empty tools still skipped)\"\n (hashtable-ref b \"tools\" #f) #f))\n\n;; responses-parse-response: plain text → assistant message, no tool calls.\n(let ([m (responses-parse-response\n (string->json-object\n \"{\\\"output\\\":[{\\\"type\\\":\\\"message\\\",\\\"role\\\":\\\"assistant\\\",\\\"content\\\":[{\\\"type\\\":\\\"output_text\\\",\\\"text\\\":\\\"Hello world\\\"}]}]}\"))])\n (check! \"responses-parse text\" (message-content m) \"Hello world\")\n (check! \"responses-parse no tcs\" (message-tool-calls m) #f))\n\n;; responses-parse-response: function_call output items become tool calls.\n(let ([m (responses-parse-response\n (string->json-object\n \"{\\\"output\\\":[{\\\"type\\\":\\\"function_call\\\",\\\"id\\\":\\\"call_1\\\",\\\"name\\\":\\\"search\\\",\\\"arguments\\\":\\\"{\\\\\\\"q\\\\\\\":\\\\\\\"x\\\\\\\"}\\\"}]}\"))])\n (check-pred! \"responses-parse fc → tcs\"\n (message-tool-calls m) (lambda (tcs) (and (pair? tcs) (= 1 (length tcs)))))\n (let ([tc (car (message-tool-calls m))])\n (check! \"responses-parse fc name\" (tool-call-name tc) \"search\")\n (check! \"responses-parse fc id\" (tool-call-id tc) \"call_1\")))\n\n;; responses-parse-response: empty output → empty content, no tcs.\n(let ([m (responses-parse-response (string->json-object \"{\\\"output\\\":[]}\"))])\n (check! \"responses-parse empty text\" (message-content m) \"\")\n (check! \"responses-parse empty no tcs\" (message-tool-calls m) #f))\n\n;; grok-list-models: always includes grok-build (cache or fallback).\n(check-pred! \"grok-list-models has grok-build\"\n (grok-list-models (make-provider \"grok\" \"\" \"grok-build\" \"https://x/v1\"))\n (lambda (ms) (assoc \"grok-build\" ms)))\n\n;; ── provider: Google prompt cache accounting ───────────────────────\n\n(section \"=== provider: Google prompt cache accounting ===\")\n\n(let* ([body (string-append\n \"{\\\"candidates\\\":[{\\\"content\\\":{\\\"parts\\\":[{\\\"text\\\":\\\"hello\\\"}]}}],\"\n \"\\\"usageMetadata\\\":{\\\"promptTokenCount\\\":100,\"\n \"\\\"cachedContentTokenCount\\\":75,\"\n \"\\\"candidatesTokenCount\\\":4,\"\n \"\\\"thoughtsTokenCount\\\":6,\"\n \"\\\"totalTokenCount\\\":110}}\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1beta\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [google (make-hashtable equal-hash equal?)])\n (hashtable-set! google \"cached_content\" \"cachedContents/unit\")\n (hashtable-set! providers \"google\" google)\n (hashtable-set! cfg \"providers\" providers)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-json! srv captured 200 body)\n (let* ([p (make-provider \"google\" \"unit-key\" \"gemini-2.5-flash\" base-url)]\n [result (call-with-values\n (lambda ()\n (parameterize ([*config* cfg])\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f))))\n (lambda (content tcs usage) (list content tcs usage)))]\n [req (vector-ref captured 0)]\n [usage (list-ref result 2)])\n (check! \"google stream cache reply\" (car result) \"hello\")\n (check! \"google explicit cachedContent forwarded\"\n (and req\n (str-contains? req \"\\\"cachedContent\\\"\")\n (str-contains? req \"cachedContents/unit\"))\n #t)\n (check! \"google stream tokens-in\"\n (cdr (assoc 'tokens-in usage)) 100)\n (check! \"google stream tokens-out includes thoughts\"\n (cdr (assoc 'tokens-out usage)) 10)\n (check! \"google stream cache-read\"\n (cdr (assoc 'cache-read usage)) 75)\n (check! \"google stream cache-creation zero\"\n (cdr (assoc 'cache-creation usage)) 0)\n (check-pred! \"google stream cache cost positive\"\n (cdr (assoc 'cost usage))\n (lambda (x) (and (number? x) (> x 0))))))\n (lambda () (tcp-close srv))))\n\n;; ── provider: streaming HTTP error bodies ─────────────────────────\n\n(section \"=== provider: streaming HTTP error bodies ===\")\n\n(let* ([ndjson-body (string-append\n \"{\\\"model\\\":\\\"unit\\\",\\\"message\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"done\\\":false}\\n\"\n \"{\\\"model\\\":\\\"unit\\\",\\\"done\\\":true,\\\"prompt_eval_count\\\":100,\\\"eval_count\\\":2,\"\n \"\\\"prompt_eval_duration\\\":123,\\\"eval_duration\\\":456,\\\"load_duration\\\":7,\"\n \"\\\"total_duration\\\":586}\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [expert (make-hashtable equal-hash equal?)]\n [esc (make-hashtable equal-hash equal?)]\n [tool (make-hashtable equal-hash equal?)]\n [fn (make-hashtable equal-hash equal?)]\n [params (make-hashtable equal-hash equal?)])\n (hashtable-set! esc \"request_logprobs\" #t)\n (hashtable-set! expert \"escalation\" esc)\n (hashtable-set! cfg \"expert\" expert)\n (hashtable-set! params \"type\" \"object\")\n (hashtable-set! fn \"name\" \"lookup\")\n (hashtable-set! fn \"description\" \"lookup\")\n (hashtable-set! fn \"parameters\" params)\n (hashtable-set! tool \"type\" \"function\")\n (hashtable-set! tool \"function\" fn)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-json! srv captured 200 ndjson-body)\n (let* ([p (make-provider \"ollama\" \"\" \"unit-test-model\" base-url)]\n [result (call-with-values\n (lambda ()\n (parameterize ([*config* cfg])\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n (list tool)\n (lambda (token) #f))))\n (lambda (content tcs usage) (list content tcs usage)))]\n [req (vector-ref captured 0)])\n (check! \"ollama native stream tools reply\" (car result) \"ok\")\n (check! \"ollama native stream uses keep_alive\"\n (and req (str-contains? req \"\\\"keep_alive\\\"\")) #t)\n (check! \"ollama native stream uses native stream flag\"\n (and req (str-contains? req \"\\\"stream\\\":true\")) #t)\n (check! \"ollama native stream tools include tools\"\n (and req (str-contains? req \"\\\"tools\\\"\")) #t)\n (check! \"ollama native stream tools omit logprobs\"\n (and req (str-contains? req \"\\\"logprobs\\\"\")) #f)\n (check! \"ollama native stream tools omit top_logprobs\"\n (and req (str-contains? req \"\\\"top_logprobs\\\"\")) #f)\n (check! \"ollama native stream omits OpenAI stream options\"\n (and req (str-contains? req \"\\\"stream_options\\\"\")) #f)\n (check! \"ollama native stream omits unsupported prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #f)\n (check! \"ollama native stream tokens-in\"\n (cdr (assoc 'tokens-in (list-ref result 2))) 100)\n (check! \"ollama native stream tokens-out\"\n (cdr (assoc 'tokens-out (list-ref result 2))) 2)\n (check! \"ollama native stream cache-read unavailable\"\n (cdr (assoc 'cache-read (list-ref result 2))) 0)))\n (lambda () (tcp-close srv))))\n\n(let* ([sse-body (string-append\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"finish_reason\\\":null}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{},\\\"finish_reason\\\":\\\"stop\\\"}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[],\\\"usage\\\":{\\\"prompt_tokens\\\":100,\\\"completion_tokens\\\":2,\\\"prompt_tokens_details\\\":{\\\"cached_tokens\\\":42}}}\\n\\n\"\n \"data: [DONE]\\n\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-sse! srv captured sse-body)\n (let* ([p (make-provider \"mlx\" \"\" \"unit-test-model\" base-url)]\n [result (call-with-values\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f)))\n (lambda (content tcs usage) (cons content usage)))]\n [req (vector-ref captured 0)]\n [usage (cdr result)]\n [cache-hit (assoc 'cache-read usage)])\n (check! \"mlx stream cache reply\" (car result) \"ok\")\n (check! \"mlx stream prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #t)\n (check! \"mlx stream cached token accounting\"\n (and cache-hit (cdr cache-hit)) 42)))\n (lambda () (tcp-close srv))))\n\n(let* ([sse-body (string-append\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{\\\"role\\\":\\\"assistant\\\",\\\"content\\\":\\\"ok\\\"},\\\"finish_reason\\\":null}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[{\\\"index\\\":0,\\\"delta\\\":{},\\\"finish_reason\\\":\\\"stop\\\"}]}\\n\\n\"\n \"data: {\\\"id\\\":\\\"chatcmpl-test\\\",\\\"object\\\":\\\"chat.completion.chunk\\\",\\\"created\\\":0,\\\"model\\\":\\\"unit\\\",\\\"choices\\\":[],\\\"usage\\\":{\\\"prompt_tokens\\\":100,\\\"completion_tokens\\\":2,\\\"prompt_tokens_details\\\":{\\\"cached_tokens\\\":42}}}\\n\\n\"\n \"data: [DONE]\\n\\n\")]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [captured (vector #f)]\n [cfg (make-hashtable equal-hash equal?)]\n [providers (make-hashtable equal-hash equal?)]\n [mlx2 (make-hashtable equal-hash equal?)])\n (hashtable-set! mlx2 \"base_url\" base-url)\n (hashtable-set! providers \"mlx2\" mlx2)\n (hashtable-set! cfg \"providers\" providers)\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-captured-sse! srv captured sse-body)\n (let* ([p (parameterize ([*config* cfg])\n (make-provider \"mlx2\" \"\" \"unit-test-model\"))]\n [result (call-with-values\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f)))\n (lambda (content tcs usage) (cons content usage)))]\n [req (vector-ref captured 0)])\n (check! \"mlx2 configured base_url\"\n (provider-base-url p) base-url)\n (check! \"mlx2 stream keyless alias reply\" (car result) \"ok\")\n (check! \"mlx2 stream prompt cache key\"\n (and req (str-contains? req \"\\\"prompt_cache_key\\\"\")) #t)))\n (lambda () (tcp-close srv))))\n\n(let* ([body \"{\\\"error\\\":{\\\"message\\\":\\\"unexpected EOF while reading stream; context window exhausted while decoding response!!\\\"}}\"]\n [srv (tcp-listen \"127.0.0.1\" 0)]\n [base-url (format \"http://127.0.0.1:~a/v1\" (tcp-server-port srv))]\n [chunk-size (number->string (string-length body) 16)])\n (dynamic-wind\n (lambda () (void))\n (lambda ()\n (serve-one-chunked-500! srv body)\n (let* ([p (make-provider \"ollama\" \"\" \"unit-test-model\" base-url)]\n [err (condition->string\n (lambda ()\n (provider-stream-chat\n p\n (list (make-user-message \"hi\"))\n '()\n (lambda (token) #f))))])\n (check-pred! \"stream chunked 500 raises\" err string?)\n (check-pred! \"stream chunked 500 includes status\"\n err\n (lambda (s) (and (string? s)\n (str-contains? s \"API error 500:\"))))\n (check-pred! \"stream chunked 500 keeps body\"\n err\n (lambda (s) (and (string? s)\n (str-contains? s \"unexpected EOF\"))))\n (check! \"stream chunked 500 strips chunk-size\"\n (and (string? err)\n (str-contains? err\n (string-append \"API error 500: \"\n chunk-size)))\n #f)\n (check! \"stream chunked 500 strips terminator\"\n (and (string? err) (str-contains? err \"\\n0\"))\n #f)))\n (lambda () (tcp-close srv))))\n\n;; ── secrets-import: grok known-providers entry ────────────────────\n;; *known-providers* (secrets-import) is the single-env-var-per-provider\n;; mapping used by import-from-env! / aider import / interactive prompts.\n;; For \"grok\" we pick GROK_CODE_XAI_API_KEY so it does not duplicate xai's\n;; XAI_API_KEY entry; runtime config-get-provider-key accepts BOTH names.\n\n(section \"=== secrets-import: grok ===\")\n\n(check! \"*known-providers* maps grok → GROK_CODE_XAI_API_KEY\"\n (cdr (assoc \"grok\" *known-providers*)) \"GROK_CODE_XAI_API_KEY\")\n(check! \"*known-providers* still maps xai → XAI_API_KEY\"\n (cdr (assoc \"xai\" *known-providers*)) \"XAI_API_KEY\")\n(check-pred! \"*known-providers* still contains anthropic\"\n *known-providers* (lambda (l) (assoc \"anthropic\" l)))\n\n;; ── external-llm: /ask-grok + sandbox paths ───────────────────────\n;; The Grok CLI integration adds:\n;; - grok to (external-llm-providers)\n;; - ~/.grok writable for the grok provider; denied for every other one\n;; - parse-grok-json reads text + sessionId out of `grok -p ... --json` output\n;; Tests do NOT spawn the CLI (it may not be installed); they drive the pure\n;; helpers we exported for this purpose.\n\n(section \"=== external-llm: grok ===\")\n\n(check-pred! \"external-llm-providers includes grok\"\n (external-llm-providers) (lambda (l) (memq 'grok l)))\n(check-pred! \"external-llm-providers still includes claude\"\n (external-llm-providers) (lambda (l) (memq 'claude l)))\n\n;; macOS sandbox-exec wraps commands after Jerboa's normal PATH search, so the\n;; external runner must resolve provider argv[0] to an absolute path first.\n(let ([argv (resolve-external-argv '(\"sh\" \"-c\" \"true\"))])\n (check! \"external argv resolution preserves args\" (cdr argv) '(\"-c\" \"true\"))\n (check-pred! \"external argv resolution makes argv0 absolute\"\n (car argv)\n (lambda (s) (and (string? s) (str-prefix? \"/\" s))))\n (check-pred! \"external support paths include resolved argv0\"\n (external-command-support-paths '(\"sh\" \"-c\" \"true\"))\n (lambda (ps) (and (member (car argv) ps) #t))))\n\n(check! \"external argv resolution leaves missing command unchanged\"\n (resolve-external-argv '(\"jcode-definitely-missing-provider-cli\"))\n '(\"jcode-definitely-missing-provider-cli\"))\n\n(check-pred! \"external launch env includes PATH\"\n (external-launch-env '())\n (lambda (env) (and (assoc \"PATH\" env) #t)))\n(check! \"external launch env omits ambient OpenAI key\"\n (assoc \"OPENAI_API_KEY\" (external-launch-env '()))\n #f)\n(check! \"external launch env omits ambient Anthropic key\"\n (assoc \"ANTHROPIC_API_KEY\" (external-launch-env '()))\n #f)\n\n;; Sandbox: grok's own auth paths cover ~/.grok.\n(check-pred! \"grok auth paths include ~/.grok\"\n (provider-auth-paths 'grok)\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \".grok\") #t]\n [else (lp (cdr p))]))))\n\n;; Sandbox: when grok is the chosen CLI, its own ~/.grok is NOT denied,\n;; but every other CLI's auth dir IS.\n(define grok-deny (sensitive-deny-paths 'grok))\n(check-pred! \"grok sandbox denies ~/.claude\"\n grok-deny\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \".claude\") #t]\n [else (lp (cdr p))]))))\n(check! \"grok sandbox does NOT deny its own ~/.grok\"\n (let lp ([p grok-deny])\n (cond [(null? p) #f]\n [(str-contains? (car p) \"/.grok\") #t]\n [else (lp (cdr p))]))\n #f)\n\n;; Sandbox: when claude is the chosen CLI, ~/.grok IS denied (cross-CLI\n;; auth isolation — a malicious or compromised claude CLI cannot lift the\n;; Grok bearer token).\n(define claude-deny (sensitive-deny-paths 'claude))\n(check-pred! \"claude sandbox denies ~/.grok\"\n claude-deny\n (lambda (ps)\n (let lp ([p ps])\n (cond [(null? p) #f]\n [(str-contains? (car p) \"/.grok\") #t]\n [else (lp (cdr p))]))))\n\n;; parse-grok-json: extracts text + sessionId; fallback session-id when missing.\n(let ([r (parse-grok-json\n \"{\\\"text\\\":\\\"Hello!\\\",\\\"sessionId\\\":\\\"sid-1\\\",\\\"stopReason\\\":\\\"end_turn\\\"}\"\n \"fallback-sid\")])\n (check! \"parse-grok-json text\" (ext-result-text r) \"Hello!\")\n (check! \"parse-grok-json sessionId\" (ext-result-session-id r) \"sid-1\")\n (check! \"parse-grok-json no error\" (ext-result-error? r) #f))\n(let ([r (parse-grok-json \"{\\\"text\\\":\\\"Hi\\\"}\" \"fallback-sid\")])\n (check! \"parse-grok-json fallback sid\" (ext-result-session-id r) \"fallback-sid\"))\n(let ([r (parse-grok-json \"not json\" \"sid-x\")])\n (check! \"parse-grok-json non-json → raw\" (ext-result-text r) \"not json\")\n (check! \"parse-grok-json non-json sid\" (ext-result-session-id r) \"sid-x\"))\n\n;; ── Agent definitions (core/agent-defs.ss) ────────────────────────\n\n(printf \"~nagent-defs:~n\")\n\n;; Built-ins resolve; unknown doesn't.\n(check! \"builtin agent names\"\n (map agent-def-name (builtin-agent-defs))\n '(\"delegate\" \"doc-explorer\" \"implementer\"))\n(check-pred! \"agent-def-lookup delegate\" (agent-def-lookup \"delegate\") agent-def?)\n(check! \"agent-def-lookup unknown\" (agent-def-lookup \"nope\") #f)\n(check! \"agent-def-lookup non-string\" (agent-def-lookup 42) #f)\n(check! \"delegate scope is none\"\n (agent-def-write-scope (agent-def-lookup \"delegate\")) 'none)\n(check! \"doc-explorer scope\"\n (agent-def-write-scope (agent-def-lookup \"doc-explorer\"))\n '(\"docs/\" \"plans/\"))\n(check! \"implementer scope unrestricted\"\n (agent-def-write-scope (agent-def-lookup \"implementer\")) #f)\n\n;; parse-write-scope normalization.\n(check! \"parse-write-scope none\" (parse-write-scope \"none\") 'none)\n(check! \"parse-write-scope all\" (parse-write-scope \"all\") #f)\n(check! \"parse-write-scope list\" (parse-write-scope '(\"docs/\")) '(\"docs/\"))\n(check! \"parse-write-scope comma string\"\n (parse-write-scope \"src/tetris/, tests/tetris/\")\n '(\"src/tetris/\" \"tests/tetris/\"))\n(check! \"parse-write-scope junk\" (parse-write-scope 17) #f)\n\n;; parse-agent-def: extends-style inheritance + overrides.\n(let* ([spec (let ([h (make-hashtable equal-hash equal?)])\n (hashtable-set! h \"model\" \"test-model\")\n h)]\n [d (parse-agent-def \"delegate-strong\" spec (agent-def-lookup \"delegate\"))])\n (check! \"variant inherits scope\" (agent-def-write-scope d) 'none)\n (check! \"variant overrides model\" (agent-def-model d) \"test-model\")\n (check-pred! \"variant inherits prompt\" (agent-def-prompt d)\n (lambda (p) (and (string? p) (> (string-length p) 0)))))\n(let* ([spec (let ([h (make-hashtable equal-hash equal?)])\n (hashtable-set! h \"write_scope\" \"all\")\n h)]\n [d (parse-agent-def \"doc-all\" spec (agent-def-lookup \"doc-explorer\"))])\n (check! \"write_scope all overrides base\" (agent-def-write-scope d) #f))\n(let ([d (parse-agent-def \"bare\" (make-hashtable equal-hash equal?) #f)])\n (check! \"bare def gets default description\" (agent-def-description d)\n \"user-defined agent\")\n (check! \"bare def unrestricted\" (agent-def-write-scope d) #f))\n\n;; write-scope-allows? matching.\n(check! \"scope #f allows\" (write-scope-allows? #f \"src/x.ss\") #t)\n(check! \"scope none refuses\" (write-scope-allows? 'none \"docs/x.md\") #f)\n(check! \"scope match\" (write-scope-allows? '(\"docs/\" \"plans/\") \"docs/a.md\") #t)\n(check! \"scope exact file match\" (write-scope-allows? '(\"Makefile\") \"Makefile\") #t)\n(check! \"scope boundary blocks sibling prefix\"\n (write-scope-allows? '(\"src/app\") \"src/application/x.ss\") #f)\n(check! \"scope directory without slash allows children\"\n (write-scope-allows? '(\"src/app\") \"src/app/main.ss\") #t)\n(check! \"scope ./ normalized\" (write-scope-allows? '(\"docs/\") \"./docs/a.md\") #t)\n(check! \"scope miss\" (write-scope-allows? '(\"docs/\") \"src/a.ss\") #f)\n(check! \"scope abs path under cwd\"\n (write-scope-allows? '(\"docs/\")\n (string-append (current-directory) \"/docs/a.md\"))\n #t)\n(check! \"scope intersect keeps bounded child\"\n (write-scope-intersect '(\"src\") '(\"src/app\"))\n '(\"src/app\"))\n(check! \"scope intersect rejects sibling prefix\"\n (write-scope-intersect '(\"src/app\") '(\"src/application\"))\n 'none)\n(check-pred! \"strict-ladder builtin skill available\"\n (builtin-skill \"strict-ladder\")\n (lambda (s) (and (string? s) (> (string-length s) 0))))\n(check! \"scope abs path outside cwd\"\n (write-scope-allows? '(\"docs/\") \"/tmp/docs/a.md\") #f)\n(check! \"scope non-string path\" (write-scope-allows? '(\"docs/\") 42) #f)\n\n;; write-scope-intersect: nesting can only narrow.\n(check! \"intersect parent #f\" (write-scope-intersect #f '(\"docs/\")) '(\"docs/\"))\n(check! \"intersect child #f\" (write-scope-intersect '(\"docs/\") #f) '(\"docs/\"))\n(check! \"intersect none wins\" (write-scope-intersect 'none #f) 'none)\n(check! \"intersect narrows\"\n (write-scope-intersect '(\"docs/\" \"plans/\") '(\"docs/modules/\"))\n '(\"docs/modules/\"))\n(check! \"intersect disjoint -> none\"\n (write-scope-intersect '(\"docs/\") '(\"src/\")) 'none)\n\n;; write-scope-error honors the current-write-scope parameter.\n(check! \"scope-error unrestricted\" (write-scope-error \"write\" \"src/x.ss\") #f)\n(parameterize ([current-write-scope '(\"docs/\")])\n (check! \"scope-error inside scope\" (write-scope-error \"write\" \"docs/x.md\") #f)\n (check-pred! \"scope-error outside scope\"\n (write-scope-error \"write\" \"src/x.ss\")\n (lambda (s) (and (string? s) (str-contains? s \"write scope\")))))\n\n;; Context-disabled tools: sub-agents use this to hide task from prompts,\n;; structured schemas, text-tool recovery, and direct execution.\n(init-task-tool)\n(define (schema-by-name schemas wanted)\n (let loop ([xs schemas])\n (cond [(null? xs) #f]\n [else\n (let* ([fn (hashtable-ref (car xs) \"function\" #f)]\n [name (and fn (hashtable-ref fn \"name\" #f))])\n (if (equal? name wanted) (car xs) (loop (cdr xs))))])))\n\n(parameterize ([current-disabled-tools '(\"task\")])\n (check! \"disabled task hidden from list-tools\"\n (and (member \"task\" (list-tools)) #t) #f)\n (check! \"disabled task hidden from tool-exists?\"\n (tool-exists? \"task\") #f)\n (check! \"disabled task hidden from schemas\"\n (let loop ([schemas (get-tool-schemas)])\n (cond [(null? schemas) #f]\n [else\n (let* ([fn (hashtable-ref (car schemas) \"function\" #f)]\n [name (and fn (hashtable-ref fn \"name\" #f))])\n (if (equal? name \"task\") #t (loop (cdr schemas))))]))\n #f)\n (check-pred! \"disabled task execution rejected\"\n (tool-execute \"task\" (args \"description\" \"x\" \"prompt\" \"x\"))\n (lambda (s) (str-contains? s \"unavailable in this context\"))))\n\n(parameterize ([current-tool-allowlist '(\"read\")])\n (check! \"allowlist hides task from list-tools\"\n (and (member \"task\" (list-tools)) #t) #f)\n (check! \"allowlist hides task from tool-exists?\"\n (tool-exists? \"task\") #f)\n (check-pred! \"allowlist execution rejected\"\n (tool-execute \"task\" (args \"description\" \"x\" \"prompt\" \"x\"))\n (lambda (s) (str-contains? s \"unavailable in this context\"))))\n\n(parameterize ([current-compact-tool-schemas #t]\n [current-tool-allowlist '(\"task\")])\n (let* ([schema (schema-by-name (get-tool-schemas) \"task\")]\n [fn (and schema (hashtable-ref schema \"function\" #f))]\n [params (and fn (hashtable-ref fn \"parameters\" #f))]\n [props (and params (hashtable-ref params \"properties\" #f))]\n [desc-prop (and props (hashtable-ref props \"description\" #f))])\n (check! \"compact schema keeps task visible\" (and schema #t) #t)\n (check! \"compact schema omits function description\"\n (hashtable-ref fn \"description\" #f) \"\")\n (check! \"compact schema keeps required args\"\n (hashtable-ref params \"required\" #f)\n '(\"description\" \"prompt\"))\n (check! \"compact schema omits property description\"\n (hashtable-ref desc-prop \"description\" #f) #f)))\n\n(parameterize ([current-compact-agent-context #t])\n (check-pred! \"compact system prompt uses structured schema note\"\n (system-prompt)\n (lambda (s) (str-contains? s \"Structured function tools are available\"))))\n\n;; Task session store: put / resume-shape / eviction cap.\n(task-session-clear!)\n(task-session-put! \"t1\" \"delegate\" '(m1 m2))\n(check-pred! \"task session stored\"\n (hashtable-ref (task-session-store) \"t1\" #f)\n (lambda (v) (and (vector? v)\n (equal? (vector-ref v 1) \"delegate\")\n (equal? (vector-ref v 2) '(m1 m2)))))\n(do ([i 0 (+ i 1)]) ((= i 40))\n (task-session-put! (format \"evict-~a\" i) #f '()))\n(check! \"task session cap evicts oldest\"\n (hashtable-ref (task-session-store) \"t1\" #f) #f)\n(check-pred! \"task session newest survives\"\n (hashtable-ref (task-session-store) \"evict-39\" #f) vector?)\n(task-session-put! \"scoped\" \"implementer\" '(m1) '(\"src/\"))\n(check! \"task session stores write scope\"\n (vector-ref (hashtable-ref (task-session-store) \"scoped\" #f) 3)\n '(\"src/\"))\n(task-session-clear!)\n\n;; Plan-lifecycle builtin skills present.\n(check! \"plan skills builtin\"\n (builtin-skill-list)\n '(\"create-plan\" \"execute-work-package\" \"generate-handover\"\n \"resume-plan\" \"review-plan\" \"save-discoveries\" \"strict-ladder\"))\n(check-pred! \"create-plan prompt mentions plans/\"\n (builtin-skill \"create-plan\")\n (lambda (s) (str-contains? s \"plans/\")))\n\n;; ── Slash-command completion coverage ─────────────────────────────\n;; Every command the TUI dispatcher (handle-slash-command! in tui.ss)\n;; accepts must appear in the completion popup (*slash-commands* in\n;; tui-input.ss). Scans the SOURCE text so adding a new\n;; (equal? cmd \"...\") / (string-prefix? \"... \" cmd) clause without a\n;; completion entry fails the suite.\n\n(define (slurp-file path)\n (call-with-input-file path (lambda (p) (get-string-all p))))\n\n(define (str-find src needle start)\n (let ([nl (string-length needle)] [sl (string-length src)])\n (let loop ([i start])\n (cond\n [(> (+ i nl) sl) #f]\n [(string=? (substring src i (+ i nl)) needle) i]\n [else (loop (+ i 1))]))))\n\n(define (collect-quoted src marker require-cmd-after?)\n ;; For each MARKER occurrence, the text up to the next double-quote.\n ;; With require-cmd-after?, keep only matches whose quote is followed\n ;; by \" cmd)\" -- filters dispatcher clauses from unrelated\n ;; string-prefix? calls.\n (let ([mlen (string-length marker)])\n (let loop ([i 0] [acc '()])\n (let ([hit (str-find src marker i)])\n (if (not hit)\n (reverse acc)\n (let* ([s (+ hit mlen)]\n [q (str-find src \"\\\"\" s)])\n (if (not q)\n (reverse acc)\n (let ([keep? (or (not require-cmd-after?)\n (and (<= (+ q 6) (string-length src))\n (string=? (substring src (+ q 1) (+ q 6))\n \" cmd)\")))])\n (loop (+ q 1)\n (if keep? (cons (substring src s q) acc) acc))))))))))\n\n(define (strip-trailing-space s)\n (let ([n (string-length s)])\n (if (and (> n 0) (char=? (string-ref s (- n 1)) #\\space))\n (substring s 0 (- n 1))\n s)))\n\n(define (dedupe lst)\n (let loop ([l lst] [acc '()])\n (cond\n [(null? l) (reverse acc)]\n [(member (car l) acc) (loop (cdr l) acc)]\n [else (loop (cdr l) (cons (car l) acc))])))\n\n(let* ([tui-src (slurp-file \"src/jcode/ui/tui.ss\")]\n [input-src (slurp-file \"src/jcode/ui/tui-input.ss\")]\n [dispatcher (dedupe\n (map strip-trailing-space\n (append\n (collect-quoted tui-src \"(equal? cmd \\\"\" #f)\n (collect-quoted tui-src \"(string-prefix? \\\"\" #t))))]\n [completions (collect-quoted input-src \"(\\\"/\" #f)])\n (check-pred! \"dispatcher commands found by source scan\"\n dispatcher\n (lambda (d) (> (length d) 30)))\n (for-each\n (lambda (cmd)\n (check-pred! (format \"completion popup has /~a\" cmd)\n completions\n (lambda (cs) (and (member cmd cs) #t))))\n dispatcher))\n\n;; ── Results ───────────────────────────────────────────────────────\n\n(printf \"~n~a passed, ~a failed~n\" pass-count fail-count)\n(when (> fail-count 0) (exit 1))\n"} --- a/training_data.jsonl +++ b/training_data.jsonl @@ -37942,7 +37942,7 @@ {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Misc Sugar in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```"}], "source": "doc:AGENTS.md:Misc Sugar"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```"}], "source": "doc:AGENTS.md:What's NOT in the Prelude (requires sepa"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme."}, {"role": "assistant", "content": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---"}], "source": "doc:AGENTS.md:Chez Scheme Conflicts (handled by prelud"} -{"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}], "source": "doc:AGENTS.md:Repository Boundaries"} +{"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}], "source": "doc:AGENTS.md:Repository Boundaries"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Build & Verification in Jerboa Scheme."}, {"role": "assistant", "content": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions."}], "source": "doc:AGENTS.md:Build & Verification"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Stale Artifacts in Jerboa Scheme."}, {"role": "assistant", "content": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\"."}], "source": "doc:AGENTS.md:Stale Artifacts"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme."}, {"role": "assistant", "content": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool."}], "source": "doc:AGENTS.md:Jerboa MCP Tools — MANDATORY Usage"} --- a/training_data.v1.jsonl +++ b/training_data.v1.jsonl @@ -37636,7 +37636,7 @@ {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Misc Sugar in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```"}], "source": "doc:AGENTS.md:Misc Sugar"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```"}], "source": "doc:AGENTS.md:What's NOT in the Prelude (requires sepa"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme."}, {"role": "assistant", "content": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---"}], "source": "doc:AGENTS.md:Chez Scheme Conflicts (handled by prelud"} -{"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}], "source": "doc:AGENTS.md:Repository Boundaries"} +{"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}], "source": "doc:AGENTS.md:Repository Boundaries"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Build & Verification in Jerboa Scheme."}, {"role": "assistant", "content": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions."}], "source": "doc:AGENTS.md:Build & Verification"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Stale Artifacts in Jerboa Scheme."}, {"role": "assistant", "content": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\"."}], "source": "doc:AGENTS.md:Stale Artifacts"} {"conversations": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme."}, {"role": "assistant", "content": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool."}], "source": "doc:AGENTS.md:Jerboa MCP Tools — MANDATORY Usage"} --- a/training_data_alpaca.json +++ b/training_data_alpaca.json @@ -227666,7 +227666,7 @@ { "instruction": "Explain Repository Boundaries in Jerboa Scheme.", "input": "", - "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", + "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", "source": "doc:AGENTS.md:Repository Boundaries" }, { --- a/training_data_alpaca.jsonl +++ b/training_data_alpaca.jsonl @@ -37942,7 +37942,7 @@ {"instruction": "Explain Misc Sugar in Jerboa Scheme.", "input": "", "output": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```", "source": "doc:AGENTS.md:Misc Sugar"} {"instruction": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme.", "input": "", "output": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```", "source": "doc:AGENTS.md:What's NOT in the Prelude (requires sepa"} {"instruction": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme.", "input": "", "output": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---", "source": "doc:AGENTS.md:Chez Scheme Conflicts (handled by prelud"} -{"instruction": "Explain Repository Boundaries in Jerboa Scheme.", "input": "", "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", "source": "doc:AGENTS.md:Repository Boundaries"} +{"instruction": "Explain Repository Boundaries in Jerboa Scheme.", "input": "", "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", "source": "doc:AGENTS.md:Repository Boundaries"} {"instruction": "Explain Build & Verification in Jerboa Scheme.", "input": "", "output": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.", "source": "doc:AGENTS.md:Build & Verification"} {"instruction": "Explain Stale Artifacts in Jerboa Scheme.", "input": "", "output": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".", "source": "doc:AGENTS.md:Stale Artifacts"} {"instruction": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme.", "input": "", "output": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.", "source": "doc:AGENTS.md:Jerboa MCP Tools — MANDATORY Usage"} --- a/training_data_alpaca.v1.jsonl +++ b/training_data_alpaca.v1.jsonl @@ -37636,7 +37636,7 @@ {"instruction": "Explain Misc Sugar in Jerboa Scheme.", "input": "", "output": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```", "source": "doc:AGENTS.md:Misc Sugar"} {"instruction": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme.", "input": "", "output": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```", "source": "doc:AGENTS.md:What's NOT in the Prelude (requires sepa"} {"instruction": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme.", "input": "", "output": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---", "source": "doc:AGENTS.md:Chez Scheme Conflicts (handled by prelud"} -{"instruction": "Explain Repository Boundaries in Jerboa Scheme.", "input": "", "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", "source": "doc:AGENTS.md:Repository Boundaries"} +{"instruction": "Explain Repository Boundaries in Jerboa Scheme.", "input": "", "output": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---", "source": "doc:AGENTS.md:Repository Boundaries"} {"instruction": "Explain Build & Verification in Jerboa Scheme.", "input": "", "output": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions.", "source": "doc:AGENTS.md:Build & Verification"} {"instruction": "Explain Stale Artifacts in Jerboa Scheme.", "input": "", "output": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\".", "source": "doc:AGENTS.md:Stale Artifacts"} {"instruction": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme.", "input": "", "output": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool.", "source": "doc:AGENTS.md:Jerboa MCP Tools — MANDATORY Usage"} --- a/training_data_together.jsonl +++ b/training_data_together.jsonl @@ -37942,7 +37942,7 @@ {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Misc Sugar in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme."}, {"role": "assistant", "content": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---"}]} -{"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} +{"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Build & Verification in Jerboa Scheme."}, {"role": "assistant", "content": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions."}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Stale Artifacts in Jerboa Scheme."}, {"role": "assistant", "content": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\"."}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme."}, {"role": "assistant", "content": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool."}]} --- a/training_data_together.v1.jsonl +++ b/training_data_together.v1.jsonl @@ -37636,7 +37636,7 @@ {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Misc Sugar in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme."}, {"role": "assistant", "content": "```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme."}, {"role": "assistant", "content": "The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---"}]} -{"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} +{"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Repository Boundaries in Jerboa Scheme."}, {"role": "assistant", "content": "When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Build & Verification in Jerboa Scheme."}, {"role": "assistant", "content": "After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions."}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Stale Artifacts in Jerboa Scheme."}, {"role": "assistant", "content": "If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\"."}]} {"messages": [{"role": "system", "content": "You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."}, {"role": "user", "content": "Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme."}, {"role": "assistant", "content": "Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool."}]} --- a/training_data_together_v6_prep.jsonl +++ b/training_data_together_v6_prep.jsonl @@ -37942,7 +37942,7 @@ {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Misc Sugar in Jerboa Scheme."},{"role":"assistant","content":"```scheme\n(assert! (> x 0)) (assert! (> x 0) \"message\")\n(alist (name \"Alice\") (age 30)) ;; → ((name . \"Alice\") (age . 30))\n(let-alist data (name age) body)\n```"}]} {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain What's NOT in the Prelude (requires separate import) in Jerboa Scheme."},{"role":"assistant","content":"```scheme\n(import (std net request)) ;; HTTP client\n(import (std net httpd)) ;; HTTP server\n(import (std db sqlite)) ;; SQLite\n(import (std actor)) ;; Actor system\n(import (std async)) ;; Async/await\n(import (std crypto digest)) ;; SHA, MD5\n(import (std text regex)) ;; Regex\n(import (std text xml)) ;; XML\n(import (std text yaml)) ;; YAML\n(import (std os env)) ;; Environment variables\n(import (std os signal)) ;; Signal handling\n(import (std security sandbox)) ;; Sandboxing\n```"}]} {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Chez Scheme Conflicts (handled by prelude) in Jerboa Scheme."},{"role":"assistant","content":"The prelude shadows these Chez builtins with Jerboa versions:\n`make-hash-table`, `hash-table?`, `sort`, `sort!`, `printf`, `fprintf`,\n`path-extension`, `path-absolute?`, `with-input-from-string`,\n`with-output-to-string`, `iota`, `1+`, `1-`, `partition`,\n`make-date`, `make-time`\n\nAll standard Chez Scheme is still available — the prelude just re-exports\nimproved versions of the above.\n\n---"}]} -{"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Repository Boundaries in Jerboa Scheme."},{"role":"assistant","content":"When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-emacs` — **NEVER touch**. Another model owns it.\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} +{"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Repository Boundaries in Jerboa Scheme."},{"role":"assistant","content":"When working in a Jerboa project, **ONLY modify files in the current repo** unless the user explicitly names another path.\n\nCommon sibling repos that exist but must NOT be touched without explicit instruction:\n- `~/mine/jerboa-mcp` — Only modify when user explicitly says to work there.\n- `~/mine/jerboa-shell` — Only modify when user explicitly says to work there.\n- `~/mine/gerbil-mcp` — **NEVER touch**. Deprecated.\n- `~/mine/gerbil-orig` — Read-only reference for upstream Gerbil. Never modify.\n\nIf a user instruction mentions a file path, use EXACTLY that path. Do not substitute a similar-looking path from another repo.\n\n---"}]} {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Build & Verification in Jerboa Scheme."},{"role":"assistant","content":"After modifying any `.ss` or `.sls` (Jerboa Scheme) source files, always run the build command and fix any errors before moving on. Common issues include: missing imports, wrong function names, and duplicate definitions."}]} {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Stale Artifacts in Jerboa Scheme."},{"role":"assistant","content":"If edits seem to have no effect after `make build`, delete stale compiled files:\n```bash\nfind lib -name \"*.so\" -delete && find lib -name \"*.wpo\" -delete && make build\n```\nRun `jerboa_stale_static` to detect stale `.so` files before debugging \"why doesn't my edit work?\"."}]} {"messages":[{"role":"system","content":"You are an expert in Jerboa Scheme, a Chez-Scheme-based dialect with a Gerbil-flavored prelude. You provide accurate, idiomatic Jerboa code with correct imports, function names, and arities. Module paths use the (jerboa ...) and (std ...) forms — never :std/foo (Gerbil) or (srfi :NN) (R7). You know the prelude, the actor system, fibers, the FFI, capability security, the macro system (defrules, syntax-case), pattern matching (match), and how Jerboa diverges from Gerbil/Racket/Clojure/SRFI. When writing code, always include required (import ...) statements."},{"role":"user","content":"Explain Jerboa MCP Tools — MANDATORY Usage in Jerboa Scheme."},{"role":"assistant","content":"Jerboa is a niche Scheme dialect with limited training data. **Never guess — always verify** with MCP tools. Tool descriptions are available at runtime via the MCP server; this section covers **when** and **why** to use each tool."}]}