1
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