Accept a UTF-8 byte order mark and end a line at a lone CR

analysis/src/commands.ml

@@ -302,6 +302,8 @@ let format ~source ~kind_file =
 
   (* Keep a CRLF document's line endings, rather than return mixed ones *)
   let newline = Res_line_endings.newline source in
+  (* Keep a byte order mark, which the scanner skips *)
+  let byte_order_mark = Res_scanner.byte_order_mark source in
 
   let result =
     match kind_file with
@@ -313,7 +315,8 @@ let format ~source ~kind_file =
       | true -> Error "Document has syntax errors"
       | false ->
         Ok
-          (Res_printer.print_implementation ~newline ~comments structure
+          (byte_order_mark
+           ^ Res_printer.print_implementation ~newline ~comments structure
           |> create_range))
     | Resi -> (
       let {Res_driver.parsetree = signature; comments; diagnostics} =
@@ -323,7 +326,8 @@ let format ~source ~kind_file =
       | true -> Error "Document has syntax errors"
       | false ->
         Ok
-          (Res_printer.print_interface ~newline ~comments signature
+          (byte_order_mark
+           ^ Res_printer.print_interface ~newline ~comments signature
           |> create_range))
     | Other -> Error "Failed to format, file not supported"
   in

changes/byte-order-mark-lone-cr.fix.md

@@ -0,0 +1 @@
+- Accept source files that start with a UTF-8 byte order mark, keeping it when formatting, and end a line at a carriage return without a line feed.

compiler/ml/code_frame.ml

@@ -13,7 +13,21 @@ let seek_2_lines_before src (pos : Lexing.position) =
         (if src.[current_char] = '\n' then current_line + 1 else current_line)
         (current_char + 1)
   in
-  loop 1 0
+  (* Like the scanner, start the first line after a UTF-8 byte order mark *)
+  loop 1 (if String.starts_with ~prefix:"\xEF\xBB\xBF" src then 3 else 0)
+
+(* Like the scanner, end a line at a CR not followed by LF too. Each such CR
+   becomes an LF, so the byte offsets of positions stay valid. *)
+let lone_crs_to_lf src =
+  if not (String.contains src '\r') then src
+  else
+    let length = String.length src in
+    String.mapi
+      (fun index character ->
+        if character = '\r' && (index + 1 = length || src.[index + 1] <> '\n')
+        then '\n'
+        else character)
+      src
 
 let seek_2_lines_after src (pos : Lexing.position) =
   let original_line = pos.pos_lnum in
@@ -122,6 +136,7 @@ type line = {gutter: gutter; content: highlighted_string list}
 *)
 let print ~is_warning ~src ~(start_pos : Lexing.position)
     ~(end_pos : Lexing.position) =
+  let src = lone_crs_to_lf src in
   let indent = 2 in
   let highlight_line_start_line = start_pos.pos_lnum in
   let highlight_line_end_line = end_pos.pos_lnum in

compiler/syntax/src/res_multi_printer.ml

@@ -28,8 +28,10 @@ let print ?(ignore_parse_errors = false) input =
     let len = String.length input in
     len > 0 && String.unsafe_get input (len - 1) = 'i'
   in
-  print_res ~ignore_parse_errors ~is_interface ~filename:input
-    (Ext_io.load_file input)
+  let source = Ext_io.load_file input in
+  (* Keep a byte order mark, which the scanner skips *)
+  Res_scanner.byte_order_mark source
+  ^ print_res ~ignore_parse_errors ~is_interface ~filename:input source
 [@@raises Res_driver.Already_reported]
 
 (* suppress unused optional arg *)

compiler/syntax/src/res_scanner.ml

@@ -85,11 +85,15 @@ let next scanner =
       then 2
       else 1
   in
+  (* A line ends at LF, or at a CR not followed by LF. CRLF ends a line once,
+     at its LF. *)
   let newline =
-    scanner.ch = '\n'
-    (* What about CRLF (\r + \n) on windows?
-       \r\n will always be terminated by a \n
-       -> we can just bump the line count on \n *)
+    match scanner.ch with
+    | '\n' -> true
+    | '\r' ->
+      next_offset >= String.length scanner.src
+      || String.unsafe_get scanner.src next_offset <> '\n'
+    | _ -> false
   in
   if newline then (
     scanner.line_offset <- next_offset;
@@ -141,15 +145,24 @@ let peek_char scanner target_char =
 
 let peek_slash scanner = peek_char scanner '/'
 
+let byte_order_mark src =
+  let bom = "\xEF\xBB\xBF" in
+  if String.starts_with ~prefix:bom src then bom else ""
+
 let make ~filename src =
+  (* Skip a byte order mark: it is not part of the program, and the first line
+     starts after it, as in an editor *)
+  let offset = String.length (byte_order_mark src) in
   {
     filename;
     src;
     err = (fun ~start_pos:_ ~end_pos:_ _ -> ());
-    ch = (if src = "" then hacky_eof_char else String.unsafe_get src 0);
-    offset = 0;
+    ch =
+      (if offset >= String.length src then hacky_eof_char
+       else String.unsafe_get src offset);
+    offset;
     offset16 = 0;
-    line_offset = 0;
+    line_offset = offset;
     lnum = 1;
   }
 
@@ -619,7 +632,7 @@ let scan_regex ~start_pos:opening_pos ~prefix_length scanner =
         scan_flags ()
       in
       (pattern, flags)
-    | ch when ch == '\n' || ch == hacky_eof_char ->
+    | ch when ch == '\n' || ch == '\r' || ch == hacky_eof_char ->
       let end_pos = position scanner in
       scanner.err ~start_pos ~end_pos (Diagnostics.message "unterminated regex");
       let pattern =

compiler/syntax/src/res_scanner.mli

@@ -16,6 +16,10 @@ type t = {
   mutable lnum: int; (* current line number *)
 }
 
+(* The UTF-8 byte order mark that [src] starts with, or "". The scanner skips
+   it, and the formatter keeps it. *)
+val byte_order_mark : string -> string
+
 val make : filename:string -> string -> t
 val position : t -> Lexing.position
 

tests/syntax_tests/res_test.ml

@@ -69,13 +69,76 @@ let () =
       "let x = 1\n/* a\r\r\nb\nc */\nlet y = 2\n";
       "let x = 1\r\n/* a\nb\r\nc */\r\nlet y = 2\r\n";
     ];
+  (* Formatting keeps a byte order mark, and a lone CR ends a line *)
+  let bom = "\xEF\xBB\xBF" in
+  List.iter
+    (fun source ->
+      let formatted = format source in
+      assert (formatted = source);
+      assert (format formatted = formatted))
+    [bom ^ "let x = 1\n"; bom ^ "// c\r\nlet x = 1\r\n"];
+  assert (format "let x = 1 // c\rlet y = 2\n" = "let x = 1 // c\nlet y = 2\n");
+  assert (format "let x = 1\rlet y = 2\r" = "let x = 1\nlet y = 2\n");
   (* The printer writes the line breaks of a comment it reindents *)
   let formatted = format "let x = 1\n/* a\r\r\n b */\nlet y = 2\n" in
   assert (formatted = "let x = 1\n/* a\n b */\nlet y = 2\n");
   assert (format (to_crlf formatted) = to_crlf formatted)
 
 let () = print_endline "✅ multi printer api tests"
 
+(* The scanner skips a UTF-8 byte order mark and ends a line at a CR without an
+   LF, and code frames show the lines the positions refer to *)
+let () =
+  let parse source =
+    let result =
+      Res_driver.parse_implementation_from_source ~display_filename:"bom.res"
+        ~source
+    in
+    assert (not result.invalid);
+    result.parsetree
+  in
+  let position_of_y source =
+    match parse source with
+    | _ :: {Parsetree.pstr_loc = {loc_start}} :: _ -> loc_start
+    | _ -> assert false
+  in
+  let line_and_column (pos : Lexing.position) =
+    (pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
+  in
+  let bom = "\xEF\xBB\xBF" in
+  (match parse (bom ^ "let x = 1") with
+  | [{pstr_loc = {loc_start}}] -> assert (line_and_column loc_start = (1, 0))
+  | _ -> assert false);
+  List.iter
+    (fun (source, expected) ->
+      assert (line_and_column (position_of_y source) = expected))
+    [
+      ("let x = 1\rlet y = 2", (2, 0));
+      ("let x = 1 // c\rlet y = 2", (2, 0));
+      ("let x = 1 /* c */\r  let y = 2", (2, 2));
+      ("let x = 1\r\nlet y = 2", (2, 0));
+      ("let x = 1\r\rlet y = 2", (3, 0));
+      ("let x = 1\n\rlet y = 2", (3, 0));
+      (bom ^ "let x = 1; let y = 2", (1, 11));
+      (bom ^ "let x = 1\rlet y = 2", (2, 0));
+    ];
+  (* A regex literal ends at a line break *)
+  assert
+    (Res_driver.parse_implementation_from_source ~display_filename:"regex.res"
+       ~source:"let r = /a\rb/")
+      .invalid;
+  Code_frame.setup (Some Misc.Color.Never);
+  let frame source =
+    let start_pos = position_of_y source in
+    Code_frame.print ~is_warning:false ~src:source ~start_pos
+      ~end_pos:{start_pos with pos_cnum = start_pos.pos_cnum + 3}
+  in
+  assert (frame (bom ^ "let x = 1; let y = 2") = "  1 │ let x = 1; let y = 2\n");
+  assert (
+    frame "let x = 1\rlet y = 2\rlet z = 3"
+    = "  1 │ let x = 1\n  2 │ let y = 2\n  3 │ let z = 3\n");
+  print_endline "✅ byte order mark and lone CR"
+
 let () =
   let filename =
     Filename.concat data_dir "printer/comments/callbackTrailing.res"