coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add section comments to evaluator.sx, show comments in sx_summarise

Browse Source 
evaluator.sx: 11 section headers + 27 subgroup/function comments
documenting the CEK machine structure (state, frames, kont ops,
extension points, eval utilities, machine core, special forms,
call dispatch, HO forms, continue phase, entry points).

mcp_tree.ml: sx_summarise and sx_read_tree now inject file comments
into their output — comments appear as un-numbered annotation lines
between indexed entries, so indices stay correct for editing.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 16:45:39 +00:00
parent 2e329f273a
commit 033b2cb304
2 changed files with 169 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -527,6 +527,38 @@ let write_edit_with_comments file cmap result =
error_result ("Error: " ^ err))
| _ -> error_result "Unexpected result type"
(* Inject comment text into summarise/annotate output.
Matches [N] markers and inserts the comment block that precedes expr N. *)
let inject_comments output cmap =
if Hashtbl.length cmap.before = 0 && cmap.trailing = [] then output
else
let lines = String.split_on_char '\n' output in
let buf = Buffer.create (String.length output + 512) in
let first = ref true in
List.iter (fun line ->
(* Check if line starts with [N] *)
let idx = if String.length line > 1 && line.[0] = '[' then
(try Scanf.sscanf line "[%d]" (fun n -> Some n) with _ -> None)
else None in
(match idx with
| Some n ->
(match Hashtbl.find_opt cmap.before n with
| Some comments ->
List.iter (fun c ->
if not !first then Buffer.add_char buf '\n';
first := false;
match c with
| Comment text -> Buffer.add_string buf text
| _ -> ()
) comments
| None -> ())
| None -> ());
if not !first then Buffer.add_char buf '\n';
first := false;
Buffer.add_string buf line
) lines;
Buffer.contents buf
(* ------------------------------------------------------------------ *)
(* Tool handlers *)
(* ------------------------------------------------------------------ *)
@@ -536,39 +568,36 @@ let handle_tool name args =
match name with
| "sx_read_tree" ->
let file = args |> member "file" |> to_string in
let tree = parse_file file in
let tree, cmap = parse_file_with_comments file in
let focus = args |> member "focus" |> to_string_option in
let max_depth = args |> member "max_depth" |> to_int_option in
let max_lines = args |> member "max_lines" |> to_int_option in
let offset = args |> member "offset" |> to_int_option |> Option.value ~default:0 in
(match focus with
| Some pattern ->
(* Focus mode: expand matching subtrees, collapse rest *)
text_result (value_to_string (call_sx "annotate-focused" [tree; String pattern]))
text_result (inject_comments (value_to_string (call_sx "annotate-focused" [tree; String pattern])) cmap)
| None ->
match max_lines with
| Some limit ->
(* Paginated mode *)
text_result (value_to_string (call_sx "annotate-paginated"
[tree; Number (float_of_int offset); Number (float_of_int limit)]))
text_result (inject_comments (value_to_string (call_sx "annotate-paginated"
[tree; Number (float_of_int offset); Number (float_of_int limit)])) cmap)
| None ->
match max_depth with
| Some depth ->
(* Depth-limited mode *)
text_result (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)]))
text_result (inject_comments (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) cmap)
| None ->
(* Auto mode: full tree if small, summarise if large *)
let full = value_to_string (call_sx "annotate-tree" [tree]) in
let line_count = 1 + String.fold_left (fun n c -> if c = '\n' then n + 1 else n) 0 full in
if line_count <= 200 then text_result full
if line_count <= 200 then text_result (inject_comments full cmap)
else
let summary = value_to_string (call_sx "summarise" [tree; Number 2.0]) in
text_result (Printf.sprintf ";; File has %d lines — showing depth-2 summary. Use max_depth, max_lines, or focus to control output.\n%s" line_count summary))
text_result (inject_comments (Printf.sprintf ";; File has %d lines — showing depth-2 summary. Use max_depth, max_lines, or focus to control output.\n%s" line_count summary) cmap))
| "sx_summarise" ->
let tree = parse_file (args |> member "file" |> to_string) in
let file = args |> member "file" |> to_string in
let tree, cmap = parse_file_with_comments file in
let depth = args |> member "depth" |> to_int in
text_result (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)]))
text_result (inject_comments (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) cmap)
| "sx_read_subtree" ->
let tree = parse_file (args |> member "file" |> to_string) in

