remove the repl printing complexity

Author: bobzhang

parsing/location.ml

@@ -72,153 +72,9 @@ let set_input_name name =
   if name <> "" then input_name := name
 (* Terminal info *)
 
-let status = ref Terminfo.Uninitialised
 
-let num_loc_lines = ref 0 (* number of lines already printed after input *)
 
-let print_updating_num_loc_lines ppf f arg =
-  let open Format in
-  let out_functions = pp_get_formatter_out_functions ppf () in
-  let out_string str start len =
-    let rec count i c =
-      if i = start + len then c
-      else if String.get str i = '\n' then count (succ i) (succ c)
-      else count (succ i) c in
-    num_loc_lines := !num_loc_lines + count start 0 ;
-    out_functions.out_string str start len in
-  pp_set_formatter_out_functions ppf
-    { out_functions with out_string } ;
-  f ppf arg ;
-  pp_print_flush ppf ();
-  pp_set_formatter_out_functions ppf out_functions
-
-(* Highlight the locations using standout mode. *)
-
-let highlight_terminfo ppf num_lines lb locs =
-  Format.pp_print_flush ppf ();  (* avoid mixing Format and normal output *)
-  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
-  let pos0 = -lb.lex_abs_pos in
-  (* Do nothing if the buffer does not contain the whole phrase. *)
-  if pos0 < 0 then raise Exit;
-  (* Count number of lines in phrase *)
-  let lines = ref !num_loc_lines in
-  for i = pos0 to lb.lex_buffer_len - 1 do
-    if Bytes.get lb.lex_buffer i = '\n' then incr lines
-  done;
-  (* If too many lines, give up *)
-  if !lines >= num_lines - 2 then raise Exit;
-  (* Move cursor up that number of lines *)
-  flush stdout; Terminfo.backup !lines;
-  (* Print the input, switching to standout for the location *)
-  let bol = ref false in
-  print_string "# ";
-  for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
-    if !bol then (print_string "  "; bol := false);
-    if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then
-      Terminfo.standout true;
-    if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then
-      Terminfo.standout false;
-    let c = Bytes.get lb.lex_buffer (pos + pos0) in
-    print_char c;
-    bol := (c = '\n')
-  done;
-  (* Make sure standout mode is over *)
-  Terminfo.standout false;
-  (* Position cursor back to original location *)
-  Terminfo.resume !num_loc_lines;
-  flush stdout
-
-(* Highlight the location by printing it again. *)
-
-let highlight_dumb ppf lb loc =
-  (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
-  let pos0 = -lb.lex_abs_pos in
-  (* Do nothing if the buffer does not contain the whole phrase. *)
-  if pos0 < 0 then raise Exit;
-  let end_pos = lb.lex_buffer_len - pos0 - 1 in
-  (* Determine line numbers for the start and end points *)
-  let line_start = ref 0 and line_end = ref 0 in
-  for pos = 0 to end_pos do
-    if Bytes.get lb.lex_buffer (pos + pos0) = '\n' then begin
-      if loc.loc_start.pos_cnum > pos then incr line_start;
-      if loc.loc_end.pos_cnum   > pos then incr line_end;
-    end
-  done;
-  (* Print character location (useful for Emacs) *)
-  Format.fprintf ppf "@[<v>Characters %i-%i:@,"
-                 loc.loc_start.pos_cnum loc.loc_end.pos_cnum;
-  (* Print the input, underlining the location *)
-  Format.pp_print_string ppf "  ";
-  let line = ref 0 in
-  let pos_at_bol = ref 0 in
-  for pos = 0 to end_pos do
-    match Bytes.get lb.lex_buffer (pos + pos0) with
-    | '\n' ->
-      if !line = !line_start && !line = !line_end then begin
-        (* loc is on one line: underline location *)
-        Format.fprintf ppf "@,  ";
-        for _i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
-          Format.pp_print_char ppf ' '
-        done;
-        for _i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
-          Format.pp_print_char ppf '^'
-        done
-      end;
-      if !line >= !line_start && !line <= !line_end then begin
-        Format.fprintf ppf "@,";
-        if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf "  "
-      end;
-      incr line;
-      pos_at_bol := pos + 1
-    | '\r' -> () (* discard *)
-    | c ->
-      if !line = !line_start && !line = !line_end then
-        (* loc is on one line: print whole line *)
-        Format.pp_print_char ppf c
-      else if !line = !line_start then
-        (* first line of multiline loc:
-           print a dot for each char before loc_start *)
-        if pos < loc.loc_start.pos_cnum then
-          Format.pp_print_char ppf '.'
-        else
-          Format.pp_print_char ppf c
-      else if !line = !line_end then
-        (* last line of multiline loc: print a dot for each char
-           after loc_end, even whitespaces *)
-        if pos < loc.loc_end.pos_cnum then
-          Format.pp_print_char ppf c
-        else
-          Format.pp_print_char ppf '.'
-      else if !line > !line_start && !line < !line_end then
-        (* intermediate line of multiline loc: print whole line *)
-        Format.pp_print_char ppf c
-  done;
-  Format.fprintf ppf "@]"
-
-(* Highlight the location using one of the supported modes. *)
-
-let rec highlight_locations ppf locs =
-  match !status with
-    Terminfo.Uninitialised ->
-      status := Terminfo.setup stdout; highlight_locations ppf locs
-  | Terminfo.Bad_term ->
-      begin match !input_lexbuf with
-        None -> false
-      | Some lb ->
-          let norepeat =
-            try Sys.getenv "TERM" = "norepeat" with Not_found -> false in
-          if norepeat then false else
-            let loc1 = List.hd locs in
-            try highlight_dumb ppf lb loc1; true
-            with Exit -> false
-      end
-  | Terminfo.Good_term num_lines ->
-      begin match !input_lexbuf with
-        None -> false
-      | Some lb ->
-          try highlight_terminfo ppf num_lines lb locs; true
-          with Exit -> false
-      end
+let num_loc_lines = ref 0 (* number of lines already printed after input *)
 
 (* Print the location in some way or another *)
 
@@ -262,13 +118,15 @@ let setup_colors () =
 let print_loc ppf loc =
   setup_colors ();
   let (file, line, startchar) = get_pos_info loc.loc_start in
-#if undefined BS_NO_COMPILER_PATCH then 
+#if true then 
   let startchar = 
     if Clflags.bs_vscode then startchar + 1 else startchar in 
 #end      
   let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
   if file = "//toplevel//" then begin
+#if false then    
     if highlight_locations ppf [loc] then () else
+#end    
       fprintf ppf "Characters %i-%i"
               loc.loc_start.pos_cnum loc.loc_end.pos_cnum
   end else begin
@@ -281,9 +139,12 @@ let print_loc ppf loc =
 
 let default_printer ppf loc =
   setup_colors ();
+#if false then
   if loc.loc_start.pos_fname = "//toplevel//"
-  && highlight_locations ppf [loc] then ()
-  else fprintf ppf "@{<loc>%a@}%s@," print_loc loc msg_colon
+  && highlight_locations ppf [loc] then ()  
+  else 
+#end  
+  fprintf ppf "@{<loc>%a@}%s@," print_loc loc msg_colon
 ;;
 
 let printer = ref default_printer
@@ -298,9 +159,12 @@ let print_error_prefix ppf =
 ;;
 
 let print_compact ppf loc =
+#if false then
   if loc.loc_start.pos_fname = "//toplevel//"
   && highlight_locations ppf [loc] then ()
-  else begin
+  else 
+#end  
+  begin
     let (file, line, startchar) = get_pos_info loc.loc_start in
     let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
     fprintf ppf "%a:%i" print_filename file line;
@@ -336,8 +200,8 @@ let default_warning_printer loc ppf w =
 
 let warning_printer = ref default_warning_printer ;;
 
-let print_warning loc ppf w =
-  print_updating_num_loc_lines ppf (!warning_printer loc) w
+let print_warning loc ppf w = 
+  !warning_printer loc ppf w  
 ;;
 
 let formatter_for_warnings = ref err_formatter;;
@@ -413,29 +277,16 @@ let error_of_exn exn =
      in
      loop !error_of_exn
 
-let rec default_error_reporter ppf ({loc; msg; sub; if_highlight} as err) =
-  let highlighted =
-    if if_highlight <> "" && loc.loc_start.pos_fname = "//toplevel//" then
-      let rec collect_locs locs {loc; sub; _} =
-        List.fold_left collect_locs (loc :: locs) sub
-      in
-      let locs = collect_locs [] err in
-      highlight_locations ppf locs
-    else
-      false
-  in
-  if highlighted then
-    Format.pp_print_string ppf if_highlight
-  else begin
+
+let rec default_error_reporter ppf ({loc; msg; sub}) =
     fprintf ppf "@[<v>%a %s" print_error loc msg;
     List.iter (Format.fprintf ppf "@,@[<2>%a@]" default_error_reporter) sub;
     fprintf ppf "@]"
-  end
-
+    
 let error_reporter = ref default_error_reporter
 
 let report_error ppf err =
-  print_updating_num_loc_lines ppf !error_reporter err
+   !error_reporter ppf err
 ;;
 
 let error_of_printer loc print x =

utils/warnings.mli

@@ -50,7 +50,9 @@ type t =
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
   | Duplicate_definitions of string * string * string * string (* 30 *)
+#if undefined BS_ONLY then  
   | Multiple_definition of string * string * string (* 31 *)
+#end  
   | Unused_value_declaration of string      (* 32 *)
   | Unused_open of string                   (* 33 *)
   | Unused_type_declaration of string       (* 34 *)
@@ -70,14 +72,18 @@ type t =
   | Eliminated_optional_arguments of string list (* 48 *)
   | No_cmi_file of string * string option   (* 49 *)
   | Bad_docstring of bool                   (* 50 *)
+#if undefined BS_ONLY then  
   | Expect_tailcall                         (* 51 *)
+#end  
   | Fragile_literal_pattern                 (* 52 *)
   | Misplaced_attribute of string           (* 53 *)
   | Duplicated_attribute of string          (* 54 *)
   | Inlining_impossible of string           (* 55 *)
   | Unreachable_case                        (* 56 *)
   | Ambiguous_pattern of string list        (* 57 *)
+#if undefined BS_ONLY then  
   | No_cmx_file of string                   (* 58 *)
+#end  
   | Assignment_to_non_mutable_value         (* 59 *)
   | Unused_module of string                 (* 60 *)
   | Unboxable_type_in_prim_decl of string   (* 61 *)
@@ -127,7 +133,8 @@ val mk_lazy: (unit -> 'a) -> 'a Lazy.t
     (** Like [Lazy.of_fun], but the function is applied with
         the warning settings at the time [mk_lazy] is called. *)
 
-#if undefined BS_NO_COMPILER_PATCH then
+#if true then
+val nerrors : int ref
 val message : t -> string 
 val number: t -> int
 val super_report :