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

@@ -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 "<buffer>"))
+           (list :op "eval" :code code :file (or buffer-file-name "<buffer>")
+                 :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
+Sent unpadded, with its line and column as fields: the daemon starts its
-top-level form starts at column 1, so the columns already agreed.  A macro
+reader there, so every location in a reply is the buffer's own.  Padding
-call does not.  It is written somewhere inside a `defn', and a refusal the
+with spaces, which this used to do, cannot work for the indented syntax,
-daemon reports against it — a macro that never settles is the one that
+where leading spaces are an indentation.  Byte columns, for the reason
-happens — carries a column that would otherwise be measured from the start of
+`flan--wire-position' gives."
-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."
   (save-excursion
     (goto-char start)
-    (concat (make-string (1- (line-number-at-pos start)) ?\n)
+    (list (buffer-substring-no-properties start end)
-            (make-string (- (position-bytes start)
+          :syntax (flan--syntax)
-                            (position-bytes (line-beginning-position)))
+          :line (line-number-at-pos start)
-                         ?\s)
+          :col (1+ (- (position-bytes start)
-            (buffer-substring-no-properties start end))))
+                      (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
+    (let ((at (flan--text-at start end)))
-     (list :op "eval-expr" :code (flan--text-at start end)
+      (append
-           :file (or buffer-file-name "<buffer>"))
+       (list :op "eval-expr" :code (car at)
-     (when arg (list :pause t))))
+             :file (or buffer-file-name "<buffer>"))
+       (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 "<buffer>")
+                       :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
+                    (append (list :op "macroexpand" :code code :file file
-                          :all (if all t nil)))))
+                                  :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))
+    (flan-macroexpand--render r code file all)
-                              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)

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

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

lib/session.ml

@@ -789,7 +789,7 @@ let rerun t = t.live <- SM.empty
    there. *)
 let eval ?(origin = "<eval>") ?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 = "<set>") 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 = "<restart>") 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 = "<globals>") t ~(globals : Tast.global list)
    declaration to live in. *)
 let eval_expr ?(origin = "<eval>") ?(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 = "<eval>") ~(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"

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)

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

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"

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:"<buf>" "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:"<buf>" "(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)