From 033b2cb304e9552d1ef116d0a2fc95ae92e088d4 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 16:45:39 +0000 Subject: [PATCH] Add section comments to evaluator.sx, show comments in sx_summarise MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/mcp_tree.ml | 55 +++++++++++---- spec/evaluator.sx | 134 ++++++++++++++++++++++++++++++++++-- 2 files changed, 169 insertions(+), 20 deletions(-) diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 1a3fe71b..2ec947b6 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -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 diff --git a/spec/evaluator.sx b/spec/evaluator.sx index f781c59d..e89f78fd 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -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)))))