A converted comment stays with the form it was written beside when the printer reorders or splits bindings, the round trip checks each comment's form, and a snippet's first line sets its left edge

This commit is contained in:
Joseph Ferano 2026-09-25 16:17:12 +07:00
parent 4b64dc5f65
commit 30373ffda5
6 changed files with 279 additions and 61 deletions

View File

@ -2808,9 +2808,10 @@ why one `C-u' and two mean the same thing here.
`flan--text-at' rather than `flan--text': an expression is not a top-level
form and does not start at column 1, so a refusal the daemon reports against
it carries a column measured from the start of the snippet. Padding both ways
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."
it carries a column measured from the start of the snippet unless the request
says where the snippet starts. The `:line' and `:col' fields it sends are what
put 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
(let ((at (flan--text-at start end)))

View File

@ -457,7 +457,8 @@ and sugar n ~last (f : Form.t) : string list option =
then Some [ line ]
else
Some
([ i ^ "if " ^ at 1 c ] @ slot (n + 2) a @ [ i ^ "else" ] @ slot (n + 2) b)
([ i ^ "if " ^ at 1 c ] @ slot (n + 2) a
@ [ Source_text.tag b.loc.Loc.line (i ^ "else") ] @ slot (n + 2) b)
| Form.List ({ v = Form.Sym "when"; _ } :: c :: (_ :: _ as body)) ->
Some ((i ^ "if " ^ at 1 c) :: block (n + 2) body)
| Form.List ({ v = Form.Sym "cond"; _ } :: args) ->
@ -466,7 +467,7 @@ and sugar n ~last (f : Form.t) : string list option =
| Some prs ->
let tests, else_ =
match List.rev prs with
| (k, e) :: rest when is_else k -> (List.rev rest, Some e)
| (k, e) :: rest when is_else k -> (List.rev rest, Some (k, e))
| _ -> (prs, None)
in
if List.length tests < 2 then None
@ -475,10 +476,15 @@ and sugar n ~last (f : Form.t) : string list option =
(List.concat
(List.mapi
(fun j (c, b) ->
(i ^ (if j = 0 then "if " else "elif ") ^ at 1 c) :: slot (n + 2) b)
(* Each test's line carries the test's own line, so a
comment written above a clause stays above it. *)
Source_text.tag (c : Form.t).loc.Loc.line
(i ^ (if j = 0 then "if " else "elif ") ^ at 1 c)
:: slot (n + 2) b)
tests)
@ (match else_ with
| Some e -> (i ^ "else") :: slot (n + 2) e
| Some ((k : Form.t), e) ->
Source_text.tag k.loc.Loc.line (i ^ "else") :: slot (n + 2) e
| None -> [])))
| Form.List ({ v = Form.Sym (("while" | "until") as w); _ } :: rest) ->
let lbl, rest = label_of rest in
@ -614,6 +620,7 @@ and sugar n ~last (f : Form.t) : string list option =
| Form.List [ { v = Form.Sym "defdata"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec cs; _ } ]
when def_name name ->
let case (c : Form.t) =
Option.map (Source_text.tag c.loc.Loc.line) @@
match c.v with
| Form.Sym s when def_name s -> Some s
| Form.List [ { v = Form.Sym s; _ }; { v = Form.Vec ps; _ } ] when def_name s ->
@ -622,20 +629,26 @@ and sugar n ~last (f : Form.t) : string list option =
in
let cs = List.map case cs in
if List.mem None cs then None
else Some ((i ^ "data " ^ name) :: List.map (fun c -> ind (n + 2) ^ Option.get c) cs)
else
Some ((i ^ "data " ^ name)
:: List.map (fun c ->
let tags, body = Source_text.untag (Option.get c) in
List.fold_left (fun l t -> Source_text.tag t l) (ind (n + 2) ^ body) tags) cs)
| Form.List [ { v = Form.Sym "defenum"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec ms; _ } ]
when def_name name ->
let rec members = function
| { Form.v = Form.Sym m; _ } :: ({ Form.v = Form.Int _ | Form.UInt _; _ } as v) :: rest
| ({ Form.v = Form.Sym m; _ } as mf) :: ({ Form.v = Form.Int _ | Form.UInt _; _ } as v) :: rest
when def_name m ->
Option.map (fun r -> (m ^ " = " ^ fst (expr v)) :: r) (members rest)
| { Form.v = Form.Sym m; _ } :: rest when def_name m ->
Option.map (fun r -> m :: r) (members rest)
Option.map (fun r -> (mf.loc.Loc.line, m ^ " = " ^ fst (expr v)) :: r) (members rest)
| ({ Form.v = Form.Sym m; _ } as mf) :: rest when def_name m ->
Option.map (fun r -> (mf.loc.Loc.line, m) :: r) (members rest)
| [] -> Some []
| _ -> None
in
Option.map
(fun ms -> (i ^ "enum " ^ name) :: List.map (fun m -> ind (n + 2) ^ m) ms)
(fun ms ->
(i ^ "enum " ^ name)
:: List.map (fun (l, m) -> Source_text.tag l (ind (n + 2) ^ m)) ms)
(members ms)
| Form.List [ { v = Form.Sym "import"; _ }; { v = Form.Sym a; _ }; ({ v = Form.Str _; _ } as p) ]
when def_name a ->
@ -666,15 +679,21 @@ and let_lines n ~last prs body =
("let " ^ x ^ ": " ^ ty ty_, w)
| _ -> ("let " ^ guard (at 8 t), v)
in
if last then
List.concat_map (fun b -> let p, v = bind b in value_lines n p v) prs @ block n body
(* Each binding line carries its own source line, so a comment written
after a binding stays on it. *)
let tagged ((t : Form.t), _) = function
| first :: more -> Source_text.tag t.loc.Loc.line first :: more
| [] -> []
in
let lines n b = let p, v = bind b in tagged b (value_lines n p v) in
if last then List.concat_map (lines n) prs @ block n body
else
match prs with
| b :: rest ->
let p, v = bind b in
(ind n ^ p ^ " = " ^ at 0 v)
:: (List.concat_map (fun b -> let p, v = bind b in value_lines (n + 2) p v) rest
@ block (n + 2) body)
tagged b [ ind n ^ p ^ " = " ^ at 0 v ]
@ List.concat_map (lines (n + 2)) rest
@ block (n + 2) body
| [] -> block n body
(** A whole file: top-level forms with a blank line between them. *)
@ -701,6 +720,6 @@ let program ?source (fs : Form.t list) : string =
inside := (fun _ -> false);
(* With the source, its comments go back where they were; without it the
tags come out and nothing goes in. *)
Source_text.weave
Source_text.weave ~starts:(Source_text.form_starts fs)
(match source with Some src -> Source_text.comments src | None -> [])
text

