location.ml1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101(* -------------------------------------------------------------------- *) open Core open Lexing (* -------------------------------------------------------------------- *) type t = { loc_fname : string; loc_start : int * int; loc_end : int * int; loc_bchar : int; loc_echar : int; } and 'a loced = { plloc : t; pldesc : 'a; } [@@deriving yojson, show {with_path = false}, visitors { variety = "map"; name = "location_map"; polymorphic = true }, visitors { variety = "iter"; name = "location_iter"; polymorphic = true }, visitors { variety = "reduce"; name = "location_reduce"; polymorphic = true }, visitors { variety = "reduce2"; name = "location_reduce2"; polymorphic = true } ] let dummy : t = { loc_fname = ""; loc_start = (-1, -1); loc_end = (-1, -1); loc_bchar = -1; loc_echar = -1; } (* -------------------------------------------------------------------- *) let make (p1 : position) (p2 : position) = let mkpos (p : position) = (p.pos_lnum, p.pos_cnum - p.pos_bol) in { loc_fname = p1.pos_fname; loc_start = mkpos p1 ; loc_end = mkpos p2 ; loc_bchar = p1.pos_cnum ; loc_echar = p2.pos_cnum ; } let of_lexbuf (lb : lexbuf) = let p1 = Lexing.lexeme_start_p lb in let p2 = Lexing.lexeme_end_p lb in make p1 p2 (* --------------------------------------------------------------------- *) let merge (p1 : t) (p2 : t) = { loc_fname = p1.loc_fname; loc_start = min p1.loc_start p2.loc_start; loc_end = max p1.loc_end p2.loc_end ; loc_bchar = min p1.loc_bchar p2.loc_bchar; loc_echar = max p1.loc_echar p2.loc_echar; } let mergeall (p : t list) = match p with | [] -> dummy | t :: ts -> List.fold_left merge t ts let isdummy (p : t) = p.loc_bchar < 0 || p.loc_echar < 0 (* --------------------------------------------------------------------- *) let tostring (p : t) = let spos = if p.loc_start = p.loc_end then Printf.sprintf "line %d (%d)" (fst p.loc_start) (snd p.loc_start) else if fst p.loc_start = fst p.loc_end then Printf.sprintf "line %d (%d-%d)" (fst p.loc_start) (snd p.loc_start) (snd p.loc_end) else Printf.sprintf "line %d (%d) to line %d (%d)" (fst p.loc_start) (snd p.loc_start) (fst p.loc_end ) (snd p.loc_end ) in if p.loc_fname <> "" then Printf.sprintf "%s: %s" p.loc_fname spos else spos (* -------------------------------------------------------------------- *) let pp_loced pp fmt (x : 'a loced) = Format.fprintf fmt "%a" pp x.pldesc let loc x = x.plloc let unloc x = x.pldesc let unlocs x = List.map unloc x let aspair x = (loc x, unloc x) let lmap (f : 'a -> 'b) (x : 'a loced) = { x with pldesc = f x.pldesc } let mkloc loc (x : 'a) : 'a loced = { plloc = loc; pldesc = x; } let dumloc (x : 'a) : 'a loced = mkloc dummy x let deloc x = x.plloc, x.pldesc