From 4b64dc5f654a7b3b0a69bab3173df502eba790f1 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 15:57:09 +0700 Subject: [PATCH] Code-carrying dev requests name their syntax and starting line and column, so a .fln snippet sent from the middle of a buffer reads with the buffer's own locations --- emacs/flan.el | 74 +++++++++++++++++++++++++++----------------- lib/dev.ml | 24 ++++++++++++-- lib/indent_reader.ml | 16 +++++++--- lib/session.ml | 10 +++--- lib/source.ml | 56 +++++++++++++++++++++++++++++++++ spec-syntax.md | 5 ++- test/test_dev.ml | 40 ++++++++++++++++++++++++ test/test_syntax.ml | 36 +++++++++++++++++++++ 8 files changed, 221 insertions(+), 40 deletions(-) diff --git a/emacs/flan.el b/emacs/flan.el index 92e42a89..5b6f4929 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -2579,7 +2579,8 @@ breakpoint is marked from the editor, without editing the buffer\"." ;; buffer-file-name so an error points at the file being edited ;; rather than at the daemon's placeholder. (append - (list :op "eval" :code code :file (or buffer-file-name "")) + (list :op "eval" :code code :file (or buffer-file-name "") + :syntax (flan--syntax)) (when pause (list :pause (flan--wire-position (car pause)))))))) ;; END as the place a value could go. Every caller of this sends a @@ -2615,27 +2616,35 @@ columns already were, because a top-level form starts at column 1." (concat (make-string (1- (line-number-at-pos start)) ?\n) (buffer-substring-no-properties start end))) +(defun flan--syntax () + "The `:syntax' of code sent from this buffer: the indented reader's for a +.fln file, the paren reader's for anything else. Sent explicitly because the +daemon cannot tell from `:file' — an expansion shown in parens is sent back +under the name of the .fln file it came from." + (if (and buffer-file-name (string-suffix-p ".fln" buffer-file-name)) + "indented" + "paren")) + +(defvar flan--code-fields nil + "Extra request fields for the code a command is about to send: its +`:syntax', and `:line'/`:col' when it is sent from the middle of a line.") + (defun flan--text-at (start end) - "The buffer text from START to END, on the line AND column it is written at. + "The buffer text from START to END, and where it starts, as +(TEXT :syntax S :line L :col C). -`flan--text' pads lines only, and says why it needs nothing more: a -top-level form starts at column 1, so the columns already agreed. A macro -call does not. It is written somewhere inside a `defn', and a refusal the -daemon reports against it — a macro that never settles is the one that -happens — carries a column that would otherwise be measured from the start of -the snippet and drawn at the start of the line. - -Leading newlines and leading spaces are both whitespace the reader skips, so -padding with each is the whole fix. Byte columns, for the reason -`flan--wire-position' gives: the reader walks the source a byte at a time, -and a space is one byte, so a byte count is exactly how many to write." +Sent unpadded, with its line and column as fields: the daemon starts its +reader there, so every location in a reply is the buffer's own. Padding +with spaces, which this used to do, cannot work for the indented syntax, +where leading spaces are an indentation. Byte columns, for the reason +`flan--wire-position' gives." (save-excursion (goto-char start) - (concat (make-string (1- (line-number-at-pos start)) ?\n) - (make-string (- (position-bytes start) - (position-bytes (line-beginning-position))) - ?\s) - (buffer-substring-no-properties start end)))) + (list (buffer-substring-no-properties start end) + :syntax (flan--syntax) + :line (line-number-at-pos start) + :col (1+ (- (position-bytes start) + (position-bytes (line-beginning-position))))))) (defun flan--defun-bounds () "Bounds of the top-level form containing or preceding point, as (START . END)." @@ -2804,10 +2813,12 @@ is what puts the error overlay on the character it is about — and the overlay this draws on success would otherwise be competing with one drawn at line 1." (flan--report (flan--request - (append - (list :op "eval-expr" :code (flan--text-at start end) - :file (or buffer-file-name "")) - (when arg (list :pause t)))) + (let ((at (flan--text-at start end))) + (append + (list :op "eval-expr" :code (car at) + :file (or buffer-file-name "")) + (cdr at) + (when arg (list :pause t))))) "expression" end)) @@ -2897,6 +2908,7 @@ the command signals, as `C-c C-c' does." (interactive) (let* ((reply (flan--request (list :op "load-file" :file (or buffer-file-name "") + :syntax (flan--syntax) :code (buffer-substring-no-properties (point-min) (point-max))))) (errors (plist-get reply :errors))) @@ -3230,8 +3242,9 @@ ALL asks for the fixpoint rather than one step. Answers the reply plist, or signals — having drawn the refusal where it happened, which is why the caller sends padded text." (let ((r (funcall flan-macroexpand-request-function - (list :op "macroexpand" :code code :file file - :all (if all t nil))))) + (append (list :op "macroexpand" :code code :file file + :all (if all t nil)) + flan--code-fields)))) (unless (equal (plist-get r :status) "ok") (let ((loc (plist-get r :loc)) (msg (plist-get r :message))) @@ -3264,7 +3277,8 @@ indentation, which lives in `flan-mode' and not in the compiler." (let ((inhibit-read-only t)) (erase-buffer) (flan-macroexpansion-mode) - (setq flan-macroexpand--origin (list :code code :file file :all all)) + (setq flan-macroexpand--origin (list :code code :file file :all all + :fields flan--code-fields)) (let ((start (point))) (insert (format "; macroexpansion, %s\n" (if all "all the way" "one step"))) @@ -3314,10 +3328,11 @@ rather than with what is typed." ;; Padded onto its own line *and column*, unlike `C-x C-e', because ;; the refusals this path can get name a location inside the snippet ;; and a macro call is written well inside a line. - (code (flan--text-at (car b) (cdr b))) + (at (flan--text-at (car b) (cdr b))) + (code (car at)) + (flan--code-fields (cdr at)) (r (flan-macroexpand--ask code file all))) - (flan-macroexpand--render r (buffer-substring-no-properties (car b) (cdr b)) - file all) + (flan-macroexpand--render r code file all) (pulse-momentary-highlight-region (car b) (cdr b)) (unless (plist-get r :expanded) (message "flan: %s" (or (plist-get r :note) "nothing expanded"))) @@ -3346,6 +3361,8 @@ non-nil ALL, take it all the way instead." ;; file, so there is no line or column for a refusal to be drawn at. ;; The file still goes on the wire — it is what tells the daemon which ;; session's macros to expand against. + ;; An expansion is printed in parens whatever its file is written in. + (flan--code-fields (list :syntax "paren")) (r (flan-macroexpand--ask code (plist-get flan-macroexpand--origin :file) all))) (if (not (plist-get r :expanded)) @@ -3377,6 +3394,7 @@ remove." (unless flan-macroexpand--origin (user-error "flan: this is not a macroexpansion buffer")) (let* ((o flan-macroexpand--origin) + (flan--code-fields (plist-get o :fields)) (r (flan-macroexpand--ask (plist-get o :code) (plist-get o :file) (plist-get o :all)))) (flan-macroexpand--render r (plist-get o :code) (plist-get o :file) diff --git a/lib/dev.ml b/lib/dev.ml index 7f052f25..0f4e7e86 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1125,7 +1125,7 @@ let errors_field (ds : Loc.diag list) = survives the reply is a refusal, with the first error where every other refusal puts it. *) let load_file t ~code ~origin = - match Reader.read_all ~file:origin code with + match Source.read_code ~file:origin code with | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg | forms -> @@ -4353,7 +4353,27 @@ let memory_op t ~file = doing the only thing it can. See TODO.org, \"Memory diagnostics \ on demand\"" ] -let handle t req = +(* Every code-carrying request is read in the syntax it names and at the + position it names; see [Source.read_code]. *) +let rec handle t req = + let syntax = + match Wire.string_field req "syntax", Wire.string_field req "op", + Wire.string_field req "file" with + | (Some _ as s), _, _ -> Source.syntax_of_field s + (* A whole file named with no [:syntax] is in the syntax its name says: + that is not a guess, it is what [Source.read_file] would do. *) + | None, Some "load-file", Some f when Source.is_indented f -> Source.Indented + | None, _, _ -> Source.Paren + in + let at = + match Wire.int_field req "line", Wire.int_field req "col" with + | Some l, Some c -> Some (l, c) + | Some l, None -> Some (l, 1) + | _ -> None + in + Source.with_code ~syntax ~at (fun () -> handle_op t req) + +and handle_op t req = match Wire.string_field req "op" with | Some "eval" -> (match Wire.string_field req "code" with diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 57669980..071a94ec 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -91,8 +91,12 @@ let split_fields text = (* ── Lexing ────────────────────────────────────────────────────────── *) -let lex ~file src : token list = +let lex ?(line = 1) ?(col = 1) ~file src : token list = let st = Reader.of_string ~file src in + (* Text taken from the middle of a buffer starts where it was written, so + every location read from it is the buffer's own. *) + st.Reader.line <- line; + st.Reader.col <- col; let out = ref [] in let sp = ref true in let line_start = ref true in @@ -1530,11 +1534,15 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list = (** All top-level forms in a [.fln] source string. [col] is the column the text's top level starts at, 1 for a file. *) -let read_all ?(col = 1) ~file src = +let read_all ?(line = 1) ?(col = 1) ~file src = let saved = !source in - source := (file, Array.of_list (String.split_on_char '\n' src)); + (* The quoted text is indexed by the buffer's lines, so a snippet that + starts on line 40 is padded to start there. *) + source := + (file, Array.of_list (String.split_on_char '\n' + (String.make (line - 1) '\n' ^ String.make (col - 1) ' ' ^ src))); Fun.protect ~finally:(fun () -> source := saved) (fun () -> - let toks = layout ~base:col (lex ~file src) in + let toks = layout ~base:col (lex ~line ~col ~file src) in let s = { p = { toks; i = 0 }; lets = [] } in let fs = stmts s in (match (peek s.p).tok with diff --git a/lib/session.ml b/lib/session.ml index c8553887..d79508bc 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -789,7 +789,7 @@ let rerun t = t.live <- SM.empty there. *) let eval ?(origin = "") ?base ?forms ?pause ?(running = true) t src : change = let forms = - match forms with Some f -> f | None -> Reader.read_all ~file:origin src + match forms with Some f -> f | None -> Source.read_code ~file:origin src in (* What an annotated listing quotes for this form is what was sent, not what the file on disk said when it was last read. *) @@ -2204,7 +2204,7 @@ let write_slot ?(origin = "") t ~frame ~(fn : Tast.fn) ~slot ~path List.map (fun (at, _, tty, code) -> let form = - match Reader.read_all ~file:origin code with + match Source.read_code ~expr:true ~file:origin code with | [ f ] -> f | [] -> fail loc "nothing to store into %s" at | _ :: f :: _ -> fail f.Form.loc "one value at a time" @@ -2328,7 +2328,7 @@ let arm_restart ?(origin = "") t ~index ~(params : Types.t list) List.map2 (fun ty code -> let form = - match Reader.read_all ~file:origin code with + match Source.read_code ~expr:true ~file:origin code with | [ f ] -> f | [] -> fail loc "a value for a %s is empty" (Types.to_string ty) | _ :: f :: _ -> fail f.Form.loc "one value for each parameter" @@ -2509,7 +2509,7 @@ let render_globals ?(origin = "") t ~(globals : Tast.global list) declaration to live in. *) let eval_expr ?(origin = "") ?(pause = false) t src : change = let form = - match Reader.read_all ~file:origin src with + match Source.read_code ~expr:true ~file:origin src with | [ f ] -> f | [] -> fail Loc.unknown "nothing to evaluate" | _ :: f :: _ -> fail f.Form.loc "one expression at a time" @@ -2687,7 +2687,7 @@ type expansion = { [C-u] refuses. *) let macroexpand ?(origin = "") ~(all : bool) t (src : string) : expansion = let form = - match Reader.read_all ~file:origin src with + match Source.read_code ~file:origin src with | [ f ] -> f | [] -> fail Loc.unknown "nothing to expand" | _ :: f :: _ -> fail f.Form.loc "one form at a time" diff --git a/lib/source.ml b/lib/source.ml index 541f9fc6..102da4fd 100644 --- a/lib/source.ml +++ b/lib/source.ml @@ -18,3 +18,59 @@ let is_source path = let read_file path = if is_indented path then Indent_reader.read_file path else Reader.read_file path + +(* ── Code from the editor ───────────────────────────────────────────── + + The dev loop's code-carrying requests say which syntax their [:code] is in + ([:syntax]), and where in the buffer it starts ([:line], [:col]), rather + than having it guessed from [:file]: an expansion shown in paren syntax is + sent back under the name of the .fln file it came from, and a REPL line has + no file at all. [Dev] sets these for the length of one request, and every + place the session reads editor code reads it through [read_code]. *) + +type syntax = Paren | Indented + +let code_syntax = ref Paren +let code_at : (int * int) option ref = ref None + +let syntax_of_field = function + | Some ("indented" | "fln") -> Indented + | _ -> Paren + +let with_code ~syntax ~at f = + let s = !code_syntax and a = !code_at in + code_syntax := syntax; + code_at := at; + Fun.protect ~finally:(fun () -> code_syntax := s; code_at := a) f + +(* The paren reader started at a line and column: [Reader.read_all] always + starts at 1:1. *) +let read_paren ?(line = 1) ?(col = 1) ~file src = + let st = Reader.of_string ~file src in + st.Reader.line <- line; + st.Reader.col <- col; + let rec go acc = + Reader.skip_ignorable st; + if Reader.at_end st then List.rev acc else go (Reader.read_form st :: acc) + in + go [] + +(** Editor code, in the request's syntax and at its position. With [expr], an + indented snippet of several statements is one expression, [(do ...)]: a + block of lines means its lines in order. *) +let read_code ?(expr = false) ~file code = + let line, col = + match !code_at with Some (l, c) -> (l, c) | None -> (1, 1) + in + match !code_syntax with + | Paren -> read_paren ~line ~col ~file code + | Indented -> + (match Indent_reader.read_all ~line ~col ~file code with + | (first :: _ :: _ as forms) when expr -> + let last = List.nth forms (List.length forms - 1) in + let loc = + { first.Form.loc with Loc.eline = last.Form.loc.Loc.eline; + ecol = last.Form.loc.Loc.ecol } + in + [ Form.make (Form.List (Form.make (Form.Sym "do") first.Form.loc :: forms)) loc ] + | forms -> forms) diff --git a/spec-syntax.md b/spec-syntax.md index 2fb6c31d..c62dcd24 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -337,7 +337,10 @@ Each step lands on its own, with `dune test --root .` green. paren-syntax expansion text under the original file's name. Replace the space-padding in `flan--text-at` (`emacs/flan.el:2602-2622`), which breaks significant indentation, with `:line`/`:col` fields; the reader seeds its - indent stack with that column. + indent stack with that column. **Built** (also `load-file` and restart + arguments; no `:syntax` means paren, except a `load-file` of a `.fln` + file; several indented statements sent as one expression read as + `(do …)`). 5. **Emacs mode** for `.fln`: - A top-level form runs from a column-0 line that isn't `else`, `elif`, `on` or `restart` to just before the next one, minus trailing blank and diff --git a/test/test_dev.ml b/test/test_dev.ml index d5446668..fa86db9c 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -634,6 +634,46 @@ let () = finished run's storage, read by a thunk the finished run's thread ran. Nothing is reset between runs and nothing is reset for an evaluation either. *) + (* The indented syntax, named by [:syntax] and placed by [:line] and + [:col] (spec-syntax.md §4 step 4). Several statements are one + expression, [(do ...)], and a refusal is at the buffer's own line + and column, not the snippet's. *) + let r = + request c + "(:op \"eval-expr\" :code \"let a = 20\\na + 3\" :syntax \"indented\" \ + :file \"/tmp/buf.fln\" :line 12 :col 1)" + in + if Wire.string_field r "value" <> Some "23" then + fail "an indented let: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")); + let r = + request c + "(:op \"eval-expr\" :code \"extra\\n4\" :syntax \"indented\" \ + :file \"/tmp/buf.fln\" :line 12 :col 1)" + in + if Wire.string_field r "value" <> Some "4" then + fail "two indented statements as one expression: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")); + let r = + request c + "(:op \"eval-expr\" :code \"1 + nosuch-name\" :syntax \"indented\" \ + :file \"/tmp/buf.fln\" :line 40 :col 7)" + in + (match Wire.string_field r "loc" with + | Some l when contains_sub l "buf.fln:40:11" -> () + | l -> + fail "an indented refusal is at %s, wanted buf.fln:40:11" + (Option.value ~default:"nowhere" l)); + let r = + request c + "(:op \"macroexpand\" :code \"unless(false, 1, 2)\" :syntax \"indented\" \ + :file \"/tmp/buf.fln\" :line 3 :col 5)" + in + (match Wire.string_field r "text" with + | Some t when contains_sub t "(if (not false)" -> () + | _ -> + fail "an indented macro call did not expand: %s" + (Option.value ~default:(status r) (Wire.string_field r "message"))); let r = request c "(:op \"eval-expr\" :code \"extra\" :file \"/tmp/buf.flan\")" in if Wire.string_field r "value" <> Some "105" then fail "a global the finished run left: %s" diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 761ed449..72f35369 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -347,6 +347,42 @@ let () = back "comments to parens" "; head\n\nfn main() -> i32\n ; why\n g() ; note\n 0" "; head\n\n(defn main [] i32\n ; why\n (g) ; note\n 0)" +(* ── Spans, for pause marks and error overlays ──────────────────────── *) + +let span_is name (f : Form.t) (l, c, el, ec) = + let g = f.loc in + if (g.Loc.line, g.Loc.col, g.Loc.eline, g.Loc.ecol) <> (l, c, el, ec) then + fail "%s spans %d:%d-%d:%d, wanted %d:%d-%d:%d" name g.Loc.line g.Loc.col + g.Loc.eline g.Loc.ecol l c el ec + +let () = + (* A rewritten statement spans its text from the first token to the last, + so a mark or an overlay drawn from it covers what was written. *) + match read "x = a.b.c + b + c" with + | [ ({ v = Form.List [ _; _; ({ v = Form.List [ _; abc; _; _ ]; _ } as sum) ]; _ } as set) ] -> + span_is "x = ..." set (1, 1, 1, 18); + span_is "a.b.c + b + c" sum (1, 5, 1, 18); + span_is "a.b.c" abc (1, 5, 1, 10) + | _ -> fail "x = a.b.c + b + c read as another shape" + +let () = + (* Editor code, placed where it was written: line 40, column 5, and the + indent stack seeded with that column, so the next line at column 5 is a + sibling rather than a dedent. *) + Source.with_code ~syntax:Source.Indented ~at:(Some (40, 5)) (fun () -> + match Source.read_code ~expr:true ~file:"" "f(1)\n g(2)" with + | [ ({ v = Form.List [ { v = Form.Sym "do"; _ }; a; b ]; _ } as d) ] -> + span_is "the snippet" d (40, 5, 41, 9); + span_is "its first line" a (40, 5, 40, 9); + span_is "its second line" b (41, 5, 41, 9) + | fs -> + fail "a two-line snippet read as %s" + (String.concat " " (List.map Form.to_string fs))); + Source.with_code ~syntax:Source.Paren ~at:(Some (7, 3)) (fun () -> + match Source.read_code ~file:"" "(f 1)" with + | [ f ] -> span_is "a paren snippet" f (7, 3, 7, 8) + | _ -> fail "a paren snippet") + (* ── Loading ───────────────────────────────────────────────────────── *) let write path text = Out_channel.with_open_bin path (fun oc -> output_string oc text)