Merge pull request #4574 from BuckleScript/refactor_super_errors

refactor super_location: semantics presevering

Author: bobzhang

jscomp/super_errors/super_location.ml

@@ -1,51 +1,21 @@
-(* open Misc
-open Asttypes
-open Parsetree
-open Types
-open Typedtree
-open Btype
-open Ctype *)
-
-open Format
-(* open Printtyp *)
-
-open Location
-
-let file_lines filePath =
-  (* open_in_bin works on windows, as opposed to open_in, afaik? *)
-  let chan = open_in_bin filePath in
-  let lines = ref [] in
-  try
-    while true do
-      lines := (input_line chan) :: !lines
-     done;
-     (* leave this here to make things type. The loop will definitly raise *)
-     [||]
-  with
-  | End_of_file -> begin
-      close_in chan;
-      List.rev (!lines) |> Array.of_list
-    end
+
+
+let fprintf = Format.fprintf
+
+
+
+let file_lines filePath = 
+  Ext_array.reverse_of_list
+    (Ext_io.rev_lines_of_file filePath)
 
 let setup_colors () =
   Misc.Color.setup !Clflags.color
 
-let print_filename ppf file =
-  match file with
-  (* modified *)
-  | "_none_"
-  | "" -> Format.fprintf ppf "(No file name)"
-  | real_file -> Format.fprintf ppf "%s" (Location.show_filename real_file)
+let print_filename = Location.print_filename
 
-let print_loc ~normalizedRange ppf loc =
+let print_loc ~normalizedRange ppf (loc : Location.t) =
   setup_colors ();
-  let (file, _, _) = Location.get_pos_info loc.loc_start in
-  if file = "//toplevel//" then begin
-    if highlight_locations ppf [loc] then () else
-      fprintf ppf "Characters %i-%i"
-              loc.loc_start.pos_cnum loc.loc_end.pos_cnum
-  end else
-    let dim_loc ppf = function
+  let dim_loc ppf = function
     | None -> ()
     | Some ((start_line, start_line_start_char), (end_line, end_line_end_char)) ->
       if start_line = end_line then
@@ -55,14 +25,11 @@ let print_loc ~normalizedRange ppf loc =
           fprintf ppf " @{<dim>%i:%i-%i@}" start_line start_line_start_char end_line_end_char
       else
         fprintf ppf " @{<dim>%i:%i-%i:%i@}" start_line start_line_start_char end_line end_line_end_char
-    in
-    fprintf ppf "@{<filename>%a@}%a" print_filename file dim_loc normalizedRange
+  in
+  fprintf ppf "@{<filename>%a@}%a" print_filename loc.loc_start.pos_fname dim_loc normalizedRange
 ;;
 
-let print ~message_kind intro ppf loc =
-  if loc.loc_start.pos_fname = "//toplevel//"
-  && highlight_locations ppf [loc] then ()
-  else
+let print ~message_kind intro ppf (loc : Location.t) =
     begin match message_kind with
     | `warning -> fprintf ppf "@[@{<info>%s@}@]@," intro
     | `warning_as_error -> fprintf ppf "@[@{<error>%s@} (configured as error) @]@," intro
@@ -155,17 +122,17 @@ let print_phanton_error_prefix ppf =
     (see super_error_reporter above) *)
   Format.pp_print_as ppf 2 ""
 
-let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt =
+let errorf ?(loc = Location.none) ?(sub = []) ?(if_highlight = "") fmt =
   Location.pp_ksprintf
     ~before:print_phanton_error_prefix
-    (fun msg -> {loc; msg; sub; if_highlight})
+    (fun msg -> Location.{loc; msg; sub; if_highlight})
     fmt
 
 let error_of_printer loc print x =
   errorf ~loc "%a@?" print x
 
 let error_of_printer_file print x =
-  error_of_printer (in_file !input_name) print x
+  error_of_printer (Location.in_file !Location.input_name) print x
 
 (* This will be called in super_main. This is how you override the default error and warning printers *)
 let setup () =

lib/4.06.1/unstable/js_compiler.ml

@@ -411571,6 +411571,98 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
       result
     end
 
