Remove unused code from Location and Rescript_cpp modules (rescript-lang#7150)

* Remove unused stuff from Location and Rescript_cpp modules

* Remove unused stuff from Syntaxerr module

* CHANGELOG

Author: cknitt

CHANGELOG.md

@@ -26,7 +26,7 @@
 - AST cleanup: first-class expression and patterns for records with optional fields. https://github.com/rescript-lang/rescript/pull/7192
 - AST cleanup: Represent the arity of uncurried function definitions directly in the AST. https://github.com/rescript-lang/rescript/pull/7197
 - AST cleanup: Remove Pexp_function from the AST. https://github.com/rescript-lang/rescript/pull/7198
-
+- Remove unused code from Location and Rescript_cpp modules. https://github.com/rescript-lang/rescript/pull/7150
 
 # 12.0.0-alpha.5
 

compiler/bsc/rescript_compiler_main.ml

@@ -10,9 +10,11 @@
 (*                                                                     *)
 (***********************************************************************)
 
+let absname = ref false
+
 let set_abs_input_name sourcefile =
   let sourcefile =
-    if !Location.absname && Filename.is_relative sourcefile then
+    if !absname && Filename.is_relative sourcefile then
       Ext_path.absolute_cwd_path sourcefile
     else sourcefile
   in
@@ -394,7 +396,7 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
       string_optional_set Clflags.preprocessor,
       "*internal* <command>  Pipe sources through preprocessor <command>" );
     ( "-absname",
-      set Location.absname,
+      set absname,
       "*internal* Show absolute filenames in error messages" );
     (* Not used, the build system did the expansion *)
     ( "-bs-no-bin-annot",

compiler/jsoo/jsoo_playground_main.ml

@@ -375,7 +375,6 @@ module Compile = struct
   let reset_compiler () =
     warning_infos := [||];
     flush_warning_buffer () |> ignore;
-    Location.reset ();
     Warnings.reset_fatal ();
     Env.reset_cache_toplevel ()
 

compiler/ml/env.ml

@@ -1035,10 +1035,6 @@ let rec lookup_module_descr_aux ?loc lid env =
 and lookup_module_descr ?loc lid env =
   let ((p, comps) as res) = lookup_module_descr_aux ?loc lid env in
   mark_module_used env (Path.last p) comps.loc;
-  (*
-  Format.printf "USE module %s at %a@." (Path.last p)
-    Location.print comps.loc;
-*)
   report_deprecated ?loc p comps.deprecated;
   res
 

compiler/ml/location.ml

@@ -15,10 +15,6 @@
 
 open Lexing
 
-let absname = ref false
-(* This reference should be in Clflags, but it would create an additional
-   dependency and make bootstrapping Camlp4 more difficult. *)
-
 type t = Warnings.loc = {
   loc_start: position;
   loc_end: position;
@@ -31,72 +27,18 @@ let in_file name =
 
 let none = in_file "_none_"
 
-let curr lexbuf =
-  {
-    loc_start = lexbuf.lex_start_p;
-    loc_end = lexbuf.lex_curr_p;
-    loc_ghost = false;
-  }
-
-let init lexbuf fname =
-  lexbuf.lex_curr_p <-
-    {pos_fname = fname; pos_lnum = 1; pos_bol = 0; pos_cnum = 0}
-
-let symbol_rloc () =
-  {
-    loc_start = Parsing.symbol_start_pos ();
-    loc_end = Parsing.symbol_end_pos ();
-    loc_ghost = false;
-  }
-
-let symbol_gloc () =
-  {
-    loc_start = Parsing.symbol_start_pos ();
-    loc_end = Parsing.symbol_end_pos ();
-    loc_ghost = true;
-  }
-
-let rhs_loc n =
-  {
-    loc_start = Parsing.rhs_start_pos n;
-    loc_end = Parsing.rhs_end_pos n;
-    loc_ghost = false;
-  }
-
 let input_name = ref "_none_"
-let input_lexbuf = ref (None : lexbuf option)
 let set_input_name name = if name <> "" then input_name := name
 (* Terminal info *)
 
-let num_loc_lines = ref 0 (* number of lines already printed after input *)
-
 (* Print the location in some way or another *)
 
 open Format
 
-let absolute_path s =
-  (* This function could go into Filename *)
-  let open Filename in
-  let s = if is_relative s then concat (Sys.getcwd ()) s else s in
-  (* Now simplify . and .. components *)
-  let rec aux s =
-    let base = basename s in
-    let dir = dirname s in
-    if dir = s then dir
-    else if base = current_dir_name then aux dir
-    else if base = parent_dir_name then dirname (aux dir)
-    else concat (aux dir) base
-  in
-  aux s
-
-let show_filename file =
-  let file = if file = "_none_" then !input_name else file in
-  if !absname then absolute_path file else file
+let show_filename file = if file = "_none_" then !input_name else file
 
 let print_filename ppf file = Format.fprintf ppf "%s" (show_filename file)
 
-let reset () = num_loc_lines := 0
-
 (* return file, line, char from the given position *)
 let get_pos_info pos = (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
 
@@ -206,21 +148,6 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) =
     | Sys_error _ ->
       ())
 
-let error_prefix = "Error"
-
-let print_error_prefix ppf =
-  setup_colors ();
-  fprintf ppf "@{<error>%s@}" error_prefix
-
-let print_compact ppf loc =
-  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;
-  if startchar >= 0 then fprintf ppf ",%i--%i" startchar endchar
-
-let print_error intro ppf loc =
-  fprintf ppf "%a%t:" (print ~message_kind:`error intro) loc print_error_prefix
-
 let default_warning_printer loc ppf w =
   match Warnings.report w with
   | `Inactive -> ()
@@ -241,10 +168,6 @@ let print_warning loc ppf w = !warning_printer loc ppf w
 let formatter_for_warnings = ref err_formatter
 let prerr_warning loc w = print_warning loc !formatter_for_warnings w
 
-let echo_eof () =
-  print_newline ();
-  incr num_loc_lines
-
 type 'a loc = {txt: 'a; loc: t}
 
 let mkloc txt loc = {txt; loc}

compiler/ml/location.mli

@@ -36,31 +36,13 @@ val none : t
 val in_file : string -> t
 (** Return an empty ghost range located in a given file. *)
 
-val init : Lexing.lexbuf -> string -> unit
-(** Set the file name and line number of the [lexbuf] to be the start
-    of the named file. *)
-
-val curr : Lexing.lexbuf -> t
-(** Get the location of the current token from the [lexbuf]. *)
-
-val symbol_rloc : unit -> t
-val symbol_gloc : unit -> t
-
-val rhs_loc : int -> t
-(** [rhs_loc n] returns the location of the symbol at position [n], starting
-  at 1, in the current parser rule. *)
-
 val input_name : string ref
 val set_input_name : string -> unit
-val input_lexbuf : Lexing.lexbuf option ref
 
 val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
 val print_loc : formatter -> t -> unit
-val print_error : tag -> formatter -> t -> unit
 
 val prerr_warning : t -> Warnings.t -> unit
-val echo_eof : unit -> unit
-val reset : unit -> unit
 
 val warning_printer : (t -> formatter -> Warnings.t -> unit) ref
 (** Hook for intercepting warnings. *)
@@ -75,23 +57,9 @@ type 'a loc = {txt: 'a; loc: t}
 val mknoloc : 'a -> 'a loc
 val mkloc : 'a -> t -> 'a loc
 
