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
open Migrate_ast
open Extended_ast
(** Concrete syntax. *)
type t = {text: string; tokens: (Parser.token * Location.t) array}
let create ~text ~tokens =
let tokens =
List.filter tokens ~f:(fun (tok, _) ->
match tok with Parser.EOL | Parser.EOF -> false | _ -> true )
in
{text; tokens= Array.of_list tokens}
let string_at t (l : Location.t) =
let pos = l.loc_start.Lexing.pos_cnum
and len = Position.distance l.loc_start l.loc_end in
String.sub t.text ~pos ~len
let find_token t k pos =
Array.binary_search t.tokens
~compare:(fun (_, elt) pos -> Position.compare elt.Location.loc_start pos)
k pos
let find_first_token_on_line t line =
match
Array.binary_search t.tokens
~compare:(fun (_, elt) -> Int.compare elt.Location.loc_start.pos_lnum)
`First_equal_to line
with
| None -> None
| Some i when i >= Array.length t.tokens -> None
| Some i -> Some t.tokens.(i)
let tokens_between (t : t) ~filter loc_start loc_end =
match find_token t `First_greater_than_or_equal_to loc_start with
| None -> []
| Some i ->
let rec loop i acc =
if i >= Array.length t.tokens then List.rev acc
else
let ((tok, tok_loc) as x) = t.tokens.(i) in
if Position.compare tok_loc.Location.loc_end loc_end > 0 then
List.rev acc
else
let acc = if filter tok then x :: acc else acc in
loop (i + 1) acc
in
loop i []
let empty_line_between (t : t) p1 p2 =
let l = tokens_between t ~filter:(function _ -> true) p1 p2 in
let rec loop (prev : Lexing.position) (l : (_ * Location.t) list) =
match l with
| [] -> p2.pos_lnum - prev.pos_lnum > 1
| (_tok, x) :: xs ->
x.loc_start.pos_lnum - prev.pos_lnum > 1 || loop x.loc_end xs
in
loop p1 l
let tokens_at t ~filter (l : Location.t) : (Parser.token * Location.t) list =
tokens_between t ~filter l.loc_start l.loc_end
let find_token_before t ~filter pos =
match find_token t `Last_strictly_less_than pos with
| None -> None
| Some i ->
let rec loop i =
if i < 0 then None
else
let ((tok, _) as elt) = t.tokens.(i) in
if filter tok then Some elt else loop (i - 1)
in
loop i
let find_token_after t ~filter pos =
match find_token t `First_greater_than_or_equal_to pos with
| None -> None
| Some i ->
let rec loop i =
if i >= Array.length t.tokens then None
else
let ((tok, _) as elt) = t.tokens.(i) in
if filter tok then Some elt else loop (i + 1)
in
loop i
let extend_loc_to_include_attributes (loc : Location.t) (l : attributes) =
let loc_end =
List.fold l ~init:loc ~f:(fun acc ({attr_loc; _} : attribute) ->
if Location.compare_end attr_loc acc <= 0 then acc else attr_loc )
in
if phys_equal loc_end loc then loc
else
{loc with loc_end= {loc.loc_end with pos_cnum= loc_end.loc_end.pos_cnum}}
let contains_token_between t ~(from : Location.t) ~(upto : Location.t) tok =
let filter = Poly.( = ) tok in
let from = from.loc_start and upto = upto.loc_start in
Source_code_position.ascending from upto < 0
&& not (List.is_empty (tokens_between t ~filter from upto))
let is_long_pexp_open source {pexp_desc; _} =
match pexp_desc with
| Pexp_open ({popen_loc= from; _}, {pexp_loc= upto; _}) ->
contains_token_between source ~from ~upto Parser.IN
| _ -> false
let is_long_functor_syntax (t : t) ~(from : Location.t) = function
| Unit -> false
| Named ({loc= _; _}, _) -> (
match
find_token_before t
~filter:(function COMMENT _ | DOCSTRING _ -> false | _ -> true)
from.loc_start
with
| Some (Parser.FUNCTOR, _) -> true
| _ -> false )
let is_long_pmod_functor t {pmod_desc; pmod_loc= from; _} =
match pmod_desc with
| Pmod_functor (fp, _) -> is_long_functor_syntax t ~from fp
| _ -> false
let is_long_pmty_functor t {pmty_desc; pmty_loc= from; _} =
match pmty_desc with
| Pmty_functor (fp, _) -> is_long_functor_syntax t ~from fp
| _ -> false
let string_literal t mode loc =
Option.value_exn ~message:"Parse error while reading string literal"
(Literal_lexer.string mode (string_at t loc))
let char_literal t loc =
Option.value_exn ~message:"Parse error while reading char literal"
(Literal_lexer.char (string_at t loc))
let begins_line ?(ignore_spaces = true) t (l : Location.t) =
if not ignore_spaces then Position.column l.loc_start = 0
else
match find_token_before t ~filter:(fun _ -> true) l.loc_start with
| None -> true
| Some (_, prev) ->
assert (Location.compare prev l < 0) ;
prev.loc_end.pos_lnum < l.loc_start.pos_lnum
let ends_line t (l : Location.t) =
match find_token_after t ~filter:(fun _ -> true) l.loc_end with
| None -> true
| Some (_, next) ->
assert (Location.compare next l > 0) ;
next.loc_start.pos_lnum > l.loc_end.pos_lnum
let empty_line_before t (loc : Location.t) =
match find_token_before t ~filter:(fun _ -> true) loc.loc_start with
| Some (_, before) -> Location.line_difference before loc > 1
| None -> false
let empty_line_after t (loc : Location.t) =
match find_token_after t ~filter:(fun _ -> true) loc.loc_end with
| Some (_, after) -> Location.line_difference loc after > 1
| None -> false
let extension_using_sugar ~(name : string Location.loc)
~(payload : Location.t) =
Source_code_position.ascending name.loc.loc_start payload.loc_start > 0
let type_constraint_is_first typ loc =
Location.compare_start typ.ptyp_loc loc < 0
let is_quoted_string t loc =
let toks =
tokens_at t loc ~filter:(function
| QUOTED_STRING_ITEM _ | QUOTED_STRING_EXPR _ -> true
| _ -> false )
in
not (List.is_empty toks)
let loc_of_first_token_at t loc kwd =
match tokens_at t loc ~filter:(Poly.( = ) kwd) with
| [] -> None
| (_, loc) :: _ -> Some loc