+end
+module Ext_io : sig 
+#1 "ext_io.mli"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+val load_file : string -> string
+
+val rev_lines_of_file : string -> string list
+
+val rev_lines_of_chann : in_channel -> string list
+
+val write_file : string -> string -> unit
+
+end = struct
+#1 "ext_io.ml"
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+(** on 32 bit , there are 16M limitation *)
+let load_file f =
+  Ext_pervasives.finally (open_in_bin f) ~clean:close_in begin fun ic ->   
+    let n = in_channel_length ic in
+    let s = Bytes.create n in
+    really_input ic s 0 n;
+    Bytes.unsafe_to_string s
+  end
+
+
+let  rev_lines_of_chann chan = 
+    let rec loop acc chan = 
+      match input_line chan with
+      | line -> loop (line :: acc) chan
+      | exception End_of_file -> close_in chan ; acc in
+    loop [] chan
+
+
+let rev_lines_of_file file = 
+  Ext_pervasives.finally 
+    ~clean:close_in 
+    (open_in_bin file) rev_lines_of_chann
+
+
+let write_file f content = 
+  Ext_pervasives.finally ~clean:close_out 
+    (open_out_bin f)  begin fun oc ->   
+    output_string oc content
+  end
+
 end
 module Super_misc : sig 
 #1 "super_misc.mli"
@@ -411780,54 +411872,24 @@ end
 module Super_location
 = struct
 #1 "super_location.ml"
-(* open Misc
-open Asttypes
-open Parsetree
-open Types
-open Typedtree
-open Btype
-open Ctype *)
 
-open Format
-(* open Printtyp *)
 
-open Location
+let fprintf = Format.fprintf
 
-let file_lines filePath =
-  (* open_in_bin works on windows, as opposed to open_in, afaik? *)
-  let chan = open_in_bin filePath in
-  let lines = ref [] in
-  try
-    while true do
-      lines := (input_line chan) :: !lines
-     done;
-     (* leave this here to make things type. The loop will definitly raise *)
-     [||]
-  with
-  | End_of_file -> begin
-      close_in chan;
-      List.rev (!lines) |> Array.of_list
-    end
+
+
+let file_lines filePath = 
+  Ext_array.reverse_of_list
+    (Ext_io.rev_lines_of_file filePath)
 
 let setup_colors () =
   Misc.Color.setup !Clflags.color
 
-let print_filename ppf file =
-  match file with
-  (* modified *)
-  | "_none_"
-  | "" -> Format.fprintf ppf "(No file name)"
-  | real_file -> Format.fprintf ppf "%s" (Location.show_filename real_file)
+let print_filename = Location.print_filename
 
-let print_loc ~normalizedRange ppf loc =
+let print_loc ~normalizedRange ppf (loc : Location.t) =
   setup_colors ();
-  let (file, _, _) = Location.get_pos_info loc.loc_start in
-  if file = "//toplevel//" then begin
-    if highlight_locations ppf [loc] then () else
-      fprintf ppf "Characters %i-%i"
-              loc.loc_start.pos_cnum loc.loc_end.pos_cnum
-  end else
-    let dim_loc ppf = function
+  let dim_loc ppf = function
     | None -> ()
     | Some ((start_line, start_line_start_char), (end_line, end_line_end_char)) ->
       if start_line = end_line then
@@ -411837,14 +411899,11 @@ let print_loc ~normalizedRange ppf loc =
           fprintf ppf " @{<dim>%i:%i-%i@}" start_line start_line_start_char end_line_end_char
       else
         fprintf ppf " @{<dim>%i:%i-%i:%i@}" start_line start_line_start_char end_line end_line_end_char
-    in
-    fprintf ppf "@{<filename>%a@}%a" print_filename file dim_loc normalizedRange
+  in
+  fprintf ppf "@{<filename>%a@}%a" print_filename loc.loc_start.pos_fname dim_loc normalizedRange
 ;;
 
-let print ~message_kind intro ppf loc =
-  if loc.loc_start.pos_fname = "//toplevel//"
-  && highlight_locations ppf [loc] then ()
-  else
+let print ~message_kind intro ppf (loc : Location.t) =
     begin match message_kind with
     | `warning -> fprintf ppf "@[@{<info>%s@}@]@," intro
     | `warning_as_error -> fprintf ppf "@[@{<error>%s@} (configured as error) @]@," intro
@@ -411937,17 +411996,17 @@ let print_phanton_error_prefix ppf =
     (see super_error_reporter above) *)
   Format.pp_print_as ppf 2 ""
 
-let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt =
+let errorf ?(loc = Location.none) ?(sub = []) ?(if_highlight = "") fmt =
   Location.pp_ksprintf
     ~before:print_phanton_error_prefix
-    (fun msg -> {loc; msg; sub; if_highlight})
+    (fun msg -> Location.{loc; msg; sub; if_highlight})
     fmt
 
 let error_of_printer loc print x =
   errorf ~loc "%a@?" print x
 
 let error_of_printer_file print x =
-  error_of_printer (in_file !input_name) print x
+  error_of_printer (Location.in_file !Location.input_name) print x
 
 (* This will be called in super_main. This is how you override the default error and warning printers *)
 let setup () =