From 562767b2a5e21a2ec67e10796f8081919d8f3e5d Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Wed, 6 Sep 2023 19:08:25 +0100 Subject: [PATCH] WIP: experiment with line directives --- lib/Cmt.ml | 14 +++++++++ lib/Cmt.mli | 2 ++ lib/Cmts.ml | 31 ++++++++++++++----- lib/dune | 1 + test/passing/dune.inc | 3 +- test/passing/tests/line_directives.ml.err | 5 --- test/passing/tests/line_directives.ml.ref | 7 +++++ .../tests/line_directives.ml.should-fail | 0 vendor/parser-extended/lexer.mll | 11 ++++--- vendor/parser-standard/lexer.mll | 11 ++++--- 10 files changed, 60 insertions(+), 25 deletions(-) delete mode 100644 test/passing/tests/line_directives.ml.should-fail diff --git a/lib/Cmt.ml b/lib/Cmt.ml index ad66026736..7f6830a379 100644 --- a/lib/Cmt.ml +++ b/lib/Cmt.ml @@ -26,6 +26,20 @@ module T = struct let is_docstring = function Comment _ -> false | Docstring _ -> true + let is_line_directive = function + | Docstring _ -> None + | Comment {txt; _} -> ( + try + let pattern = "(.*)" in + let regex = Re.Posix.compile_pat pattern in + match Re.exec_opt regex txt with + | Some groups -> + let line_number = Int.of_string (Re.Group.get groups 1) in + let name = Re.Group.get groups 2 in + Some (line_number, name) + | None -> None + with _ -> None ) + let compare = Poly.compare let sexp_of_t cmt = diff --git a/lib/Cmt.mli b/lib/Cmt.mli index 8782f265b0..24f5f9beba 100644 --- a/lib/Cmt.mli +++ b/lib/Cmt.mli @@ -19,6 +19,8 @@ val create_docstring : string -> Location.t -> t val is_docstring : t -> bool +val is_line_directive : t -> (int * string) option + val loc : t -> Location.t val txt : t -> string diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 1c104e2609..51a250063b 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -449,19 +449,23 @@ let find_cmts ?(filter = Fn.const true) t pos loc = picked ) let break_comment_group source margin a b = - let a = Cmt.loc a and b = Cmt.loc b in + let loc_a = Cmt.loc a and loc_b = Cmt.loc b in let vertical_align = - Location.line_difference a b = 1 && Location.compare_start_col a b = 0 + Location.line_difference loc_a loc_b = 1 + && Location.compare_start_col loc_a loc_b = 0 in let horizontal_align = - Location.line_difference a b = 0 + Location.line_difference loc_a loc_b = 0 && List.is_empty - (Source.tokens_between source a.loc_end b.loc_start + (Source.tokens_between source loc_a.loc_end loc_b.loc_start ~filter:(function _ -> true) ) in - not - ( (Location.is_single_line a margin && Location.is_single_line b margin) - && (vertical_align || horizontal_align) ) + Option.is_some (Cmt.is_line_directive a) + || Option.is_some (Cmt.is_line_directive b) + || not + ( ( Location.is_single_line loc_a margin + && Location.is_single_line loc_b margin ) + && (vertical_align || horizontal_align) ) module Asterisk_prefixed = struct let split txt {Location.loc_start; _} = @@ -647,6 +651,13 @@ let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos = | `Unwrapped (x, _) -> Unwrapped.fmt ~opn ~offset x | `Asterisk_prefixed x -> Asterisk_prefixed.fmt ~opn x +let fmt_cmt (conf : Conf.t) cmt ~fmt_code pos = + match Cmt.is_line_directive cmt with + | Some (line, filename) -> + let open Fmt in + str (Format.sprintf "#%i %S" line filename) + | None -> fmt_cmt conf cmt ~fmt_code pos + let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos = let open Fmt in let groups = @@ -684,7 +695,11 @@ let fmt_cmts t conf ~fmt_code ?pro ?epi ?(eol = Fmt.fmt "@\n") ?(adj = eol) let adj_cmt = eol_cmt && Location.line_difference last_loc loc = 1 in fmt_or_k eol_cmt (fmt_or_k adj_cmt adj eol) (fmt_opt epi) in - fmt_opt pro $ fmt_cmts_aux t conf cmts ~fmt_code pos $ epi + ( match List.hd cmts with + | Some cmt when Option.is_some @@ Cmt.is_line_directive cmt -> fmt "\n" + | _ -> fmt_opt pro ) + $ fmt_cmts_aux t conf cmts ~fmt_code pos + $ epi let fmt_before t conf ~fmt_code ?pro ?(epi = Fmt.break 1 0) ?eol ?adj loc = fmt_cmts t conf (find_cmts t `Before loc) ~fmt_code ?pro ~epi ?eol ?adj loc diff --git a/lib/dune b/lib/dune index 547882058e..f1d5b2cec0 100644 --- a/lib/dune +++ b/lib/dune @@ -30,6 +30,7 @@ (backend bisect_ppx)) (libraries format_ + re ocaml_common parser_standard parser_extended diff --git a/test/passing/dune.inc b/test/passing/dune.inc index d0deccd148..e76ba4f154 100644 --- a/test/passing/dune.inc +++ b/test/passing/dune.inc @@ -3488,8 +3488,7 @@ (action (with-stdout-to line_directives.ml.stdout (with-stderr-to line_directives.ml.stderr - (with-accepted-exit-codes 1 - (run %{bin:ocamlformat} --margin-check %{dep:tests/line_directives.ml})))))) + (run %{bin:ocamlformat} --margin-check %{dep:tests/line_directives.ml}))))) (rule (alias runtest) diff --git a/test/passing/tests/line_directives.ml.err b/test/passing/tests/line_directives.ml.err index 47533e6a3f..e69de29bb2 100644 --- a/test/passing/tests/line_directives.ml.err +++ b/test/passing/tests/line_directives.ml.err @@ -1,5 +0,0 @@ -ocamlformat: ignoring "tests/line_directives.ml" (syntax error) -File "tests/line_directives.ml", line 1, characters 1-9: -1 | #3 "f.ml" - ^^^^^^^^ -Error: Invalid lexer directive "#3 \"f.ml\"": line directives are not supported diff --git a/test/passing/tests/line_directives.ml.ref b/test/passing/tests/line_directives.ml.ref index e69de29bb2..ad432eef06 100644 --- a/test/passing/tests/line_directives.ml.ref +++ b/test/passing/tests/line_directives.ml.ref @@ -0,0 +1,7 @@ +#3 "f.ml" + +let x = + +#4 "f.ml" + y +#5 "f.ml" diff --git a/test/passing/tests/line_directives.ml.should-fail b/test/passing/tests/line_directives.ml.should-fail deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll index c6713eca47..7eb4bdf89c 100644 --- a/vendor/parser-extended/lexer.mll +++ b/vendor/parser-extended/lexer.mll @@ -617,13 +617,14 @@ rule token = parse { error lexbuf (Illegal_character illegal_char) } and directive = parse - | ([' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']* - ("\"" ([^ '\010' '\013' '\"' ] * as _name) "\"") as directive) + | ([' ' '\t']* (['0'-'9']+ as line) [' ' '\t']* + ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"")) [^ '\010' '\013'] * { - (* Line directives are not preserved by the lexer so we error out. *) - let explanation = "line directives are not supported" in - error lexbuf (Invalid_directive ("#" ^ directive, Some explanation)) + let loc = Location.curr lexbuf in + let line = int_of_string line in + let s = Format.sprintf "%s" line name in + COMMENT (s, loc) } and comment = parse "(*" diff --git a/vendor/parser-standard/lexer.mll b/vendor/parser-standard/lexer.mll index dcaa9d89d1..af8220b807 100644 --- a/vendor/parser-standard/lexer.mll +++ b/vendor/parser-standard/lexer.mll @@ -616,13 +616,14 @@ rule token = parse { error lexbuf (Illegal_character illegal_char) } and directive = parse - | ([' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']* - ("\"" ([^ '\010' '\013' '\"' ] * as _name) "\"") as directive) + | ([' ' '\t']* (['0'-'9']+ as line) [' ' '\t']* + ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"")) [^ '\010' '\013'] * { - (* Line directives are not preserved by the lexer so we error out. *) - let explanation = "line directives are not supported" in - error lexbuf (Invalid_directive ("#" ^ directive, Some explanation)) + let loc = Location.curr lexbuf in + let line = int_of_string line in + let s = Format.sprintf "%s" line name in + COMMENT (s, loc) } and comment = parse "(*"