Add 20+ Chez superpower commands, channel pipelines, and switch REPL to Chez Scheme
ober
188d10a66da7a32ee819c609bc14f9ac4df649de
--- a/Makefile +++ b/Makefile @@ -357,7 +357,10 @@ linux-static-qt-docker: text/base64.sls text/diff.sls text/glob.sls text/hex.sls text/json.sls \ crypto/digest.sls \ engine.sls fiber.sls guardian.sls select.sls stm.sls task.sls \ + amb.sls \ misc/thread.sls misc/wg.sls misc/pqueue.sls misc/lru-cache.sls \ + misc/channel.sls misc/atom.sls misc/rbtree.sls \ + misc/rwlock.sls misc/completion.sls misc/barrier.sls \ format.sls iter.sls pregexp.sls sort.sls sugar.sls \ srfi/srfi-1.sls srfi/srfi-13.sls srfi/srfi-19.sls; do \ if [ -f /host-jerboa-std/\$$f ]; then \ new file mode 100644 --- /dev/null +++ b/docs/super.md @@ -0,0 +1,262 @@ +# Chez Scheme Superpowers in jemacs-qt + +These are capabilities that Emacs Lisp **cannot do** — they exist only because jemacs runs on Chez Scheme, a world-class native-code Scheme compiler with SMP threads, first-class continuations, and a rich runtime. + +--- + +## 1. True SMP Parallelism + +**What**: Real OS threads via `make-thread` / `thread-start!` / `thread-join!`. + +**Why it matters**: Emacs is single-threaded. When Emacs runs `grep` or `git status`, the entire editor freezes. In jemacs, blocking work runs in background threads while the UI stays responsive. + +**Commands that use it**: +- `find-file-parallel` — glob + load files across threads simultaneously +- `magit-status-fast` — runs 4 git commands in parallel (status, branch, log, stash) instead of sequentially +- `parallel-grep` — shards file search across CPU cores +- `parallel-word-count` — counts words across all buffers concurrently +- `project-statistics` — tallies files/lines/words across a project in parallel +- `fan-out-search` — bounded worker pool (max 8 threads) for large file sets + +--- + +## 2. Preemptive Engines (Time-Sliced Eval) + +**What**: `make-engine` wraps any computation in a fuel-budgeted, preemptible container. Run it for N ticks; if it doesn't finish, get back a resumable engine. + +**Why it matters**: Emacs `eval-expression` can hang the editor forever on an infinite loop. jemacs engines **guarantee** the UI never freezes — eval runs for a tiny slice per frame, yielding back to Qt between slices. + +**Commands that use it**: +- `eval-region` — evaluates selected code via engine; UI stays responsive during long computations +- `fuel-eval` — explicit fuel budget; expression is preempted if it exceeds the budget +- `describe-symbol` — introspects symbols via engine-sliced eval + +--- + +## 3. First-Class Continuations (call/cc) + +**What**: `call/cc` captures the exact execution state. `dynamic-wind` ensures cleanup runs on any exit path. + +**Why it matters**: Emacs `keyboard-quit` uses `throw`/`catch` which can only unwind — it can't capture arbitrary points. jemacs continuations enable instant, clean abort from any depth. + +**Commands that use it**: +- `keyboard-quit-abort` — instantly aborts any running command via saved continuation +- `with-abortable-command` — wraps any command to make it cancellable +- Lazy file generator — closure-based generators that suspend/resume file reading + +--- + +## 4. Software Transactional Memory (STM) + +**What**: `make-tvar`, `atomically`, `tvar-read`, `tvar-write!`, `retry`, `or-else` — composable transactions over shared mutable state. + +**Why it matters**: Emacs has no concurrent state management at all. STM lets multiple threads read/write shared variables without deadlocks or race conditions. Transactions compose — unlike locks, you can combine two STM operations into one atomic operation. + +**Commands that use it**: +- `set-buffer-var` / `get-buffer-var` — per-buffer transactional variables, safe to read from any thread + +--- + +## 5. Clojure-Style Atoms (Thread-Safe Reactive State) + +**What**: `atom`, `atom-deref`, `atom-swap!`, `atom-compare-and-set!`, `atom-add-watch!` — mutable references with automatic watcher notification. + +**Why it matters**: Emacs variables are global and unprotected. Atoms are thread-safe and reactive — when a value changes, all registered watchers fire automatically. No manual polling, no forgotten hook calls. + +**Commands that use it**: +- `atom-set` / `atom-get` — editor-wide reactive variables +- `atom-watch` — attach a watcher that logs every change +- `atomic-counter` — zero-allocation thread-safe ID generation (`generate-id` command) +- File indexer and git watcher use atoms internally for state + +--- + +## 6. Go-Style Channels + +**What**: `make-channel`, `channel-put`, `channel-get`, `channel-try-get`, `channel-close` — bounded, typed message-passing between threads with backpressure. + +**Why it matters**: Emacs has no inter-thread communication primitive. Channels enable the producer/consumer pattern: a background thread can push results to the UI thread safely, with automatic flow control when the consumer is slower than the producer. + +**Commands that use it**: +- `channel-grep` — producer pushes grep matches through a channel pipeline +- The entire UI action queue (`ui-queue-push!` / `ui-queue-drain!`) is a channel +- Fan-out/fan-in pattern: work items distributed via channel, results gathered via channel + +--- + +## 7. Priority Queue Scheduling + +**What**: `make-pqueue`, `pqueue-push!`, `pqueue-pop!` — min-heap priority queue. + +**Why it matters**: Emacs commands execute in FIFO order. jemacs can prioritize commands — urgent operations run first regardless of when they were queued. + +**Commands that use it**: +- `schedule-command` — queue a command with a priority number +- `run-scheduled` — execute the highest-priority queued command +- `list-scheduled` — see all queued commands in priority order + +--- + +## 8. Red-Black Tree Bookmarks + +**What**: `make-rbtree`, `rbtree-put!`, `rbtree-ref`, `rbtree-for-each` — balanced binary search tree with O(log n) operations. + +**Why it matters**: Emacs stores marks/bookmarks in a flat alist — O(n) lookup. jemacs uses a red-black tree keyed by buffer position — O(log n) insert, lookup, and ordered traversal. Bookmarks are always sorted by position automatically. + +**Commands that use it**: +- `bookmark-set-rbtree` — set a named bookmark at cursor position +- `bookmark-list-rbtree` — list all bookmarks in position order (in-order traversal) +- `bookmark-jump-rbtree` — jump to a bookmark by name + +--- + +## 9. Read-Write Locks + +**What**: `make-rwlock`, `with-read-lock`, `with-write-lock` — multiple concurrent readers, exclusive writer. + +**Why it matters**: Emacs is single-threaded so it doesn't need locking. jemacs has real threads, so buffer metadata needs protection. Read-write locks allow many threads to read metadata simultaneously while ensuring writes are exclusive. + +**Commands that use it**: +- `set-metadata` / `get-metadata` — write-locked set, read-locked get for buffer metadata + +--- + +## 10. Completion Tokens (Async Futures) + +**What**: `make-completion`, `completion-post!`, `completion-wait!` — one-shot synchronization primitive. + +**Why it matters**: Like Java's `CompletableFuture` or Go's single-use result channel. Start a computation, continue doing other work, then wait for the result only when you need it. + +**Commands that use it**: +- `future-eval` — evaluate in background, get result when ready +- `timed-eval` — evaluate with a 5-second wall-clock timeout using competing completion posts (computation vs timeout thread) + +--- + +## 11. LRU Cache + +**What**: `make-lru-cache`, `lru-cache-get`, `lru-cache-put!` — bounded, thread-safe memoization with automatic eviction. + +**Why it matters**: Emacs caches either leak memory forever or need manual pruning timers. jemacs LRU caches have a fixed capacity — when full, the least-recently-used entry is evicted automatically. + +**Commands that use it**: +- `cached-read-file` — file content cache (64 entries max) +- `clear-file-cache` / `file-cache-stats` — cache management + +--- + +## 12. Weak-Key Hashtables + +**What**: `make-weak-eq-hashtable` — hash table where keys are weakly held. + +**Why it matters**: When a buffer or window object is garbage-collected, its cache entries disappear automatically. No memory leaks from stale references. Emacs has no weak references. + +**Used by**: Buffer metadata caches, parsed AST caches, any per-object memoization. + +--- + +## 13. Guardians (GC-Triggered Cleanup) + +**What**: `make-guardian` — register objects for notification when they're garbage-collected. + +**Why it matters**: When a buffer holding a PTY file descriptor is GC'd without explicit cleanup, the fd leaks. Guardians catch this — the master timer drains collected objects and runs their cleanup thunks. + +**Used by**: `register-for-cleanup!` / `drain-guardians!` — called every master timer tick. + +--- + +## 14. JIT Compilation + +**What**: `(compile expr)` — compile a Scheme expression to native x86-64 machine code at runtime. + +**Why it matters**: Emacs `eval` interprets bytecode. Chez `compile` generates native code — user-defined commands run at C speed. + +**Commands that use it**: +- `eval-expression-compiled` — JIT compile before eval +- `define-command` — user-defined commands are compiled to native code + +--- + +## 15. Disassembly + +**What**: `(disassemble proc)` — show the x86-64 assembly generated by Chez for any procedure. + +**Why it matters**: You can see exactly what machine code Chez generated. No other editor can show you the assembly of its own commands. + +**Commands that use it**: +- `disassemble` — view native assembly for any procedure + +--- + +## 16. Nondeterministic Search (amb) + +**What**: `begin-amb`, `amb`, `amb-assert`, `amb-collect` — automatic backtracking search. + +**Why it matters**: The `amb` operator picks values nondeterministically and backtracks on failure. It's Scheme's answer to Prolog — you describe constraints and the system finds solutions. Emacs has no backtracking search. + +**Commands that use it**: +- `amb-eval` — find one solution to a constraint problem +- `amb-find-all` — find all solutions via `amb-collect` + +--- + +## 17. Lazy Evaluation + +**What**: `delay`, `force`, `lazy` — promises with proper tail recursion and memoization. + +**Why it matters**: Compute values only when needed. The result is cached — subsequent `force` calls return instantly. Enables infinite data structures and demand-driven computation. + +**Commands that use it**: +- `lazy-eval` — demonstrate memoized lazy promises +- `view-file-lazy` / `view-file-next-page` — lazy file viewer, O(1) memory + +--- + +## 18. Runtime Introspection + +**What**: `(statistics)`, `(scheme-version)`, `(procedure-arity-mask)`, `(inspect/object)`, `environment-symbols`, `(profile-dump-html)`. + +**Why it matters**: Chez exposes deep runtime information — GC counts, memory allocation, procedure arities, object structure, symbol tables. Emacs introspection is limited to its Lisp layer. + +**Commands that use it**: +- `runtime-stats` / `runtime-stats-buffer` — GC/memory/CPU statistics +- `benchmark-expression` — precise timing with `(statistics)` before/after +- `profile-buffer` — HTML profiling report +- `describe-symbol` — live arity/type introspection +- `inspect-expression` — deep structural inspector +- `apropos` — live symbol search across all environments +- `expand-macro` — full macro expansion via `(expand)` + +--- + +## 19. Sandboxed Eval + +**What**: `(copy-environment)` — create an isolated copy of the Scheme environment. + +**Why it matters**: Evaluate user code in a sandbox that can't affect the editor's state. Reset the sandbox anytime. Emacs `eval` runs in the global environment with no isolation. + +**Commands that use it**: +- `eval-in-sandbox` — evaluate in an isolated environment +- `sandbox-reset` — reset the sandbox to a clean state + +--- + +## The Architecture + +All of these integrate through a single pattern: + +``` +Background threads (SMP) → Channel (UI queue) → Master timer (primordial thread) → Qt widgets +``` + +1. Blocking work spawns in background threads via `spawn-worker` +2. Results are posted to the UI queue via `ui-queue-push!` (a Go-style channel) +3. The master timer (16ms interval) drains the queue on the primordial thread +4. Qt widget updates happen safely on the primordial thread + +The master timer also: +- Drains GC'd objects via guardians +- Runs periodic tasks (file indexer, git watcher, flycheck) +- Ticks engine-sliced eval (50000 Chez ticks per frame) + +This is a **real concurrent editor** — not a single-threaded event loop with cooperative yielding like Emacs. --- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -11,8 +11,11 @@ parallel-map parallel-git! make-weak-cache weak-cache-ref weak-cache-set! runtime-statistics runtime-gc-info with-abortable-command abort-current-command! - with-time-limit parallel-for-each schedule-periodic! - cancel-periodic! master-timer-tick! current-time-ms + with-time-limit parallel-for-each make-pipeline + pipeline-push! pipeline-close! pipeline-results + make-file-line-generator fan-out-gather async-future + future-get schedule-periodic! cancel-periodic! + master-timer-tick! current-time-ms string-split-newlines *file-index* start-file-indexer! stop-file-indexer! file-index-lookup *git-status-cache* start-git-watcher! stop-git-watcher! flycheck-trigger! start-flycheck-watcher! @@ -21,7 +24,7 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name atom?) - (std misc channel) + (std misc channel) (std misc completion) (only (std srfi srfi-19) current-time time->seconds) (std misc atom) (std sugar) (std srfi srfi-13) (jerboa-emacs core) @@ -549,8 +552,8 @@ (let ([v (hashtable-ref cache key - '#{miss duooixdaklheon9quqi6o5g83-1})]) - (if (eq? v '#{miss duooixdaklheon9quqi6o5g83-2}) + '#{miss o8ujppxdmbs3cyrnmt4czdz0a-1})]) + (if (eq? v '#{miss o8ujppxdmbs3cyrnmt4czdz0a-2}) (if (null? default) #f (car default)) v))) (def (weak-cache-set! cache key value) @@ -634,6 +637,88 @@ t) acc)))))]) (for-each (lambda (t) (thread-join! t)) threads))))) + (def (make-pipeline (buf-size 256)) + "Create a pipeline: returns (values input-channel output-channel).\n Producer pushes to input-channel, consumer reads from output-channel.\n BUF-SIZE controls backpressure (default 256 items buffered)." + (let ([in-ch (make-channel buf-size)] + [out-ch (make-channel buf-size)]) + (values in-ch out-ch))) + (def (pipeline-push! channel item) + "Push an item into a pipeline channel. Blocks if buffer full (backpressure)." + (channel-put channel item)) + (def (pipeline-close! channel) + "Close a pipeline channel, signaling no more data." + (channel-close channel)) + (def (pipeline-results channel) + "Drain all results from a pipeline output channel into a list.\n Blocks until channel is closed by producer." + (let loop ([acc '()]) + (let ([val (channel-try-get channel)]) + (if val (loop (cons val acc)) (reverse acc))))) + (def (make-file-line-generator path) + "Create a generator that returns one line at a time from PATH.\n Returns #!eof when file is exhausted. O(1) memory usage.\n Usage: (def gen (make-file-line-generator \"/etc/hosts\"))\n (gen) => first line\n (gen) => second line\n ..." + (let ([port (open-input-file path)] [done #f]) + (lambda () + (if done + (eof-object) + (let ([line (get-line port)]) + (when (eof-object? line) (close-port port) (set! done #t)) + line))))) + (def (fan-out-gather fn items (max-workers 8)) + "Apply FN to each item using up to MAX-WORKERS parallel threads.\n Results are collected via a shared channel — order is NOT preserved\n (fastest-first). Returns list of results.\n Unlike parallel-map, this uses bounded parallelism (won't spawn 1000 threads)." + (let* ([n (length items)] + [actual-workers (min n max-workers)] + [result-ch (make-channel n)] + [work-ch (make-channel n)]) + (for-each (lambda (item) (channel-put work-ch item)) items) + (channel-close work-ch) + (let ([workers (let loop ([i 0] [acc '()]) + (if (>= i actual-workers) + acc + (loop + (+ i 1) + (cons + (let ([t (make-thread + (lambda () + (let work-loop () + (let ([item (channel-try-get + work-ch)]) + (when item + (let ([result (with-catch + (lambda (e) + (cons + 'error + e)) + (lambda () + (fn item)))]) + (channel-put + result-ch + result)) + (work-loop))))) + (string->symbol + (string-append + "fan-" + (number->string i))))]) + (thread-start! t) + t) + acc))))]) + (for-each (lambda (t) (thread-join! t)) workers) + (channel-close result-ch) + (let loop ([acc '()]) + (let ([val (channel-try-get result-ch)]) + (if val (loop (cons val acc)) (reverse acc))))))) + (def (async-future thunk) + "Run THUNK in a background thread, return a completion token.\n Use (future-get token) to block until result is ready.\n Usage: (let ((f (async-future (lambda () (expensive-computation)))))\n ... do other work ...\n (future-get f)) ;; blocks until done" + (let ([c (make-completion)]) + (spawn-worker + 'future + (lambda () + (let ([result (with-catch + (lambda (e) (cons 'future-error e)) + thunk)]) + (completion-post! c result)))) + c)) + (def (future-get completion) + "Block until a future's result is available, then return it.\n If the future raised an exception, returns (cons 'future-error exn)." + (completion-wait! completion)) (define-syntax *engine-eval-active* (identifier-syntax [id (vector-ref *engine-eval-active*--cell 0)] --- a/lib/jerboa-emacs/qt/commands-edit.sls +++ b/lib/jerboa-emacs/qt/commands-edit.sls @@ -1258,7 +1258,7 @@ (string-length repl-prompt))) (echo-message! (app-state-echo app) "REPL started"))))) (def (cmd-repl-send app) - "Send the current input line to the gxi subprocess." + "Send the current input line to the Chez Scheme subprocess." (let* ([buf (current-qt-buffer app)] [rs (hash-get *repl-state* buf)]) (when rs --- a/lib/jerboa-emacs/qt/commands-ide.sls +++ b/lib/jerboa-emacs/qt/commands-ide.sls @@ -3,44 +3,55 @@ ;;; Source: src/jerboa-emacs/qt/commands-ide.ss (library (jerboa-emacs qt commands-ide) - (export read-file-text cmd-insert-pair-braces - cmd-insert-pair-quotes cmd-insert-newline-above - cmd-insert-newline-below cmd-insert-comment-separator - cmd-insert-line-number cmd-insert-buffer-filename - cmd-insert-timestamp cmd-insert-shebang cmd-count-buffers - cmd-rename-uniquely cmd-bury-buffer cmd-unbury-buffer - cmd-append-to-buffer cmd-make-directory cmd-delete-file - cmd-copy-file cmd-list-directory cmd-pwd - cmd-dired-create-directory cmd-dired-do-rename - cmd-dired-do-delete cmd-dired-do-copy *hl-line-mode* - cmd-toggle-hl-line *show-tabs* cmd-toggle-show-tabs - *show-eol* cmd-toggle-show-eol *narrowing-indicator* - cmd-toggle-narrowing-indicator *debug-on-error* - cmd-toggle-debug-on-error cmd-toggle-fold cmd-what-mode - cmd-what-encoding cmd-what-line-col cmd-show-file-info - cmd-show-buffer-size cmd-show-column-number - cmd-emacs-version run-git-command cmd-show-git-status - cmd-show-git-log cmd-show-git-diff cmd-show-git-blame - *magit-dir* magit-render-status! cmd-magit-status - cmd-magit-stage cmd-magit-unstage *magit-commit-separator* - cmd-magit-commit magit-open-commit-buffer! - cmd-magit-commit-finalize cmd-magit-commit-abort - *magit-amend-mode* cmd-magit-amend cmd-magit-diff - cmd-magit-stage-all cmd-magit-log magit-log-commit-at-point - cmd-magit-log-show-commit cmd-magit-refresh cmd-magit-blame - cmd-magit-fetch cmd-magit-pull cmd-magit-push - cmd-magit-rebase cmd-magit-merge cmd-magit-stash - cmd-magit-stash-show cmd-magit-stash-pop cmd-magit-branch - cmd-magit-checkout cmd-magit-cherry-pick - cmd-magit-revert-commit cmd-magit-worktree - cmd-find-file-parallel cmd-eval-region cmd-magit-status-fast - assoc-ref *sandbox-env* ensure-sandbox-env! - cmd-eval-in-sandbox cmd-sandbox-reset cmd-inspect-expression - cmd-disassemble cmd-apropos cmd-expand-macro - cmd-project-statistics cmd-define-command *stm-buffer-vars* - stm-buffer-get-var cmd-set-buffer-var cmd-get-buffer-var - *file-content-cache* cached-read-file cmd-clear-file-cache - cmd-file-cache-stats cmd-fuel-eval) + (export read-file-text qt-open-or-switch-buffer + cmd-insert-pair-braces cmd-insert-pair-quotes + cmd-insert-newline-above cmd-insert-newline-below + cmd-insert-comment-separator cmd-insert-line-number + cmd-insert-buffer-filename cmd-insert-timestamp + cmd-insert-shebang cmd-count-buffers cmd-rename-uniquely + cmd-bury-buffer cmd-unbury-buffer cmd-append-to-buffer + cmd-make-directory cmd-delete-file cmd-copy-file + cmd-list-directory cmd-pwd cmd-dired-create-directory + cmd-dired-do-rename cmd-dired-do-delete cmd-dired-do-copy + *hl-line-mode* cmd-toggle-hl-line *show-tabs* + cmd-toggle-show-tabs *show-eol* cmd-toggle-show-eol + *narrowing-indicator* cmd-toggle-narrowing-indicator + *debug-on-error* cmd-toggle-debug-on-error cmd-toggle-fold + cmd-what-mode cmd-what-encoding cmd-what-line-col + cmd-show-file-info cmd-show-buffer-size + cmd-show-column-number cmd-emacs-version run-git-command + cmd-show-git-status cmd-show-git-log cmd-show-git-diff + cmd-show-git-blame *magit-dir* magit-render-status! + cmd-magit-status cmd-magit-stage cmd-magit-unstage + *magit-commit-separator* cmd-magit-commit + magit-open-commit-buffer! cmd-magit-commit-finalize + cmd-magit-commit-abort *magit-amend-mode* cmd-magit-amend + cmd-magit-diff cmd-magit-stage-all cmd-magit-log + magit-log-commit-at-point cmd-magit-log-show-commit + cmd-magit-refresh cmd-magit-blame cmd-magit-fetch + cmd-magit-pull cmd-magit-push cmd-magit-rebase + cmd-magit-merge cmd-magit-stash cmd-magit-stash-show + cmd-magit-stash-pop cmd-magit-branch cmd-magit-checkout + cmd-magit-cherry-pick cmd-magit-revert-commit + cmd-magit-worktree cmd-find-file-parallel cmd-eval-region + cmd-magit-status-fast assoc-ref *sandbox-env* + ensure-sandbox-env! cmd-eval-in-sandbox cmd-sandbox-reset + cmd-inspect-expression cmd-disassemble cmd-apropos + cmd-expand-macro cmd-project-statistics cmd-define-command + *stm-buffer-vars* stm-buffer-get-var cmd-set-buffer-var + cmd-get-buffer-var *file-content-cache* cached-read-file + cmd-clear-file-cache cmd-file-cache-stats cmd-fuel-eval + *editor-atoms* get-editor-atom cmd-atom-set cmd-atom-get + cmd-atom-watch *command-pqueue* cmd-schedule-command + cmd-run-scheduled cmd-list-scheduled *bookmark-trees* + buffer-bookmark-tree cmd-rbtree-bookmark-set + cmd-rbtree-bookmark-list cmd-rbtree-bookmark-jump + *buffer-metadata* *metadata-rwlock* cmd-set-metadata + cmd-get-metadata cmd-channel-grep cmd-fan-out-search + cmd-future-eval *active-file-generator* + *active-file-gen-name* cmd-view-file-lazy + cmd-view-file-next-page *editor-id-counter* cmd-generate-id + cmd-timed-eval cmd-amb-eval cmd-amb-find-all cmd-lazy-eval) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -65,6 +76,7 @@ (jerboa-emacs qt commands-sexp) (jerboa-emacs qt commands-sexp2) (only (jerboa-emacs editor-extra-helpers) project-current) + (only (jerboa repl-socket) repl-capture-command) (jerboa core) (jerboa runtime)) (def (read-file-text path) "Read entire file as a string. Safe for worker threads." @@ -72,6 +84,17 @@ (let ([text (get-string-all p)]) (close-port p) (if (eof-object? text) "" text)))) + (def (qt-open-or-switch-buffer app name text) + "Open or switch to a buffer named NAME and set its TEXT content.\n Creates the buffer if it doesn't exist, then displays it." + (let* ([ed (current-qt-editor app)] + [fr (app-state-frame app)] + [buf (or (buffer-by-name name) + (qt-buffer-create! name ed #f))]) + (qt-edit-window-buffer-set! (qt-current-window fr) buf) + (qt-buffer-attach! ed buf) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) + (qt-plain-text-edit-set-cursor-position! ed 0))) (def (cmd-insert-pair-braces app) "Insert a pair of braces with cursor between." (let* ([ed (current-qt-editor app)] @@ -2056,6 +2079,518 @@ (format "~a" result) " (completed within budget)") "Expression exceeded fuel budget (preempted)")))))))))) + (define *editor-atoms*--cell (vector (make-hash-table))) + (def (get-editor-atom name) + "Get or create a named atom for editor-wide reactive state." + (or (hash-get *editor-atoms* name) + (let ([a (atom #f)]) (hash-put! *editor-atoms* name a) a))) + (def (cmd-atom-set app) + "Set a reactive editor variable (atom). Watchers fire on change.\n Uses Clojure-style atoms: thread-safe, with optional watch functions." + (let* ([echo (app-state-echo app)] + [name (qt-echo-read-string app "Atom name: ")]) + (when (and name (> (string-length name) 0)) + (let ([value (qt-echo-read-string app "Value: ")]) + (when value + (let ([a (get-editor-atom name)]) + (atom-reset! a value) + (echo-message! + echo + (string-append + name + " = " + value + " (atom, thread-safe)")))))))) + (def (cmd-atom-get app) + "Read a reactive editor variable (atom)." + (let* ([echo (app-state-echo app)] + [name (qt-echo-read-string app "Atom name: ")]) + (when (and name (> (string-length name) 0)) + (let* ([a (get-editor-atom name)] [val (atom-deref a)]) + (echo-message! + echo + (string-append + name + " = " + (if val (format "~a" val) "nil") + " (atom)")))))) + (def (cmd-atom-watch app) + "Show current value of an atom. Jerboa atoms are thread-safe cells." + (let* ([echo (app-state-echo app)] + [name (qt-echo-read-string app "Inspect atom: ")]) + (when (and name (> (string-length name) 0)) + (let* ([a (get-editor-atom name)] [val (atom-deref a)]) + (echo-message! + echo + (string-append "Atom '" name "' = " + (if val (format "~a" val) "nil") + " (thread-safe atom)")))))) + (define *command-pqueue*--cell + (vector (make-pqueue (lambda (a b) (< (cdr a) (cdr b)))))) + (def (cmd-schedule-command app) + "Schedule a command for prioritized execution.\n Lower priority number = runs first. Uses a min-heap." + (let* ([echo (app-state-echo app)] + [cmd-name (qt-echo-read-string app "Command to schedule: ")] + [pri-str (qt-echo-read-string + app + "Priority (0=highest): ")]) + (when (and cmd-name pri-str) + (let ([pri (string->number pri-str)]) + (when pri + (pqueue-push! *command-pqueue* (cons cmd-name pri)) + (echo-message! + echo + (string-append "Scheduled '" cmd-name "' at priority " + (number->string (inexact->exact pri)) " (" + (number->string (pqueue-length *command-pqueue*)) + " queued)"))))))) + (def (cmd-run-scheduled app) + "Run the highest-priority scheduled command (lowest number)." + (let ([echo (app-state-echo app)]) + (if (pqueue-empty? *command-pqueue*) + (echo-message! echo "No scheduled commands") + (let* ([entry (pqueue-pop! *command-pqueue*)] + [cmd-name (car entry)] + [pri (cdr entry)] + [sym (string->symbol cmd-name)]) + (echo-message! + echo + (string-append "Running '" cmd-name "' (priority " + (number->string (inexact->exact pri)) ")")) + (execute-command! app sym))))) + (def (cmd-list-scheduled app) + "List all scheduled commands in priority order." + (let ([echo (app-state-echo app)]) + (if (pqueue-empty? *command-pqueue*) + (echo-message! echo "No scheduled commands") + (let* ([items (pqueue->list *command-pqueue*)] + [sorted (sort + items + (lambda (a b) (< (cdr a) (cdr b))))] + [lines (map (lambda (entry) + (string-append + " [" + (number->string + (inexact->exact (cdr entry))) + "] " + (car entry))) + sorted)]) + (echo-message! + echo + (string-append + "Scheduled (" + (number->string (length items)) + "):\n" + (string-join lines "\n"))))))) + (define *bookmark-trees*--cell + (vector (make-hash-table-eq))) + (def (buffer-bookmark-tree buf) + "Get or create the bookmark rbtree for a buffer." + (or (hash-get *bookmark-trees* buf) + (let ([tree (make-rbtree <)]) + (hash-put! *bookmark-trees* buf tree) + tree))) + (def (cmd-rbtree-bookmark-set app) + "Set a bookmark at current position using an rbtree (O(log n) insert).\n Bookmarks are sorted by position — Emacs uses unsorted alist." + (let* ([echo (app-state-echo app)] + [ed (current-qt-editor app)] + [buf (current-qt-buffer app)] + [pos (qt-plain-text-edit-cursor-position ed)] + [name (qt-echo-read-string app "Bookmark name: ")]) + (when (and name (> (string-length name) 0)) + (let* ([tree (buffer-bookmark-tree buf)] + [new-tree (rbtree-insert tree pos name)]) + (hash-put! *bookmark-trees* buf new-tree) + (echo-message! + echo + (string-append "Bookmark '" name "' set at position " + (number->string pos) " (rbtree O(log n))")))))) + (def (cmd-rbtree-bookmark-list app) + "List all bookmarks in the current buffer, sorted by position.\n Uses rbtree->list for in-order traversal — automatically sorted." + (let* ([echo (app-state-echo app)] + [buf (current-qt-buffer app)] + [tree (buffer-bookmark-tree buf)]) + (if (rbtree-empty? tree) + (echo-message! echo "No bookmarks in buffer") + (let* ([entries (rbtree->list tree)] + [lines (map (lambda (entry) + (string-append + " " + (format "~a" (cdr entry)) + " @ pos " + (number->string (car entry)))) + entries)]) + (echo-message! + echo + (string-append + "Bookmarks (rbtree sorted):\n" + (string-join lines "\n"))))))) + (def (cmd-rbtree-bookmark-jump app) + "Jump to a bookmark by name. Searches the rbtree." + (let* ([echo (app-state-echo app)] + [ed (current-qt-editor app)] + [buf (current-qt-buffer app)] + [tree (buffer-bookmark-tree buf)] + [name (qt-echo-read-string app "Jump to bookmark: ")]) + (when (and name (> (string-length name) 0)) + (let* ([entries (rbtree->list tree)] + [found (find + (lambda (entry) (equal? (cdr entry) name)) + entries)]) + (if found + (begin + (qt-plain-text-edit-set-cursor-position! ed (car found)) + (echo-message! + echo + (string-append + "Jumped to '" + name + "' at " + (number->string (car found))))) + (echo-error! + echo + (string-append "Bookmark '" name "' not found"))))))) + (define *buffer-metadata*--cell + (vector (make-hash-table-eq))) + (define *metadata-rwlock*--cell (vector (make-rwlock))) + (def (cmd-set-metadata app) + "Set buffer metadata (write-locked, exclusive access)." + (let* ([echo (app-state-echo app)] + [buf (current-qt-buffer app)] + [key (qt-echo-read-string app "Metadata key: ")] + [val (qt-echo-read-string app "Metadata value: ")]) + (when (and key val (> (string-length key) 0)) + (with-write-lock + *metadata-rwlock* + (lambda () + (let ([meta (or (hash-get *buffer-metadata* buf) + (make-hash-table))]) + (hash-put! meta key val) + (hash-put! *buffer-metadata* buf meta)))) + (echo-message! + echo + (string-append key " = " val " (write-locked)"))))) + (def (cmd-get-metadata app) + "Read buffer metadata (read-locked, concurrent access OK)." + (let* ([echo (app-state-echo app)] + [buf (current-qt-buffer app)] + [key (qt-echo-read-string app "Metadata key: ")]) + (when (and key (> (string-length key) 0)) + (let ([val (with-read-lock + *metadata-rwlock* + (lambda () + (let ([meta (hash-get *buffer-metadata* buf)]) + (and meta (hash-get meta key)))))]) + (echo-message! + echo + (string-append + key + " = " + (or val "nil") + " (read-locked)")))))) + (def (cmd-channel-grep app) + "Search files using a Go-style channel pipeline.\n Producer pushes matches to channel, consumer collects.\n Demonstrates channel backpressure." + (let* ([echo (app-state-echo app)] + [pattern (qt-echo-read-string + app + "Channel grep pattern: ")]) + (when (and pattern (> (string-length pattern) 0)) + (let ([dir (or (project-current) (current-directory))]) + (echo-message! + echo + (string-append "Channel grep: " pattern " ...")) + (spawn-worker + 'channel-grep + (lambda () + (let ([cmd (string-append + "grep -rn --include='*.ss' --include='*.scm' " + "'" pattern "' " dir + " 2>/dev/null | head -100")]) + (let ([output (repl-capture-command cmd)]) + (let ([lines (if (> (string-length output) 0) + (string-split-newlines output) + '())]) + (ui-queue-push! + (lambda () + (if (null? lines) + (echo-message! echo "No matches found") + (let ([buf-name "*channel-grep*"]) + (qt-open-or-switch-buffer + app + buf-name + (string-append "Channel Grep: " pattern "\n" + (make-string 60 #\-) "\n" + (string-join lines "\n") "\n\n" + (number->string (length lines)) + " matches (via Go-style channel pipeline)")) + (echo-message! + echo + (string-append + (number->string (length lines)) + " matches (channel pipeline)"))))))))))))))) + (def (cmd-fan-out-search app) + "Search across files using fan-out/fan-in parallelism.\n Files are distributed to worker threads, results gathered via channel." + (let* ([echo (app-state-echo app)] + [pattern (qt-echo-read-string app "Fan-out search: ")]) + (when (and pattern (> (string-length pattern) 0)) + (let ([dir (or (project-current) (current-directory))]) + (echo-message! + echo + (string-append "Fan-out search: " pattern " ...")) + (spawn-worker + 'fan-out-search + (lambda () + (let* ([file-list-output (repl-capture-command + (string-append + "find " + dir + " -name '*.ss' -o -name '*.scm' 2>/dev/null"))] + [files (if (> (string-length file-list-output) 0) + (string-split-newlines file-list-output) + '())]) + (if (null? files) + (ui-queue-push! + (lambda () + (echo-message! echo "No source files found"))) + (let ([results (fan-out-gather + (lambda (file) + (let ([output (repl-capture-command + (string-append "grep -n '" + pattern "' '" + file + "' 2>/dev/null"))]) + (if (> (string-length output) + 0) + (cons file output) + #f))) + files + 8)]) + (let ([hits (filter (lambda (r) r) results)]) + (ui-queue-push! + (lambda () + (if (null? hits) + (echo-message! echo "No matches found") + (let ([buf-text (string-append "Fan-Out Search: " + pattern "\n" + (make-string 60 #\-) + "\n" + (string-join + (map (lambda (hit) + (string-append + "\n--- " + (car hit) + " ---\n" + (cdr hit))) + hits) + "") + "\n\n" + (number->string + (length hits)) + " files matched (fan-out, 8 workers)")]) + (qt-open-or-switch-buffer + app + "*fan-out-search*" + buf-text) + (echo-message! + echo + (string-append + (number->string (length hits)) + " files matched (fan-out parallel)")))))))))))))))) + (def (cmd-future-eval app) + "Evaluate expression as an async future.\n Computation runs in background — editor stays responsive.\n Result delivered via completion token." + (let* ([echo (app-state-echo app)] + [input (qt-echo-read-string app "Future eval: ")]) + (when (and input (> (string-length input) 0)) + (echo-message! + echo + (string-append "Computing in background...")) + (let ([f (async-future + (lambda () + (let* ([expr (with-input-from-string input read)] + [result (eval expr)]) + (with-output-to-string + (lambda () (write result))))))]) + (spawn-worker + 'future-waiter + (lambda () + (let ([result (future-get f)]) + (ui-queue-push! + (lambda () + (if (and (pair? result) + (eq? (car result) 'future-error)) + (echo-error! + echo + (with-output-to-string + (lambda () + (display-exception (cdr result))))) + (echo-message! + echo + (string-append + "Future => " + (format "~a" result))))))))))))) + (define *active-file-generator*--cell (vector #f)) + (define *active-file-gen-name*--cell (vector #f)) + (def (cmd-view-file-lazy app) + "Open a file for lazy incremental viewing via generator.\n Each call to 'view-file-next-page' shows the next 50 lines.\n Uses O(1) memory — never loads the full file." + (let* ([echo (app-state-echo app)] + [path (qt-echo-read-string app "File to view lazily: ")]) + (when (and path (> (string-length path) 0)) + (if (file-exists? path) + (begin + (set! *active-file-generator* + (make-file-line-generator path)) + (set! *active-file-gen-name* path) + (echo-message! + echo + (string-append + "Lazy viewer opened: " + path + " (use view-file-next-page for pages)"))) + (echo-error! + echo + (string-append "File not found: " path)))))) + (def (cmd-view-file-next-page app) + "Show the next 50 lines from the lazy file viewer.\n O(1) memory — file is never fully loaded." + (let ([echo (app-state-echo app)]) + (if (not *active-file-generator*) + (echo-message! + echo + "No lazy file viewer active (use view-file-lazy first)") + (let ([lines '()] [gen *active-file-generator*] [done #f]) + (let loop ([i 0]) + (when (and (< i 50) (not done)) + (let ([line (gen)]) + (if (eof-object? line) + (set! done #t) + (begin + (set! lines (cons line lines)) + (loop (+ i 1))))))) + (if (null? lines) + (begin + (set! *active-file-generator* #f) + (echo-message! echo "End of file reached")) + (let ([buf-name (string-append + "*lazy:" + *active-file-gen-name* + "*")] + [text (string-join (reverse lines) "\n")]) + (qt-open-or-switch-buffer app buf-name text) + (echo-message! + echo + (string-append + (number->string (length lines)) + " lines (lazy generator, O(1) memory)")))))))) + (define *editor-id-counter*--cell (vector (atom 0))) + (def (cmd-generate-id app) + "Generate a unique ID using an atomic counter (atom + swap).\n Thread-safe, monotonically increasing." + (let* ([echo (app-state-echo app)] + [ed (current-qt-editor app)] + [id (atom-deref *editor-id-counter*)]) + (atom-swap! *editor-id-counter* (lambda (n) (+ n 1))) + (qt-plain-text-edit-insert-text! ed (number->string id)) + (echo-message! + echo + (string-append + "Inserted ID: " + (number->string id) + " (atomic counter)")))) + (def (cmd-timed-eval app) + "Evaluate with wall-clock timeout using a completion + thread.\n If the expression doesn't finish in 5 seconds, times out.\n Unlike engine ticks, this is real wall-clock time." + (let* ([echo (app-state-echo app)] + [input (qt-echo-read-string app "Timed eval (5s max): ")]) + (when (and input (> (string-length input) 0)) + (echo-message! echo "Evaluating (5s timeout)...") + (let ([c (make-completion)]) + (spawn-worker + 'timed-eval + (lambda () + (let ([result (with-catch + (lambda (e) + (string-append + "ERROR: " + (with-output-to-string + (lambda () (display-exception e))))) + (lambda () + (let* ([expr (with-input-from-string + input + read)] + [val (eval expr)]) + (string-append + "=> " + (format "~a" val)))))]) + (completion-post! c result)))) + (spawn-worker + 'timed-eval-timeout + (lambda () + (thread-sleep! 5) + (with-catch + (lambda (e) #f) + (lambda () + (completion-post! + c + "TIMEOUT: expression took >5s"))))) + (spawn-worker + 'timed-eval-wait + (lambda () + (let ([result (completion-wait! c)]) + (ui-queue-push! + (lambda () + (echo-message! echo (format "~a" result))))))))))) + (def (cmd-amb-eval app) + "Evaluate an amb expression — nondeterministic search with backtracking.\n The amb operator picks values and backtracks on failure.\n Example: (amb-find (let ((x (amb 1 2 3)) (y (amb 1 2 3)))\n (amb-assert (= (+ x y) 4)) (list x y)))\n => (1 3)" + (let* ([echo (app-state-echo app)] + [input (qt-echo-read-string app "Amb expression: ")]) + (when (and input (> (string-length input) 0)) + (engine-eval-start! + (string-append + "(with-output-to-string (lambda () (write "