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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
(* camlp5r *)
(* ploc.ml,v *)
(* Copyright (c) INRIA 2007-2017 *)
(* #load "pa_macro.cmo" *)
type t =
{ fname : string;
line_nb : int;
bol_pos : int;
line_nb_last : int;
bol_pos_last : int;
bp : int;
ep : int;
comm : string;
ecomm : string }
;;
let make_loc fname line_nb bol_pos (bp, ep) comm =
{fname = fname; line_nb = line_nb; bol_pos = bol_pos;
line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep;
comm = comm; ecomm = ""}
;;
let make_unlined (bp, ep) =
{fname = ""; line_nb = 1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
bp = bp; ep = ep; comm = ""; ecomm = ""}
;;
let dummy =
{fname = ""; line_nb = 1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
bp = 0; ep = 0; comm = ""; ecomm = ""}
;;
let file_name loc = loc.fname;;
let first_pos loc = loc.bp;;
let last_pos loc = loc.ep;;
let line_nb loc = loc.line_nb;;
let bol_pos loc = loc.bol_pos;;
let line_nb_last loc = loc.line_nb_last;;
let bol_pos_last loc = loc.bol_pos_last;;
let comment loc = loc.comm;;
let comment_last loc = loc.ecomm;;
let encl loc1 loc2 =
if loc1.bp < loc2.bp then
if loc1.ep < loc2.ep then
{fname = loc1.fname; line_nb = loc1.line_nb; bol_pos = loc1.bol_pos;
line_nb_last = loc2.line_nb_last; bol_pos_last = loc2.bol_pos_last;
bp = loc1.bp; ep = loc2.ep; comm = loc1.comm; ecomm = loc2.comm}
else loc1
else if loc2.ep < loc1.ep then
{fname = loc2.fname; line_nb = loc2.line_nb; bol_pos = loc2.bol_pos;
line_nb_last = loc1.line_nb_last; bol_pos_last = loc1.bol_pos_last;
bp = loc2.bp; ep = loc1.ep; comm = loc2.comm; ecomm = loc1.comm}
else loc2
;;
let shift sh loc = {loc with bp = sh + loc.bp; ep = sh + loc.ep};;
let sub loc sh len = {loc with bp = loc.bp + sh; ep = loc.bp + sh + len};;
let after loc sh len = {loc with bp = loc.ep + sh; ep = loc.ep + sh + len};;
let with_comment loc comm = {loc with comm = comm};;
let with_comment_last loc ecomm = {loc with ecomm = ecomm};;
let with_line_nb_last loc n = {loc with line_nb_last = n};;
let with_bol_pos_last loc n = {loc with bol_pos_last = n};;
let name = ref "loc";;
let from_file fname loc =
let (bp, ep) = first_pos loc, last_pos loc in
try
let ic = open_in_bin fname in
let strm = Stream.of_channel ic in
let rec loop fname lin =
let rec not_a_line_dir col (strm__ : _ Stream.t) =
let cnt = Stream.count strm__ in
match Stream.peek strm__ with
Some c ->
Stream.junk strm__;
let s = strm__ in
if cnt < bp then
if c = '\n' then loop fname (lin + 1)
else not_a_line_dir (col + 1) s
else let col = col - (cnt - bp) in fname, lin, col, col + ep - bp
| _ -> fname, lin, col, col + 1
in
let rec a_line_dir str n col (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some '\n' -> Stream.junk strm__; loop str n
| Some _ ->
Stream.junk strm__; let s = strm__ in a_line_dir str n (col + 1) s
| _ -> raise Stream.Failure
in
let rec spaces col (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some ' ' -> Stream.junk strm__; let s = strm__ in spaces (col + 1) s
| _ -> col
in
let rec check_string str n col (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some '"' ->
Stream.junk strm__;
let col =
try spaces (col + 1) strm__ with
Stream.Failure -> raise (Stream.Error "")
in
let s = strm__ in a_line_dir str n col s
| Some c when c <> '\n' ->
Stream.junk strm__;
let s = strm__ in
check_string (str ^ String.make 1 c) n (col + 1) s
| _ -> not_a_line_dir col strm__
in
let check_quote n col (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some '"' ->
Stream.junk strm__;
let s = strm__ in check_string "" n (col + 1) s
| _ -> not_a_line_dir col strm__
in
let rec check_num n col (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some ('0'..'9' as c) ->
Stream.junk strm__;
let s = strm__ in
check_num (10 * n + Char.code c - Char.code '0') (col + 1) s
| _ ->
let col = spaces col strm__ in
let s = strm__ in check_quote n col s
in
let begin_line (strm__ : _ Stream.t) =
match Stream.peek strm__ with
Some '#' ->
Stream.junk strm__;
let col =
try spaces 1 strm__ with
Stream.Failure -> raise (Stream.Error "")
in
let s = strm__ in check_num 0 col s
| _ -> not_a_line_dir 0 strm__
in
begin_line strm
in
let r =
try loop fname 1 with
Stream.Failure ->
let bol = bol_pos loc in fname, line_nb loc, bp - bol, ep - bol
in
close_in ic; r
with Sys_error _ -> fname, 1, bp, ep
;;
let second_line fname ep0 (line, bp) ep =
let ic = open_in fname in
seek_in ic bp;
let rec loop line bol p =
if p = ep then
begin close_in ic; if bol = bp then line, ep0 else line, ep - bol end
else
let (line, bol) =
match input_char ic with
'\n' -> line + 1, p + 1
| _ -> line, bol
in
loop line bol (p + 1)
in
loop line bp bp
;;
let get loc =
if loc.fname = "" || loc.fname = "-" then
loc.line_nb, loc.bp - loc.bol_pos, loc.line_nb, loc.ep - loc.bol_pos,
loc.ep - loc.bp
else
let (bl, bc, ec) =
loc.line_nb, loc.bp - loc.bol_pos, loc.ep - loc.bol_pos
in
let (el, eep) = second_line loc.fname ec (bl, loc.bp) loc.ep in
bl, bc, el, eep, ec - bc
;;
let call_with r v f a =
let saved = !r in
try r := v; let b = f a in r := saved; b with e -> r := saved; raise e
;;
exception Exc of t * exn;;
let raise loc exc =
match exc with
Exc (_, _) -> raise exc
| _ -> raise (Exc (loc, exc))
;;
type 'a vala =
VaAnt of string
| VaVal of 'a
;;
let warned = ref true;;
let warning_deprecated_since_6_00 name =
if not !warned then
begin
Printf.eprintf "<W> %s deprecated since version 6.00" name;
warned := true
end
;;
let make line_nb bol_pos (bp, ep) =
let _ = warning_deprecated_since_6_00 "Ploc.make" in
{fname = ""; line_nb = line_nb; bol_pos = bol_pos; line_nb_last = line_nb;
bol_pos_last = bol_pos; bp = bp; ep = ep; comm = ""; ecomm = ""}
;;
let string_of_loc fname line bp ep =
match Sys.os_type with
"MacOS" ->
Printf.sprintf "File \"%s\"; line %d; characters %d to %d\n### " fname
line bp ep
| _ ->
Printf.sprintf "File \"%s\", line %d, characters %d-%d:\n" fname line bp
ep
;;
let string_of_location
{fname = fname; bp = bp; ep = ep; line_nb = line; bol_pos = bol} =
string_of_loc fname line (bp - bol) (ep - bol)
;;
|