View File

@ -220,9 +220,12 @@ let point (l : Loc.t) = { l with Loc.line = l.Loc.eline; col = l.Loc.ecol }
(* NEWLINE, INDENT and DEDENT, at bracket depth zero only: inside ( [ { a
line break is whitespace. A line continues the one before it when either
side of the break is a spaced binary operator (spec §2 "Continuation"). *)
let layout ?(base = 1) (toks : token list) : token array =
let layout ?(snippet = false) ?(base = 1) (toks : token list) : token array =
let arr = Array.of_list toks in
let n = Array.length arr in
(* A snippet from the editor starts wherever it was written, and its first
line is its base: a later line may not go left of it. *)
let base = if snippet && n > 0 then arr.(0).loc.Loc.col else base in
let out = ref [] in
let add tok loc = out := { tok; loc; sp = true } :: !out in
let stack = ref [ base ] in
@ -276,6 +279,21 @@ let layout ?(base = 1) (toks : token list) : token array =
add INDENT at
end
else if col < top then begin
if col < base then
failk "dedent" t.loc
"%s"
(if snippet then
Printf.sprintf
"this line starts at column %d, left of column %d where \
the code sent starts. Its first line sets its left \
edge, and no later line can go left of it: send the \
enclosing form, or line this up at column %d or right \
of it"
col base base
else
Printf.sprintf
"this line starts at column %d, left of the top level at \
column %d" col base);
let closed = ref top in
let rec pop () =
match !stack with
@ -843,10 +861,14 @@ let rec ty p : Form.t =
as a call does not. *)
type st = { p : p; mutable lets : Form.t list }
(* A block of several lines is a [do] spanning its lines, from the first
statement to the end of the last — not from the header above it, which is
another form's. *)
let blk (s : st) l (ss : Form.t list) =
match ss with
| [ x ] -> x
| _ -> mk s.p l (Form.List (sym l "do" :: ss))
| (first : Form.t) :: _ -> mk s.p first.loc (Form.List (sym first.loc "do" :: ss))
| [] -> mk s.p l (Form.List [ sym l "do" ])
let is_lambda_candidate (e : Form.t) =
match e.v with
@ -1534,7 +1556,9 @@ 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 ?(line = 1) ?(col = 1) ~file src =
let read_all ?(line = 1) ?col ~file src =
let snippet = col <> None in
let col = Option.value col ~default:1 in
let saved = !source in
(* The quoted text is indexed by the buffer's lines, so a snippet that
starts on line 40 is padded to start there. *)
@ -1542,7 +1566,7 @@ let read_all ?(line = 1) ?(col = 1) ~file src =
(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 ~line ~col ~file src) in
let toks = layout ~snippet ~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

View File

@ -40,7 +40,13 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
let bracket o c items ~keep =
let placed inner x =
match layout spell inner x with
| first :: more -> tagl x ((String.make inner ' ' ^ first) :: more)
| first :: more ->
(* The pad goes after any tags, which lead the line. *)
let tags, body = Source_text.untag first in
let padded =
List.fold_left (fun l t -> Source_text.tag t l) (String.make inner ' ' ^ body) tags
in
tagl x (padded :: more)
| [] -> []
in
let lines =
@ -52,14 +58,37 @@ let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
if keep > 0 then
let first = List.filteri (fun i _ -> i < keep) items in
let rest = List.filteri (fun i _ -> i >= keep) items in
(o ^ String.concat " " (List.map (flat spell) first))
:: List.concat_map (placed (col + 2)) rest
let before = List.filteri (fun i _ -> i < keep - 1) first in
match List.nth first (keep - 1) with
(* A binding vector with a comment inside it — [(let [a 1 ; first
b 2] ...)] — goes a pair to a line, each line carrying its pair's
source line, so a comment after a binding stays on it. *)
| { Form.v = Form.Vec vs; _ } as v
when keep > 1 && inside v && List.length vs mod 2 = 0 ->
let lead = o ^ String.concat " " (List.map (flat spell) before) ^ " [" in
let pad = String.make (col + String.length lead) ' ' in
let rec pairs k = function
| (a : Form.t) :: b :: more ->
Source_text.tag a.loc.Loc.line
((if k = 0 then lead else pad) ^ flat spell a ^ " " ^ flat spell b)
:: pairs (k + 1) more
| _ -> []
in
let ps = pairs 0 vs in
let np = List.length ps in
List.mapi (fun i l -> if i = np - 1 then l ^ "]" else l) ps
@ List.concat_map (placed (col + 2)) rest
| _ ->
(o ^ String.concat " " (List.map (flat spell) first))
:: List.concat_map (placed (col + 2)) rest
else
match items with
| [] -> [ o ]
| x :: xs ->
(match layout spell (col + 1) x with
| first :: more -> (o ^ first) :: more
| first :: more ->
let tags, body = Source_text.untag first in
List.fold_left (fun l t -> Source_text.tag t l) (o ^ body) tags :: more
| [] -> [ o ])
@ List.concat_map (placed (col + 1)) xs
in
@ -97,4 +126,4 @@ let program ?source (fs : Form.t list) : string =
fs)
^ "\n"
in
Source_text.weave cs text
Source_text.weave ~starts:(Source_text.form_starts fs) cs text

View File

@ -81,61 +81,96 @@ let spelling (src : string) : Form.t -> string option =
line that came from after it, a trailing comment at the end of the line
the code it followed was printed on. *)
let tag (line : int) (text : string) =
(* A tag already there is a form nested at the start of this one's first
line; the outer form started no later, so it wins. *)
let text =
if String.length text > 0 && text.[0] = '\001' then
match String.index_opt text '\002' with
| Some k -> String.sub text (k + 1) (String.length text - k - 1)
| None -> text
else text
in
if line <= 0 then text
else "\001" ^ string_of_int line ^ "\002" ^ text
let untag (text : string) : int option * string =
(* A line can come from several forms — a statement and the test at its
start — so it carries every line they started on. *)
let untag (text : string) : int list * string =
if String.length text > 0 && text.[0] = '\001' then
match String.index_opt text '\002' with
| Some k ->
(int_of_string_opt (String.sub text 1 (k - 1)),
(List.filter_map int_of_string_opt
(String.split_on_char ',' (String.sub text 1 (k - 1))),
String.sub text (k + 1) (String.length text - k - 1))
| None -> (None, text)
else (None, text)
| None -> ([], text)
else ([], text)
let tag (line : int) (text : string) =
let tags, body = untag text in
let tags = if line > 0 && not (List.mem line tags) then line :: tags else tags in
if tags = [] then body
else "\001" ^ String.concat "," (List.map string_of_int tags) ^ "\002" ^ body
let indent_of s =
let n = String.length s in
let rec go i = if i < n && s.[i] = ' ' then go (i + 1) else i in
go 0
let weave (cs : comment list) (text : string) : string =
(** Where every form in [fs] starts, as (line, col), in source order. *)
let form_starts (fs : Form.t list) : (int * int) list =
let out = ref [] in
let rec walk (f : Form.t) =
out := (f.loc.Loc.line, f.loc.Loc.col) :: !out;
match f.v with
| Form.List l | Form.Vec l | Form.Map l -> List.iter walk l
| _ -> ()
in
List.iter walk fs;
List.sort_uniq compare !out
let weave ?(starts = []) (cs : comment list) (text : string) : string =
let lines = Array.of_list (List.map untag (String.split_on_char '\n' text)) in
let n = Array.length lines in
let tags = Array.map fst lines and body = Array.map snd lines in
let all = Array.map fst lines and body = Array.map snd lines in
(* For ordering, a line is as early as the earliest form on it. *)
let tags =
Array.map (function [] -> None | l -> Some (List.fold_left min max_int l)) all
in
let before = Array.make (n + 1) [] and trailing = Array.make n [] in
List.iter
(fun c ->
(* The line printed from exactly [line], when one was: a printer
may reorder forms — handler-bind's clauses go after its body — so a
comment goes with the form, not with whatever line follows. *)
let exact line =
let r = ref (-1) in
Array.iteri (fun i t -> if List.mem line t && !r < 0 then r := i) all;
!r
in
if c.own_line then begin
(* The first line printed from code after the comment. *)
(* The form it precedes: the first to start after it. *)
let owner =
List.find_opt (fun (l, _) -> l > c.line) starts |> Option.map fst
in
let rec find i =
if i >= n then n
else match tags.(i) with Some t when t > c.line -> i | _ -> find (i + 1)
in
let i = find 0 in
let i =
match owner with
| Some l when exact l >= 0 -> exact l
| _ -> find 0
in
before.(i) <- c :: before.(i)
end
else begin
(* The line the code before it went to: the latest line tagged at
or before the comment's own line. *)
let best = ref (-1) and best_tag = ref 0 in
Array.iteri
(fun i t ->
match t with
| Some t when t <= c.line && t >= !best_tag -> best := i; best_tag := t
| _ -> ())
tags;
if !best < 0 then before.(0) <- c :: before.(0)
else trailing.(!best) <- c :: trailing.(!best)
(* The line the code before it went to: the one printed from its own
line, or else the latest line tagged at or before it. *)
let last_exact =
let r = ref (-1) in
Array.iteri (fun i t -> if List.mem c.line t then r := i) all;
!r
in
if last_exact >= 0 then trailing.(last_exact) <- c :: trailing.(last_exact)
else begin
let best = ref (-1) and best_tag = ref 0 in
Array.iteri
(fun i t ->
match t with
| Some t when t <= c.line && t >= !best_tag -> best := i; best_tag := t
| _ -> ())
tags;
if !best < 0 then before.(0) <- c :: before.(0)
else trailing.(!best) <- c :: trailing.(!best)
end
end)
cs;
let b = Buffer.create (String.length text + 256) in

View File

@ -100,6 +100,93 @@ let comment_texts src =
List.sort compare
(List.map (fun (c : Source_text.comment) -> String.trim c.text) (Source_text.comments src))
(* What each comment is attached to. An own-line comment belongs to the form
after it; a trailing one to the last form that starts on its line. After a
conversion, the form after an own-line comment must be that form or one
holding it (a comment inside an expression printed on one line goes above
the line), and a trailing comment's line — or, when it had to move onto a
line of its own, the line above — must hold its form. So a comment that
drifted to another statement is caught, not only a lost one. *)
let starts_of (fs : Form.t list) =
let out = ref [] in
let rec walk (f : Form.t) =
(* Outermost first among forms starting at one place: [x = v] and its
[x] start together, and the statement is what a comment is about. *)
let t = Form.to_string (norm f) in
out := ((f.loc.Loc.line, f.loc.Loc.col, - String.length t), t) :: !out;
match f.v with
| Form.List l | Form.Vec l | Form.Map l -> List.iter walk l
| _ -> ()
in
List.iter walk fs;
List.map (fun ((l, c, _), t) -> (l, c, t)) (List.sort compare !out)
let attachments src forms =
let st = starts_of forms in
List.map
(fun (c : Source_text.comment) ->
let owner =
if c.own_line then
List.find_opt (fun (l, _, _) -> l > c.line) st
else
(* The last place a form starts on the line, and the outermost
form starting there. *)
List.fold_left
(fun acc ((l, col, _) as x) ->
match acc with
| Some (_, col', _) when l = c.line && col = col' -> acc
| _ -> if l = c.line then Some x else acc)
None st
in
(c, Option.map (fun (_, _, t) -> t) owner))
(Source_text.comments src)
let attached_ok ~what path (src, forms) (out, back) =
let want = attachments src forms and got = attachments out back in
let st = starts_of back in
let on_line l = List.filter_map (fun (l', _, t) -> if l' = l then Some t else None) st in
(* Paired by text, in order: the n-th copy of a text with the n-th. *)
let rec pair = function
| [] -> ()
| ((c : Source_text.comment), o) :: rest ->
let t = String.trim c.text in
let same (d : Source_text.comment) = String.trim d.text = t in
let rec take = function
| [] -> None
| ((d, _) as x) :: xs ->
if same d && not (List.memq x !used) then (used := x :: !used; Some x)
else take xs
in
(match take got, o with
| None, _ -> fail "%s %s: the comment %s went missing" what path t
| Some _, None -> ()
| Some ((d : Source_text.comment), g), Some o ->
let holds x = Test_support.contains x o in
(* The code line a moved trailing comment sits under: up past the
comment lines between. *)
let rec code_above l =
if l < 1 then []
else match on_line l with [] -> code_above (l - 1) | fs -> fs
in
let fine =
if c.own_line then
(match g with
(* Above the form, above the statement holding it, or above the
first statement of the block it was: all of those read as
being about it. *)
| Some g -> holds g || (String.length g > 4 && Test_support.contains o g)
| None -> false)
else
List.exists holds (on_line d.line)
|| (d.own_line && List.exists holds (code_above (d.line - 1)))
in
if not fine then
fail "%s %s: the comment %s (line %d) was about %s and is now beside %s"
what path t c.line o (Option.value g ~default:"nothing"));
pair rest
and used = ref [] in
pair want
(* Every .flan the build tree holds. [..] is the workspace root from here;
the deps in test/dune decide what is in it. *)
let corpus () =
@ -136,6 +223,7 @@ let () =
else if comment_texts text <> comment_texts source then
fail "round trip %s: the comments did not all come through" path
else begin
attached_ok ~what:"round trip" path (source, forms) (text, back);
(* And back to parens, from the indented text: the forms and
the comments survive the second printer too. *)
let paren = Paren_printer.program ~source:text back in
@ -147,7 +235,10 @@ let () =
(describe_diff b (List.map norm again))
else if comment_texts paren <> comment_texts source then
fail "back to parens %s: the comments did not all come through" path
else incr ok
else begin
attached_ok ~what:"back to parens" path (text, back) (paren, again);
incr ok
end
end)
(corpus ());
Printf.printf "round trip: %d files\n" !ok;
@ -344,6 +435,12 @@ let () =
in
back "spellings to parens" "fn main() -> i32\n println(0x1F, 1e3, 1_000, 3.0, 2.50, 0b101)\n 0"
"(println 0x1F 1e3 1_000 3.0 2.50 0b101)";
back "each binding keeps its comment"
"fn main() -> i32\n let a = 1 ; first\n let b = 2 ; second\n a + b"
"(let [a 1 ; first\n b 2] ; second";
prints "each binding keeps its comment, indented"
"(defn f [] i32\n (let [a 1 ; first\n b 2] ; second\n (+ a b)))"
" let a = 1 ; first\n let b = 2 ; second";
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)"
@ -378,6 +475,19 @@ let () =
| fs ->
fail "a two-line snippet read as %s"
(String.concat " " (List.map Form.to_string fs)));
(* A snippet's first line is its left edge: a later line left of it is
refused as that, and a snippet sent with leading spaces starts where its
first token does. *)
Source.with_code ~syntax:Source.Indented ~at:(Some (40, 5)) (fun () ->
(match Source.read_code ~file:"<buf>" "f(1)\n g(2)" with
| _ -> fail "a line left of the snippet's first was read"
| exception Loc.Error d ->
if not (Test_support.contains d.Loc.dmsg "left of column 5 where the code sent starts")
then fail "a line left of a snippet: %s" d.Loc.dmsg);
match Source.read_code ~file:"<buf>" " f(1)\n g(2)" with
| [ _; _ ] -> ()
| _ -> fail "a snippet with leading spaces"
| exception e -> fail "a snippet with leading spaces: %s" (diag_text e));
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)