-val print :
-  ?src:string option ->
-  message_kind:[< `error | `warning | `warning_as_error > `warning] ->
-  string ->
-  formatter ->
-  t ->
-  unit
-val print_compact : formatter -> t -> unit
 val print_filename : formatter -> string -> unit
 
-val absolute_path : string -> string
-
 val show_filename : string -> string
-(** In -absname mode, return the absolute path for this filename.
-        Otherwise, returns the filename unchanged. *)
-
-val absname : bool ref
 
 (** Support for located errors *)
 
@@ -107,13 +75,6 @@ exception Error of error
 
 val error : ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error
 
-val print_error_prefix : Format.formatter -> unit
-val pp_ksprintf :
-  ?before:(formatter -> unit) ->
-  (string -> 'a) ->
-  ('b, formatter, unit, 'a) format4 ->
-  'b
-
 val errorf :
   ?loc:t ->
   ?sub:error list ->

compiler/ml/rescript_cpp.ml

@@ -22,26 +22,13 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-type pp_error = Unterminated_if | Unterminated_else
-
-exception Pp_error of pp_error * Location.t
-
 type directive_value =
   | Dir_bool of bool
   | Dir_float of float
   | Dir_int of int
   | Dir_string of string
   | Dir_null
 
-let prepare_pp_error loc = function
-  | Unterminated_if -> Location.errorf ~loc "#if not terminated"
-  | Unterminated_else -> Location.errorf ~loc "#else not terminated"
-
-let () =
-  Location.register_error_of_exn (function
-    | Pp_error (err, loc) -> Some (prepare_pp_error loc err)
-    | _ -> None)
-
 let directive_built_in_values = Hashtbl.create 51
 
 let replace_directive_built_in_value k v =
@@ -117,38 +104,3 @@ let define_key_value key v =
            try Dir_float (float_of_string v) with _ -> Dir_string v)));
     true)
   else false
