[location] Remove Loc.ghost.

Now it is a private field, locations are optional.

9 files changed, 40 insertions, 49 deletions

diff --git a/lib/aux_file.ml b/lib/aux_file.ml
index 1b6651a55f..fe6e873883 100644
--- a/lib/aux_file.ml
+++ b/lib/aux_file.ml
@@ -46,19 +46,21 @@ let contents x = x
 
 let empty_aux_file = H.empty
 
-let get aux loc key = M.find key (H.find (Loc.unloc loc) aux)
+let get ?loc aux key = M.find key (H.find (Option.cata Loc.unloc (0,0) loc) aux)
 
-let record_in_aux_at loc key v =
+let record_in_aux_at ?loc key v =
   Option.iter (fun oc ->
-    let i, j = Loc.unloc loc in
-    Printf.fprintf oc "%d %d %s %S\n" i j key v)
-  !oc
+      match loc with
+      | Some loc -> let i, j = Loc.unloc loc in
+                    Printf.fprintf oc "%d %d %s %S\n" i j key v
+      | None     -> Printf.fprintf oc "--- %s %S\n" key v
+    ) !oc
 
-let current_loc = ref Loc.ghost
+let current_loc : Loc.t option ref = ref None
 
-let record_in_aux_set_at loc = current_loc := loc
+let record_in_aux_set_at ?loc = current_loc := loc
 
-let record_in_aux key v = record_in_aux_at !current_loc key v
+let record_in_aux key v = record_in_aux_at ?loc:!current_loc key v
 
 let set h loc k v =
   let m = try H.find loc h with Not_found -> M.empty in
@@ -91,4 +93,4 @@ let load_aux_file_for vfile =
     Flags.if_verbose Feedback.msg_info Pp.(str"Loading file "++str aux_fname++str": "++str s);
      empty_aux_file
 
-let set h loc k v = set h (Loc.unloc loc) k v
+let set ?loc h k v = set h (Option.cata Loc.unloc (0,0) loc) k v
diff --git a/lib/aux_file.mli b/lib/aux_file.mli
index 86e322b71d..41b7b0855d 100644
--- a/lib/aux_file.mli
+++ b/lib/aux_file.mli
@@ -9,9 +9,9 @@
 type aux_file
 
 val load_aux_file_for : string -> aux_file
-val get : aux_file -> Loc.t -> string -> string
 val empty_aux_file : aux_file
-val set : aux_file -> Loc.t -> string -> string -> aux_file
+val get : ?loc:Loc.t -> aux_file -> string -> string
+val set : ?loc:Loc.t -> aux_file -> string -> string -> aux_file
 
 module H : Map.S with type key = int * int
 module M : Map.S with type key = string
@@ -22,6 +22,6 @@ val start_aux_file : aux_file:string -> v_file:string -> unit
 val stop_aux_file : unit -> unit 
 val recording : unit -> bool
 
-val record_in_aux_at : Loc.t -> string -> string -> unit
+val record_in_aux_at : ?loc:Loc.t -> string -> string -> unit
 val record_in_aux : string -> string -> unit
