From e8a6467545c2814c9418889201e8be19c0cef201 Mon Sep 17 00:00:00 2001
From: Emilio Jesus Gallego Arias
Date: Wed, 18 Jan 2017 15:46:23 +0100
Subject: [location] Make location optional in Loc.located

This completes the Loc.ghost removal, the idea is to gear the API
towards optional, but uniform, location handling.

We don't print <unknown> anymore in the case there is no location.
This is what the test suite expects.

The old printing logic for located items was a bit inconsistent as
it sometimes printed <unknown> and other times it printed nothing as
the caller checked for `is_ghost` upstream.
---
 lib/cWarnings.ml  |  2 +-
 lib/cWarnings.mli |  2 +-
 lib/loc.ml        | 25 ++++++++++++-------------
 lib/loc.mli       | 14 ++++++--------
 4 files changed, 20 insertions(+), 23 deletions(-)

(limited to 'lib')

diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index 4e692af360..ececc6308e 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -23,7 +23,7 @@ let categories : (string, string list) Hashtbl.t = Hashtbl.create 97
 let current_loc = ref None
 let flags = ref ""
 
-let set_current_loc loc = current_loc := Some loc
+let set_current_loc loc = current_loc := loc
 
 let get_flags () = !flags
 
diff --git a/lib/cWarnings.mli b/lib/cWarnings.mli
index 3f6cee31b7..c1fb5d6042 100644
--- a/lib/cWarnings.mli
+++ b/lib/cWarnings.mli
@@ -8,7 +8,7 @@
 
 type status = Disabled | Enabled | AsError
 
-val set_current_loc : Loc.t -> unit
+val set_current_loc : Loc.t option -> unit
 
 val create : name:string -> category:string -> ?default:status ->
              ('a -> Pp.std_ppcmds) -> ?loc:Loc.t -> 'a -> unit
diff --git a/lib/loc.ml b/lib/loc.ml
index 3051ca7b9d..e02fe108d6 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -45,33 +45,32 @@ 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 merge_opt l1 l2 = match l1, l2 with
+  | None, None    -> None
+  | Some l , None -> Some l
+  | None, Some l  -> Some l
+  | Some l1, Some l2 -> Some (merge l1 l2)
 
 let unloc loc = (loc.bp, loc.ep)
 
 let join_loc = merge
 
-(** Located type *)
-
-type 'a located = t * 'a
-
-let is_ghost loc = loc.ep = 0
-
-let ghost = {
+let internal_ghost = {
   fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
   bp = 0; ep = 0; }
 
-let internal_ghost = ghost
+(** Located type *)
+type 'a located = t option * 'a
+
 let to_pair x = x
-let tag ?loc x = Option.default ghost loc, x
+let tag ?loc x = loc, x
 let obj (_,x) = x
 
-let with_loc   f (loc, x) = f ~loc x
+let with_loc   f (loc, x) = f ?loc x
 let with_unloc f (_,x) = f x
 
 let map f (l,x) = (l, f x)
-let map_with_loc f (loc, x) = (loc, f ~loc x)
+let map_with_loc f (loc, x) = (loc, f ?loc x)
 
 let located_fold_left f x (_,a) = f x a
 let located_iter2 f (_,a) (_,b) = f a b
diff --git a/lib/loc.mli b/lib/loc.mli
index 82792613c0..6de6c584d8 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -33,13 +33,11 @@ val make_loc : int * int -> t
 (** Make a location out of its start and end position *)
 
 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
+val merge_opt : t option -> t option -> t option
 
 (** {5 Located exceptions} *)
 
@@ -54,20 +52,20 @@ val raise : ?loc:t -> exn -> 'a
 
 (** {5 Objects with location information } *)
 
-type 'a located = t * 'a
+type 'a located = t option * 'a
 (** Embed a location in a type *)
 
 (** Warning, this API is experimental  *)
 
-val to_pair : 'a located -> t * 'a
+val to_pair : 'a located -> t option * 'a
 val tag : ?loc:t -> 'a -> 'a located
 val obj : 'a located -> 'a
 
-val with_loc : (loc:t -> 'a -> 'b) -> 'a located -> 'b
+val with_loc : (?loc:t -> 'a -> 'b) -> 'a located -> 'b
 val with_unloc : ('a -> 'b) -> 'a located -> 'b
 
 val map : ('a -> 'b) -> 'a located -> 'b located
-val map_with_loc : (loc:t -> 'a -> 'b) -> 'a located -> 'b located
+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
-- 
cgit v1.2.3