-
-type dir_conditional = Dir_if_true | Dir_out
-
-(* let string_of_dir_conditional (x : dir_conditional) = *)
-(*   match x with  *)
-(*   | Dir_if_true -> "Dir_if_true" *)
-(*   | Dir_if_false -> "Dir_if_false" *)
-(*   | Dir_out -> "Dir_out" *)
-
-let if_then_else = ref Dir_out
-
-(* store the token after hash, [# token]
-   when we see `#if` we do the processing immediately
-   when we see #method, we produce `HASH` token and save `method`
-   token so that the next lexing produce the right one.
-*)
-let sharp_look_ahead = ref None
-
-let update_if_then_else v =
-  (* Format.fprintf Format.err_formatter "@[update %s \n@]@." (string_of_dir_conditional v); *)
-  if_then_else := v
-
-let at_bol lexbuf =
-  let pos = Lexing.lexeme_start_p lexbuf in
-  pos.pos_cnum = pos.pos_bol
-
-let eof_check lexbuf =
-  if !if_then_else <> Dir_out then
-    if !if_then_else = Dir_if_true then
-      raise (Pp_error (Unterminated_if, Location.curr lexbuf))
-    else raise (Pp_error (Unterminated_else, Location.curr lexbuf))
-
-let init () =
-  sharp_look_ahead := None;
-  update_if_then_else Dir_out

compiler/ml/rescript_cpp.mli

@@ -22,12 +22,6 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val at_bol : Lexing.lexbuf -> bool
-
-val eof_check : Lexing.lexbuf -> unit
-
-val init : unit -> unit
-
 (* Methods below are used for cpp, they are not needed by the compiler patches*)
 val remove_directive_built_in_value : string -> unit
 

compiler/ml/syntaxerr.ml

@@ -15,66 +15,6 @@
 
 (* Auxiliary type for reporting syntax errors *)
 
-type error =
-  | Unclosed of Location.t * string * Location.t * string
-  | Expecting of Location.t * string
-  | Not_expecting of Location.t * string
-  | Applicative_path of Location.t
-  | Variable_in_scope of Location.t * string
-  | Other of Location.t
-  | Ill_formed_ast of Location.t * string
-  | Invalid_package_type of Location.t * string
+type error = Variable_in_scope of Location.t * string
 
 exception Error of error
-exception Escape_error
-
-let prepare_error = function
-  | Unclosed (opening_loc, opening, closing_loc, closing) ->
-    Location.errorf ~loc:closing_loc
-      ~sub:
-        [
-          Location.errorf ~loc:opening_loc "This '%s' might be unmatched" opening;
-        ]
-      ~if_highlight:
-        (Printf.sprintf
-           "Syntax error: '%s' expected, the highlighted '%s' might be \
-            unmatched"
-           closing opening)
-      "Syntax error: '%s' expected" closing
-  | Expecting (loc, nonterm) ->
-    Location.errorf ~loc "Syntax error: %s expected." nonterm
-  | Not_expecting (loc, nonterm) ->
-    Location.errorf ~loc "Syntax error: %s not expected." nonterm
-  | Applicative_path loc ->
-    Location.errorf ~loc
-      "Syntax error: applicative paths of the form F(X).t are not supported \
-       when the option -no-app-func is set."
-  | Variable_in_scope (loc, var) ->
-    Location.errorf ~loc
-      "In this scoped type, variable '%s is reserved for the local type %s." var
-      var
-  | Other loc -> Location.errorf ~loc "Syntax error"
-  | Ill_formed_ast (loc, s) ->
-    Location.errorf ~loc "broken invariant in parsetree: %s" s
-  | Invalid_package_type (loc, s) ->
-    Location.errorf ~loc "invalid package type: %s" s
-
-let () =
-  Location.register_error_of_exn (function
-    | Error err -> Some (prepare_error err)
-    | _ -> None)
-
-let report_error ppf err = Location.report_error ppf (prepare_error err)
-
-let location_of_error = function
-  | Unclosed (l, _, _, _)
-  | Applicative_path l
-  | Variable_in_scope (l, _)
-  | Other l
-  | Not_expecting (l, _)
-  | Ill_formed_ast (l, _)
-  | Invalid_package_type (l, _)
-  | Expecting (l, _) ->
-    l
-
-let ill_formed_ast loc s = raise (Error (Ill_formed_ast (loc, s)))