Merge branch 'master' into src-dune-short-rule

CHANGES.md

@@ -1,6 +1,7 @@
 ### (master)
 
   + Build: use short form for action in src/dune (#1076) (Etienne Millon)
+  + Internal: Cleanup sequence_blank_line (#1075) (Jules Aguillon)
   + Improve: set conventional as the default profile (#1060) (Guillaume Petiot)
   + Fix precedence of Dot wrt Hash (#1058) (Guillaume Petiot)
   + Fix break in variant type definition to not exceed the margin (#1064) (Guillaume Petiot)

src/Ast.ml

@@ -414,7 +414,7 @@ module Structure_item : Module_item with type t = structure_item = struct
     ||
     match Conf.(c1.module_item_spacing, c2.module_item_spacing) with
     | `Preserve, `Preserve ->
-        Source.empty_line_between s i1.pstr_loc i2.pstr_loc
+        Source.empty_line_between s i1.pstr_loc.loc_end i2.pstr_loc.loc_start
     | _ ->
         (not (is_simple (i1, c1)))
         || (not (is_simple (i2, c2)))
@@ -498,7 +498,7 @@ module Signature_item : Module_item with type t = signature_item = struct
     ||
     match Conf.(c1.module_item_spacing, c2.module_item_spacing) with
     | `Preserve, `Preserve ->
-        Source.empty_line_between s i1.psig_loc i2.psig_loc
+        Source.empty_line_between s i1.psig_loc.loc_end i2.psig_loc.loc_start
     | _ ->
         (not (is_simple (i1, c1)))
         || (not (is_simple (i2, c2)))

src/Cmts.ml

@@ -241,8 +241,8 @@ end
     [|] character and the first location begins a line and the start column
     of the first location is not greater than that of the second location. *)
 let is_adjacent t (l1 : Location.t) (l2 : Location.t) =
-  Option.value_map (Source.string_between t.source l1 l2) ~default:false
-    ~f:(fun btw ->
+  Option.value_map (Source.string_between t.source l1.loc_end l2.loc_start)
+    ~default:false ~f:(fun btw ->
       match String.strip btw with
       | "" -> true
       | "|" ->
@@ -259,8 +259,7 @@ let infix_symbol_before t (loc : Location.t) =
   match Source.position_before t.source loc_end with
   | Some loc_start ->
       if loc_start.pos_cnum < loc.loc_end.pos_cnum then
-        let op_loc = {loc with loc_start} in
-        let str = Source.string_at t.source op_loc in
+        let str = Source.string_at t.source loc_start loc.loc_end in
         String.equal str ";" || Ast.is_infix_id str
       else false
   | None -> false
@@ -305,7 +304,7 @@ let add_cmts t ?prev ?next tbl loc cmts =
     if Conf.debug then
       List.iter cmtl ~f:(fun {Cmt.txt= cmt_txt; loc= cmt_loc} ->
           let string_between (l1 : Location.t) (l2 : Location.t) =
-            match Source.string_between t.source l1 l2 with
+            match Source.string_between t.source l1.loc_end l2.loc_start with
             | None -> "swapped"
             | Some s -> s
           in

src/Fmt_ast.ml

@@ -136,7 +136,7 @@ let maybe_disabled_k c (loc : Location.t) (l : attributes) f k =
   else
     let loc = Source.extend_loc_to_include_attributes c.source loc l in
     Cmts.drop_inside c.cmts loc ;
-    let s = Source.string_at c.source loc in
+    let s = Source.string_at c.source loc.loc_start loc.loc_end in
     let indent_of_first_line = Position.column loc.loc_start in
     let l = String.split ~on:'\n' s in
     let l =
@@ -476,25 +476,19 @@ let fmt_assign_arrow c =
 let fmt_docstring_padded c doc =
   fmt_docstring c ~pro:(break c.conf.doc_comments_padding 0) doc
 
-let sequence_blank_line c xe1 xe2 =
+let sequence_blank_line c (l1 : Location.t) (l2 : Location.t) =
   match c.conf.sequence_blank_line with
   | `Preserve_one ->
-      let open Location in
-      (* Count empty lines between [xe1] and [xe2], some may be comments *)
-      let l1 = xe1.ast.pexp_loc and l2 = xe2.ast.pexp_loc in
-      let a = l1.loc_end.pos_lnum and b = l2.loc_start.pos_lnum in
-      let commented_lines =
-        (* Number of lines in [l] that are between [a] and [b], exclusive. *)
-        let height_constrained l =
-          max 0
-            ( min (b - 1) l.loc_end.pos_lnum
-            - max (a + 1) l.loc_start.pos_lnum
-            + 1 )
-        in
-        List.fold ~init:0 (Cmts.remaining_before c.cmts l2)
-          ~f:(fun acc cmt -> acc + height_constrained cmt.Cmt.loc)
+      let rec loop prev_pos = function
+        | cmt :: tl ->
+            (* Check empty line before each comment *)
+            Source.empty_line_between c.source prev_pos cmt.Cmt.loc.loc_start
+            || loop cmt.Cmt.loc.loc_end tl
+        | [] ->
+            (* Check empty line after all comments *)
+            Source.empty_line_between c.source prev_pos l2.loc_start
       in
-      b - a - commented_lines > 1
+      loop l1.loc_end (Cmts.remaining_before c.cmts l2)
   | `Compact -> false
 
 let rec fmt_extension c ctx key (ext, pld) =
@@ -1259,7 +1253,8 @@ and fmt_args ~first:first_grp ~last:last_grp c ctx args =
 and fmt_sequence c ?ext parens width xexp pexp_loc fmt_atrs =
   let fmt_sep c ?(force_break = false) xe1 ext xe2 =
     let break =
-      if sequence_blank_line c xe1 xe2 then fmt "\n@;<1000 0>"
+      let l1 = xe1.ast.pexp_loc and l2 = xe2.ast.pexp_loc in
+      if sequence_blank_line c l1 l2 then fmt "\n@;<1000 0>"
       else if c.conf.break_sequences || force_break then fmt "@;<1000 0>"
       else if parens && Poly.(c.conf.sequence_style = `Before) then
         fmt "@;<1 -2>"

src/Params.ml

@@ -17,7 +17,10 @@ let parens_or_begin_end (c : Conf.t) source ~loc =
   match c.exp_grouping with
   | `Parens -> `Parens
   | `Preserve ->
-      let str = String.lstrip (Source.string_at source loc) in
+      let str =
+        String.lstrip
+          (Source.string_at source loc.Location.loc_start loc.loc_end)
+      in
       if String.is_prefix ~prefix:"begin" str then `Begin_end else `Parens
 
 let wrap_exp (c : Conf.t) ?(disambiguate = false) ?(fits_breaks = true)

src/Source.ml

@@ -28,9 +28,9 @@ let position_before t (pos : Lexing.position) =
   let pos_cnum_opt = String.rfindi t ~pos:pos.pos_cnum ~f in
   Option.map pos_cnum_opt ~f:(fun x -> {pos with pos_cnum= x + 1})
 
-let string_between t (l1 : Location.t) (l2 : Location.t) =
-  let pos = l1.loc_end.pos_cnum in
-  let len = Position.distance l1.loc_end l2.loc_start in
+let string_between t (p1 : Lexing.position) (p2 : Lexing.position) =
+  let pos = p1.pos_cnum in
+  let len = Position.distance p1 p2 in
   if
     len < 0 || pos < 0
     (* can happen e.g. if comment is within a parenthesized expression *)
@@ -41,72 +41,91 @@ let string_between t (l1 : Location.t) (l2 : Location.t) =
   then None
   else Some (String.sub t ~pos ~len)
 
-let empty_line_between t l1 l2 =
-  let non_whitespace _ c = not (Char.is_whitespace c) in
-  let is_empty s = String.lfindi s ~f:non_whitespace |> Option.is_none in
-  Location.(l2.loc_end.pos_lnum - l1.loc_start.pos_lnum) > 1
-  && Option.for_all (string_between t l1 l2) ~f:is_empty
+(** Lines between [p1] and [p2]. Lines are represented their (offset, length)
+    in the source. The first and last line (containing [p1] and [p2]) are
+    ignored. *)
+let lines_between t (p1 : Lexing.position) (p2 : Lexing.position) =
+  let rec loop acc off lnum =
+    if lnum >= p2.pos_lnum then acc (* ignore last line *)
+    else
+      match String.index_from t off '\n' with
+      | None -> acc (* ignore last line *)
+      | Some endl -> loop ((off, endl - off) :: acc) (endl + 1) (lnum + 1)
+  in
+  (* ignore first line *)
+  match String.index_from t p1.pos_cnum '\n' with
+  | None -> []
+  | Some endl -> loop [] (endl + 1) (p1.pos_lnum + 1)
+
+(** Returns the index of the first char that [f] match. Only consider [len]
+    characters starting at [pos]. *)
+let string_lcontains ~pos ~len s ~f =
+  let end_ = pos + len in
+  let rec loop i =
+    if i >= end_ then None else if f s.[i] then Some i else loop (i + 1)
+  in
+  loop pos
 
-let string_at t (l : Location.t) =
-  let pos = l.loc_start.pos_cnum in
-  let len = Location.width l in
+let empty_line_between t p1 p2 =
+  let non_whitespace c = not (Char.is_whitespace c) in
+  let is_line_empty (off, len) =
+    Option.is_none (string_lcontains ~pos:off ~len t ~f:non_whitespace)
+  in
+  Lexing.(p2.pos_lnum - p1.pos_lnum) > 1
+  && List.exists (lines_between t p1 p2) ~f:is_line_empty
+
+let string_at t loc_start loc_end =
+  let pos = loc_start.Lexing.pos_cnum
+  and len = Position.distance loc_start loc_end in
   if String.length t < pos + len || pos < 0 || len < 0 then ""
   else String.sub t ~pos ~len
 
 let has_cmt_same_line_after t (loc : Location.t) =
   let loc_start = {loc.loc_end with pos_cnum= loc.loc_end.pos_cnum} in
   let loc_end = {loc.loc_end with pos_cnum= loc_start.pos_cnum + 20} in
-  let loc = {loc with loc_start; loc_end} in
-  let str = string_at t loc in
+  let str = string_at t loc_start loc_end in
   if String.is_empty str then false
   else if Char.equal str.[0] '\n' then false
   else
     let str = String.lstrip str in
     String.is_prefix str ~prefix:"(*"
 
-let merge (l1 : Location.t) ~(sub : Location.t) =
-  let base = l1.loc_start.pos_cnum in
-  { l1 with
-    loc_start= {l1.loc_start with pos_cnum= base + sub.loc_start.pos_cnum}
-  ; loc_end= {l1.loc_end with pos_cnum= base + sub.loc_end.pos_cnum} }
-
-let lexbuf_from_loc t (l : Location.t) =
-  let s = string_at t l in
-  Lexing.from_string s
+let lexbuf_set_pos lexbuf pos =
+  lexbuf.Lexing.lex_abs_pos <- pos.Lexing.pos_cnum ;
+  lexbuf.lex_curr_p <- pos
 
-let tokens_at t ?(filter = fun _ -> true) (l : Location.t) :
-    (Parser.token * Location.t) list =
-  let lexbuf = lexbuf_from_loc t l in
+let tokens_between t ?(filter = fun _ -> true) loc_start loc_end =
+  let s = string_at t loc_start loc_end in
+  let lexbuf = Lexing.from_string s in
+  lexbuf_set_pos lexbuf loc_start ;
   let rec loop acc =
     match Lexer.token lexbuf with
     | Parser.EOF -> List.rev acc
     | tok ->
-        if filter tok then
-          let sub = Location.curr lexbuf in
-          loop ((tok, merge l ~sub) :: acc)
+        if filter tok then loop ((tok, Location.curr lexbuf) :: acc)
         else loop acc
   in
   loop []
 
+let tokens_at t ?filter (l : Location.t) =
+  tokens_between t ?filter l.loc_start l.loc_end
+
 let find_after t f (loc : Location.t) =
-  let loc = {loc with loc_start= loc.loc_end} in
-  let pos = ref loc.loc_end.pos_cnum in
+  let pos_start = loc.loc_end in
   let lexbuf =
+    let pos = ref pos_start.pos_cnum in
     Lexing.from_function (fun bytes available ->
         let to_write = min (String.length t - !pos) available in
         Bytes.From_string.blit ~src:t ~src_pos:!pos ~dst:bytes ~dst_pos:0
           ~len:to_write ;
         pos := !pos + to_write ;
         to_write)
   in
+  lexbuf_set_pos lexbuf pos_start ;
   let rec loop () =
     match Lexer.token lexbuf with
     | Parser.EOF -> None
-    | tok ->
-        if f tok then
-          let sub = Location.curr lexbuf in
-          Some (merge loc ~sub)
-        else loop ()
+    | tok -> if f tok then Some (Location.curr lexbuf) else loop ()
   in
   loop ()
 
@@ -173,17 +192,11 @@ let extend_loc_to_include_attributes t (loc : Location.t)
       | None -> impossible "Invariant of the token stream"
       | Some e -> {loc with loc_end= e.loc_end}
 
-let loc_between ~(from : Location.t) ~(upto : Location.t) : Location.t =
-  {from with loc_start= from.loc_start; loc_end= upto.loc_start}
-
-let tokens_between t ?(filter = fun _ -> true) ~(from : Location.t)
-    ~(upto : Location.t) : (Parser.token * Location.t) list =
-  tokens_at t ~filter (loc_between ~from ~upto)
-
 let contains_token_between t ~(from : Location.t) ~(upto : Location.t) tok =
   let filter = Poly.( = ) tok in
-  Source_code_position.ascending from.loc_start upto.loc_start < 0
-  && not (List.is_empty (tokens_between t ~from ~upto ~filter))
+  let from = from.loc_start and upto = upto.loc_start in
+  Source_code_position.ascending from upto < 0
+  && not (List.is_empty (tokens_between t ~filter from upto))
 
 let is_long_pexp_open source {Parsetree.pexp_desc; _} =
   match pexp_desc with
@@ -197,6 +210,10 @@ let is_long_pmod_functor source Parsetree.{pmod_desc; pmod_loc= from; _} =
       contains_token_between source ~from ~upto Parser.FUNCTOR
   | _ -> false
 
+let lexbuf_from_loc t (l : Location.t) =
+  let s = string_at t l.loc_start l.loc_end in
+  Lexing.from_string s
+
 let string_literal t mode (l : Location.t) =
   (* the location of a [string] might include surrounding comments and
      attributes because of [reloc_{exp,pat}] and a [string] can be found in

src/Source.mli

@@ -15,13 +15,16 @@ type t
 
 val create : string -> t
 
-val empty_line_between : t -> Location.t -> Location.t -> bool
+val empty_line_between : t -> Lexing.position -> Lexing.position -> bool
+(** [empty_line_between t p1 p2] is [true] if there is an empty line between
+    [p1] and [p2]. The lines containing [p1] and [p2] are not considered
+    empty. *)
 
-val string_between : t -> Location.t -> Location.t -> string option
+val string_between : t -> Lexing.position -> Lexing.position -> string option
 
 val has_cmt_same_line_after : t -> Location.t -> bool
 
-val string_at : t -> Location.t -> string
+val string_at : t -> Lexing.position -> Lexing.position -> string
 
 val string_literal :
   t -> [`Normalize | `Preserve] -> Location.t -> string option
@@ -38,18 +41,14 @@ val position_before : t -> Lexing.position -> Lexing.position option
 (** [position_before s pos] returns the starting position of the token
     preceding the position [pos]. *)
 
-val loc_between : from:Location.t -> upto:Location.t -> Location.t
-(** [loc_between ~from ~upto] returns a location starting from [from] and
-    ending before [upto]. *)
-
 val tokens_between :
      t
   -> ?filter:(Parser.token -> bool)
-  -> from:Location.t
-  -> upto:Location.t
+  -> Lexing.position
+  -> Lexing.position
   -> (Parser.token * Location.t) list
-(** [tokens_between s ~filter ~from ~upto] returns the list of tokens
-    starting from [from] and ending before [upto] and respecting the [filter]
+(** [tokens_between s ~filter from upto] returns the list of tokens starting
+    from [from] and ending before [upto] and respecting the [filter]
     property. [from] must start before [upto]. *)
 
 val is_long_pexp_open : t -> Parsetree.expression -> bool

test/passing/module_item_spacing-preserve.ml.ref

@@ -1,7 +1,6 @@
 let z = this one is pretty looooooooooooooooooooooooooooooooooong
 
 and z = so is this oooooooooooooooooooooooooooooooooooooooooooone
-
 let f x = x + 1
 let z = this one is pretty looooooooooooooooooooooooooooooooooong
 let z = so is this oooooooooooooooooooooooooooooooooooooooooooone
@@ -18,7 +17,6 @@ let f = function
 let x = 1
 
 and y = 2
-
 let z = this one is pretty looooooooooooooooooooooooooooooooooong
 let z = so is this oooooooooooooooooooooooooooooooooooooooooooone
 
@@ -36,7 +34,6 @@ module M =
 
 let x = 1
 let y = 2
-
 let x = 1
 
 and y = 2
@@ -50,15 +47,11 @@ and z = so is this oooooooooooooooooooooooooooooooooooooooooooone
 type k = A | B | K of int * char * string | E
 
 let x = 1
-
 let z = this one (is short)
-
 let y = 2
-
 let w =
   this one is toooooooooooooooooooooooooo
     (looooooooooooooooooooooooog but is (originally a one - liner))
-
 let k = z
 
 module N = struct
@@ -133,4 +126,5 @@ let cr0_em = 1 lsl 2
 (* with double semicolons *)
 
 let foo = fooooooooooooooooooooooooooooo
+
 let foo = fooooooooooooooooooooooooooooo

test/passing/sequence-preserve.ml.opts

@@ -1 +1 @@
---sequence-blank-line=preserve-one
+--sequence-blank-line=preserve-one --max-iter=3