From 30373ffda51943609284eb0df0c5004e62835a2d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 16:17:12 +0700 Subject: [PATCH] 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 --- emacs/flan.el | 7 +-- lib/indent_printer.ml | 51 +++++++++++++------ lib/indent_reader.ml | 32 ++++++++++-- lib/paren_printer.ml | 39 +++++++++++++-- lib/source_text.ml | 99 +++++++++++++++++++++++++------------ test/test_syntax.ml | 112 +++++++++++++++++++++++++++++++++++++++++- 6 files changed, 279 insertions(+), 61 deletions(-) diff --git a/emacs/flan.el b/emacs/flan.el index 5b6f4929..614e91b2 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -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))) diff --git a/lib/indent_printer.ml b/lib/indent_printer.ml index 20023884..eb3bfd38 100644 --- a/lib/indent_printer.ml +++ b/lib/indent_printer.ml @@ -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 diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 071a94ec..a5ea3a81 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -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 diff --git a/lib/paren_printer.ml b/lib/paren_printer.ml index 07e3abd3..ed72d06e 100644 --- a/lib/paren_printer.ml +++ b/lib/paren_printer.ml @@ -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 diff --git a/lib/source_text.ml b/lib/source_text.ml index 12b8e508..e876f58f 100644 --- a/lib/source_text.ml +++ b/lib/source_text.ml @@ -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 diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 72f35369..d8dc6426 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -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:"" "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:"" " 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:"" "(f 1)" with | [ f ] -> span_is "a paren snippet" f (7, 3, 7, 8)