-val record_in_aux_set_at : Loc.t -> unit
+val record_in_aux_set_at : ?loc:Loc.t -> unit
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index 2f569d2849..4e692af360 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -20,10 +20,10 @@ type t = {
 let warnings : (string, t) Hashtbl.t = Hashtbl.create 97
 let categories : (string, string list) Hashtbl.t = Hashtbl.create 97
 
-let current_loc = ref Loc.ghost
+let current_loc = ref None
 let flags = ref ""
 
-let set_current_loc = (:=) current_loc
+let set_current_loc loc = current_loc := Some loc
 
 let get_flags () = !flags
 
@@ -35,29 +35,22 @@ let add_warning_in_category ~name ~category =
   in
   Hashtbl.replace categories category (name::ws)
 
-let refine_loc = function
-  | None when not (Loc.is_ghost !current_loc) -> Some !current_loc
-  | loc -> loc
-
 let create ~name ~category ?(default=Enabled) pp =
   Hashtbl.add warnings name { default; category; status = default };
   add_warning_in_category ~name ~category;
   if default <> Disabled then
     add_warning_in_category ~name ~category:"default";
-  fun ?loc x -> let w = Hashtbl.find warnings name in
+  fun ?loc x ->
+           let w = Hashtbl.find warnings name in
+           let loc = Option.append loc !current_loc in
            match w.status with
            | Disabled -> ()
-           | AsError ->
-              begin match refine_loc loc with
-              | Some loc -> CErrors.user_err ~loc (pp x)
-              | None -> CErrors.user_err (pp x)
-              end
+           | AsError -> CErrors.user_err ?loc (pp x)
            | Enabled ->
               let msg =
                 pp x ++ spc () ++ str "[" ++ str name ++ str "," ++
                   str category ++ str "]"
               in
-              let loc = refine_loc loc in
               Feedback.msg_warning ?loc msg
 
 let warn_unknown_warning =
diff --git a/lib/feedback.ml b/lib/feedback.ml
index df6fe3a629..3552fa4a03 100644
--- a/lib/feedback.ml
+++ b/lib/feedback.ml
@@ -30,7 +30,7 @@ type feedback_content =
   | FileDependency of string option * string
   | FileLoaded of string * string
   (* Extra metadata *)
-  | Custom of Loc.t * string * xml
+  | Custom of Loc.t option * string * xml
   (* Generic messages *)
   | Message of level * Loc.t option * Pp.std_ppcmds
 
diff --git a/lib/feedback.mli b/lib/feedback.mli
index bdd236ac78..dc104132a0 100644
--- a/lib/feedback.mli
+++ b/lib/feedback.mli
@@ -38,7 +38,7 @@ type feedback_content =
   | FileDependency of string option * string
   | FileLoaded of string * string
   (* Extra metadata *)
-  | Custom of Loc.t * string * xml
+  | Custom of Loc.t option * string * xml
   (* Generic messages *)
   | Message of level * Loc.t option * Pp.std_ppcmds
 
diff --git a/lib/loc.ml b/lib/loc.ml
index 2a785fac48..3051ca7b9d 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -26,12 +26,6 @@ let make_loc (bp, ep) = {
   fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
   bp = bp; ep = ep; }
 
-let ghost = {
-  fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
-  bp = 0; ep = 0; }
-
-let is_ghost loc = loc.ep = 0
-
 let merge loc1 loc2 =
   if loc1.bp < loc2.bp then
     if loc1.ep < loc2.ep then {
@@ -51,15 +45,24 @@ let merge loc1 loc2 =
     bp = loc2.bp; ep = loc1.ep; }
   else loc2
 
+let merge_opt l1 l2 = Option.cata (fun l1 -> merge l1 l2) l2 l1
+let opt_merge l1 l2 = Option.cata (fun l2 -> merge l1 l2) l1 l2
+
 let unloc loc = (loc.bp, loc.ep)
 
-let dummy_loc = ghost
 let join_loc = merge
 
 (** Located type *)
 
 type 'a located = t * 'a
 
+let is_ghost loc = loc.ep = 0
+
+let ghost = {
+  fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
+  bp = 0; ep = 0; }
+
+let internal_ghost = ghost
 let to_pair x = x
 let tag ?loc x = Option.default ghost loc, x
 let obj (_,x) = x
diff --git a/lib/loc.mli b/lib/loc.mli
index 10f63a8dd7..82792613c0 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -32,14 +32,15 @@ val unloc : t -> int * int
 val make_loc : int * int -> t
 (** Make a location out of its start and end position *)
 
-val ghost : t
-(** Dummy location *)
-
+val internal_ghost : t
 val is_ghost : t -> bool
 (** Test whether the location is meaningful *)
 
 val merge : t -> t -> t
 
+val merge_opt : t option -> t -> t
+val opt_merge : t -> t option -> t
+
 (** {5 Located exceptions} *)
 
 val add_loc : Exninfo.info -> t -> Exninfo.info
@@ -71,15 +72,7 @@ val map_with_loc : (loc:t -> 'a -> 'b) -> 'a located -> 'b located
 val located_fold_left : ('a -> 'b -> 'a) -> 'a -> 'b located -> 'a
 val down_located : ('a -> 'b) -> 'a located -> 'b
 
-(* Current not used *)
+(* Currently not used *)
 val located_iter2 : ('a -> 'b -> unit) -> 'a located -> 'b located -> unit
 
 (** Projects out a located object *)
-
-(** {5 Backward compatibility} *)
-
-val dummy_loc : t
-(** Same as [ghost] *)
-
-val join_loc : t -> t -> t
-(** Same as [merge] *)
diff --git a/lib/stateid.ml b/lib/stateid.ml
index ae25735c5f..34d49685b4 100644
--- a/lib/stateid.ml
+++ b/lib/stateid.ml
@@ -41,7 +41,7 @@ type ('a,'b) request = {
   exn_info : t * t;
   stop : t;
   document : 'b;
-  loc : Loc.t;
+  loc : Loc.t option;
   uuid     : 'a;
   name     : string
 }
diff --git a/lib/stateid.mli b/lib/stateid.mli
index 1d87a343b3..d9e75f5840 100644
--- a/lib/stateid.mli
+++ b/lib/stateid.mli
@@ -34,7 +34,7 @@ type ('a,'b) request = {
   exn_info : t * t;
   stop : t;
   document : 'b;
-  loc : Loc.t;
+  loc : Loc.t option;
   uuid     : 'a;
   name     : string
 }