diff --git a/CHANGELOG.md b/CHANGELOG.md index 50295029c4..cf206f1101 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index caa2312b1d..83b08fa796 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/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* Pipe sources through preprocessor " ); ( "-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", diff --git a/compiler/jsoo/jsoo_playground_main.ml b/compiler/jsoo/jsoo_playground_main.ml index dd7ffd1f00..96f4f0150c 100644 --- a/compiler/jsoo/jsoo_playground_main.ml +++ b/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 () diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index 30bfed3736..474f45d805 100644 --- a/compiler/ml/env.ml +++ b/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 diff --git a/compiler/ml/location.ml b/compiler/ml/location.ml index bbf80e8eee..87592822e8 100644 --- a/compiler/ml/location.ml +++ b/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 "@{%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} diff --git a/compiler/ml/location.mli b/compiler/ml/location.mli index db4aa270da..0df157efcc 100644 --- a/compiler/ml/location.mli +++ b/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 -> diff --git a/compiler/ml/rescript_cpp.ml b/compiler/ml/rescript_cpp.ml index 98f2ac7576..8b91023dcc 100644 --- a/compiler/ml/rescript_cpp.ml +++ b/compiler/ml/rescript_cpp.ml @@ -22,10 +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. *) -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 @@ -33,15 +29,6 @@ type directive_value = | 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 diff --git a/compiler/ml/rescript_cpp.mli b/compiler/ml/rescript_cpp.mli index 7881cc878a..d0b1652d94 100644 --- a/compiler/ml/rescript_cpp.mli +++ b/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 diff --git a/compiler/ml/syntaxerr.ml b/compiler/ml/syntaxerr.ml index 6bc31b6eaa..11a12f4edd 100644 --- a/compiler/ml/syntaxerr.ml +++ b/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))) diff --git a/compiler/ml/syntaxerr.mli b/compiler/ml/syntaxerr.mli index b737acaaf3..8d4606d8f5 100644 --- a/compiler/ml/syntaxerr.mli +++ b/compiler/ml/syntaxerr.mli @@ -15,23 +15,6 @@ (** Auxiliary type for reporting syntax errors *) -open Format - -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 - -val report_error : formatter -> error -> unit -(** @deprecated Use {!Location.error_of_exn}, {!Location.report_error}. *) - -val location_of_error : error -> Location.t -val ill_formed_ast : Location.t -> string -> 'a