conservative update input name

Author: bobzhang

driver/compile.ml

@@ -100,5 +100,5 @@ let implementation ppf sourcefile outputprefix =
  raise x
 
 let c_file name =
- Location.input_name := name;
+ Location.set_input_name  name;
  if Ccomp.compile_file name <> 0 then exit 2

driver/pparse.ml

@@ -84,7 +84,7 @@ let read_ast magic fn =
  try
  let buffer = really_input_string ic (String.length magic) in
  assert(buffer = magic); (* already checked by apply_rewriter *)
- Location.input_name := input_value ic;
+ Location.set_input_name @@ input_value ic;
  let ast = input_value ic in
  close_in ic;
  Misc.remove_file fn;
@@ -152,11 +152,11 @@ let file ppf ~tool_name inputfile parse_fun ast_magic =
  (* FIXME make this a proper warning *)
  fprintf ppf "@[Warning: %s@]@."
  "option -unsafe used with a preprocessor returning a syntax tree";
- Location.input_name := input_value ic;
+ Location.set_input_name @@ input_value ic;
  input_value ic
  end else begin
  seek_in ic 0;
- Location.input_name := inputfile;
+ Location.set_input_name  inputfile;
  let lexbuf = Lexing.from_channel ic in
  Location.init lexbuf inputfile;
  parse_fun lexbuf
@@ -183,7 +183,7 @@ let () =
  )
 
 let parse_all ~tool_name parse_fun magic ppf sourcefile =
- Location.input_name := sourcefile;
+ Location.set_input_name  sourcefile;
  let inputfile = preprocess sourcefile in
  let ast =
  try file ppf ~tool_name inputfile parse_fun magic

parsing/ast_mapper.ml

@@ -799,7 +799,7 @@ let apply_lazy ~source ~target mapper =
  if magic <> Config.ast_impl_magic_number
  && magic <> Config.ast_intf_magic_number then
  failwith "Ast_mapper: OCaml version mismatch or malformed input";
- Location.input_name := input_value ic;
+ Location.set_input_name @@ input_value ic;
  let ast = input_value ic in
  close_in ic;
 

parsing/location.ml

@@ -65,7 +65,8 @@ let rhs_loc n = {
 
 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 status = ref Terminfo.Uninitialised

parsing/location.mli

@@ -48,6 +48,7 @@ val symbol_gloc: unit -> t
 val rhs_loc: int -> t
 
 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 *)