134
spec/evaluator.sx
View File

@@ -1,3 +1,10 @@
;; ═══════════════════════════════════════════════════════════════
;; Part 1: CEK State
;;
;; The CEK machine state is a 5-tuple: {control, env, kont, value, phase}.
;; In "eval" phase, control holds the expression to evaluate.
;; In "continue" phase, value holds the result and kont is unwound.
;; ═══════════════════════════════════════════════════════════════
(define make-cek-state (fn (control env kont) {:control control :env env :kont kont :value nil :phase "eval"}))
(define make-cek-value (fn (value env kont) {:control nil :env env :kont kont :value value :phase "continue"}))
@@ -18,6 +25,13 @@
(define cek-value (fn (s) (get s "value")))
;; ═══════════════════════════════════════════════════════════════
;; Part 2: Continuation Frames
;;
;; Each frame type represents a pending computation — what to do
;; when the current sub-expression finishes evaluating. The kont
;; (continuation) is a list of frames, forming a reified call stack.
;; ═══════════════════════════════════════════════════════════════
(define make-if-frame (fn (then-expr else-expr env) {:else else-expr :env env :type "if" :then then-expr}))
(define make-when-frame (fn (body-exprs env) {:body body-exprs :env env :type "when"}))
@@ -30,6 +44,7 @@
(define make-set-frame (fn (name env) {:env env :type "set" :name name}))
;; Function call frames: accumulate evaluated args, then dispatch
(define
make-arg-frame
(fn (f evaled remaining env raw-args head-name) {:env env :head-name (or head-name nil) :evaled evaled :type "arg" :f f :remaining remaining :raw-args raw-args}))
@@ -55,6 +70,7 @@
fenv)
(eval-expr (list form (list (quote quote) value)) fenv))))
;; Higher-order iteration frames
(define make-map-frame (fn (f remaining results env) {:indexed false :env env :results results :type "map" :f f :remaining remaining}))
(define make-map-indexed-frame (fn (f remaining results env) {:indexed true :env env :results results :type "map" :f f :remaining remaining}))
@@ -73,12 +89,14 @@
(define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining}))
;; Scope/provide/context — downward data passing without env threading
(define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name}))
(define make-provide-frame (fn (name value remaining env) {:env env :value value :type "provide" :remaining remaining :name name}))
(define make-scope-acc-frame (fn (name value remaining env) {:env env :value (or value nil) :type "scope-acc" :remaining remaining :emitted (list) :name name}))
;; Delimited continuations (shift/reset)
(define make-reset-frame (fn (env) {:env env :type "reset"}))
(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))
@@ -87,6 +105,7 @@
(define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining}))
;; Dynamic wind + reactive signals
(define
make-dynamic-wind-frame
(fn (phase body-thunk after-thunk env) {:env env :phase phase :after-thunk after-thunk :type "dynamic-wind" :body-thunk body-thunk}))
@@ -95,10 +114,14 @@
make-reactive-reset-frame
(fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"}))
;; Undelimited continuations (call/cc)
(define make-callcc-frame (fn (env) {:env env :type "callcc"}))
(define make-deref-frame (fn (env) {:env env :type "deref"}))
;; HO setup: staged argument evaluation for map/filter/etc.
;; Evaluates args one at a time, then dispatches to the correct
;; HO frame (map, filter, reduce) once all args are ready.
(define
make-ho-setup-frame
(fn (ho-type remaining-args evaled-args env) {:ho-type ho-type :env env :evaled evaled-args :type "ho-setup" :remaining remaining-args}))
@@ -119,16 +142,24 @@
(cons {:file (get frame "file") :name (get frame "name")} (kont-collect-comp-trace (rest kont)))
(kont-collect-comp-trace (rest kont)))))))
;; Condition system frames (handler-bind, restart-case, signal)
(define make-handler-frame (fn (handlers remaining env) {:env env :type "handler" :f handlers :remaining remaining}))
(define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining}))
(define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))
;; R7RS exception frames (raise, guard)
(define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"}))
(define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont}))
;; ═══════════════════════════════════════════════════════════════
;; Part 3: Continuation Stack Operations
;;
;; Searching and manipulating the kont list — finding handlers,
;; restarts, scope accumulators, and capturing delimited slices.
;; ═══════════════════════════════════════════════════════════════
(define
find-matching-handler
(fn
@@ -197,6 +228,7 @@
(list match frame (rest kont))))
(kont-find-restart (rest kont) name))))))
;; Basic kont operations
(define frame-type (fn (f) (get f "type")))
(define kont-push (fn (frame kont) (cons frame kont)))
@@ -207,6 +239,7 @@
(define kont-empty? (fn (kont) (empty? kont)))
;; Capture frames up to a reset boundary — used by shift
(define
kont-capture-to-reset
(fn
@@ -291,6 +324,12 @@
(scan (rest k) (append captured (list frame))))))))
(scan kont (list))))
;; ═══════════════════════════════════════════════════════════════
;; Part 4: Extension Points & Mutable State
;;
;; Custom special forms registry, render hooks, strict mode.
;; Mutable globals use set! — the transpiler emits OCaml refs.
;; ═══════════════════════════════════════════════════════════════
(define *custom-special-forms* (dict))
(define
@@ -418,8 +457,18 @@
(fn (i v) (list i v))
(slice args (len (or positional (list)))))))))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 5: Evaluation Utilities
;;
;; Forward-declared eval-expr, lambda/component calling, keyword
;; arg parsing, special form constructors (lambda, defcomp,
;; defmacro, quasiquote), and macro expansion.
;; ═══════════════════════════════════════════════════════════════
;; Forward declaration — redefined at end of file as CEK entry point
(define eval-expr (fn (expr (env :as dict)) nil))
;; Shared param binding for lambda/component calls.
;; Handles &rest collection — used by both call-lambda and continue-with-call.
(define
bind-lambda-params
(fn
@@ -470,6 +519,7 @@
(slice params (len args))))
(make-thunk (lambda-body f) local))))
;; Component calls: parse keyword args, bind params, TCO thunk
(define
call-component
(fn
@@ -518,6 +568,7 @@
raw-args)
(list kwargs children))))
;; Cond/case helpers
(define
cond-scheme?
(fn
@@ -545,6 +596,7 @@
(= (type-of test) "symbol")
(or (= (symbol-name test) "else") (= (symbol-name test) ":else"))))))
;; Special form constructors — build state for CEK evaluation
(define
sf-named-let
(fn
@@ -795,6 +847,7 @@
params-expr)
(list params rest-param))))
;; Quasiquote expansion
(define
qq-expand
(fn
@@ -950,6 +1003,7 @@
(scope-pop! name)
result)))
;; Macro expansion — expand then re-evaluate the result
(define
expand-macro
(fn
@@ -975,6 +1029,14 @@
(slice raw-args (len (macro-params mac)))))
(trampoline (eval-expr (macro-body mac) local)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define
cek-run
(fn
@@ -1046,6 +1108,12 @@
(step-eval-list expr env kont))
:else (make-cek-value expr env kont)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define
step-sf-raise
(fn
@@ -1055,6 +1123,7 @@
env
(kont-push (make-raise-eval-frame env false) kont))))
;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
(define
step-sf-guard
(fn
@@ -1128,6 +1197,9 @@
env
kont))))
;; List evaluation — dispatches on head: special forms, macros,
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define
step-eval-list
(fn
@@ -1274,6 +1346,7 @@
:else (step-eval-call head args env kont)))))
(step-eval-call head args env kont))))))
;; call/cc: capture entire kont as undelimited escape continuation
(define
step-sf-callcc
(fn
@@ -1332,6 +1405,7 @@
pairs)))
:else (= pattern value))))
;; Pattern matching (match form)
(define
step-sf-match
(fn
@@ -1346,6 +1420,7 @@
(error (str "match: no clause matched " (inspect val)))
(make-cek-state (nth result 1) (first result) kont))))))
;; Condition system special forms
(define
step-sf-handler-bind
(fn
@@ -1646,6 +1721,7 @@
step-sf-lambda
(fn (args env kont) (make-cek-value (sf-lambda args env) env kont)))
;; Scope/provide/context — structured downward data passing
(define
step-sf-scope
(fn
@@ -1701,9 +1777,11 @@
nil))
(frame (kont-find-provide kont name)))
(make-cek-value
(if frame
(if
frame
(get frame "value")
(if (env-has? env "context")
(if
(env-has? env "context")
(apply (env-get env "context") (list name default-val))
default-val))
env
@@ -1717,12 +1795,17 @@
((name (trampoline (eval-expr (first args) env)))
(val (trampoline (eval-expr (nth args 1) env)))
(frame (kont-find-scope-acc kont name)))
(if frame
(if
frame
(do
(dict-set! frame "emitted" (append (get frame "emitted") (list val)))
(dict-set!
frame
"emitted"
(append (get frame "emitted") (list val)))
(make-cek-value nil env kont))
(do
(when (env-has? env "scope-emit!")
(when
(env-has? env "scope-emit!")
(apply (env-get env "scope-emit!") (list name val)))
(make-cek-value nil env kont))))))
@@ -1734,14 +1817,17 @@
((name (trampoline (eval-expr (first args) env)))
(frame (kont-find-scope-acc kont name)))
(make-cek-value
(if frame
(if
frame
(get frame "emitted")
(if (env-has? env "emitted")
(if
(env-has? env "emitted")
(apply (env-get env "emitted") (list name))
(list)))
env
kont))))
;; Delimited continuations
(define
step-sf-reset
(fn
@@ -1768,6 +1854,7 @@
(env-bind! shift-env k-name k)
(make-cek-state body shift-env rest-kont))))))
;; Signal dereferencing with reactive dependency tracking
(define
step-sf-deref
(fn
@@ -1777,6 +1864,13 @@
env
(kont-push (make-deref-frame env) kont))))
;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;;
;; cek-call: invoke a function from native code (runs a nested
;; trampoline). step-eval-call: CEK-native call dispatch for
;; lambda, component, native fn, and continuations.
;; ═══════════════════════════════════════════════════════════════
(define
cek-call
(fn
@@ -1790,6 +1884,7 @@
(cek-run (continue-with-call f a (make-env) a (list)))
:else nil))))
;; Reactive signal tracking — captures dependency continuation for re-render
(define
reactive-shift-deref
(fn
@@ -1825,6 +1920,13 @@
env
(kont-push (make-arg-frame nil (list) args env args hname) kont)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define
ho-form-name?
(fn
@@ -2048,6 +2150,14 @@
(make-ho-setup-frame "for-each" (rest args) (list) env)
kont))))
;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define
step-continue
(fn
@@ -2705,6 +2815,9 @@
(set! *last-error-kont* rest-k)
(error (str "Unknown frame type: " ft))))))))))
;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define
continue-with-call
(fn
@@ -2796,6 +2909,13 @@
(make-cek-state body env kont)
(sf-case-step-loop match-val (slice clauses 2) env kont))))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
;;
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define
eval-expr-cek
(fn (expr env) (cek-run (make-cek-state expr env (list)))))