Source file indexScope.ml
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
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
open Approx_lexer
module Stream = struct
type stream =
{ nstream: Nstream.t;
last: token;
before_last: token;
region: Pos.Region.t;
stop: Lexing.position -> bool }
let of_nstream ?(stop=fun _ -> false) nstream = {
nstream;
last = COMMENT;
before_last = COMMENT;
region = Pos.Region.zero;
stop;
}
let next stream =
let shift stream tok region =
{ stream with
region;
last = tok;
before_last = match stream.last with
| COMMENT -> stream.before_last
| tok -> tok; }
in
match Nstream.next stream.nstream with
| Some ({Nstream.token; region}, nstream) ->
if stream.stop (Pos.Region.snd region)
then EOF, shift stream EOF region
else token, shift {stream with nstream} token region
| _ -> EOF, shift stream EOF stream.region
let equals st1 st2 =
st1.nstream == st2.nstream
let next_two stream =
let tok1, stream = next stream in
let tok2, stream = next stream in
tok1, tok2, stream
let next_three stream =
let tok1, stream = next stream in
let tok2, stream = next stream in
let tok3, stream = next stream in
tok1, tok2, tok3, stream
let previous stream = stream.before_last
let token stream = stream.last
let pos stream =
let pos1 = Pos.Region.fst stream.region in
let pos2 = Pos.Region.snd stream.region in
Lexing.(pos1.pos_lnum, pos1.pos_cnum - pos1.pos_bol, pos2.pos_cnum - pos1.pos_cnum)
end
let close_def stream = match Stream.previous stream with
| AMPERSAND | AMPERAMPER | BARBAR | BEGIN | COLONCOLON | COLONEQUAL | COMMA
| DO | DOWNTO | ELSE | EQUAL | GREATER | IF | IN | INFIXOP0 _ | INFIXOP1 _
| INFIXOP2 _ | INFIXOP3 _ | INFIXOP4 _ | LBRACE | LBRACELESS | LBRACKET
| LBRACKETBAR | LBRACKETLESS | LBRACKETGREATER | LESS | LESSMINUS | LPAREN
| MATCH | MINUS | MINUSDOT | MINUSGREATER | OR | PLUS | PLUSDOT | QUESTION
| QUESTIONQUESTION | SEMI | STAR | THEN | TO | TRY | WHEN | WHILE | TILDE ->
false
| _ -> true
let parse_path stream =
let rec aux acc stream =
match Stream.next_two stream with
| DOT, UIDENT i, stream -> aux (i::acc) stream
| _ -> List.rev acc, stream
in
match Stream.next stream with
| UIDENT i, stream ->
let path, stream = aux [] stream in
i::path, stream
| _ -> [], stream
let rec skip_to_next_paren stream =
let tok, stream = Stream.next stream in
match tok with
| RPAREN | EOF -> stream
| _ -> skip_to_next_paren stream
type scope = Def | Block | Paren | Brace
type env = Alias of string * string list | Open of string list
type t = (scope * env list) list
let empty = []
let rec close t scope = match t with
| [] -> []
| (scope1,_)::r when scope1 = scope -> r
| _::r -> close r scope
let maybe_close t scope = match t with
| (scope1,_)::r when scope1 = scope -> r
| t -> t
let push t info = match t with
| (scope, infos)::r -> (scope, info::infos) :: r
| [] -> [Block, [info]]
let parse_functor_args stream =
let rec aux stream =
let parse_error = [], stream in
match Stream.next_three stream with
| LPAREN, UIDENT x, COLON, stream ->
begin match parse_path stream with
| [], _ -> parse_error
| s , stream ->
let stream = skip_to_next_paren stream in
let args, stream = aux stream in
Alias (x,s) :: args, stream
end
| _ -> parse_error in
aux stream
let parse_functor stream =
let rec aux stream =
let parse_error = [], stream in
match Stream.next stream with
| FUNCTOR, stream ->
let args, stream = parse_functor_args stream in
begin match Stream.next stream with
| MINUSGREATER, stream ->
let rest, stream = aux stream in
args @ rest, stream
| _ -> parse_error
end
| _ -> parse_error in
aux stream
let parse t stream0 =
let tok, stream = Stream.next stream0 in
match tok with
| STRUCT | SIG | BEGIN | OBJECT -> (Block, []) :: t, stream
| END -> close t Block, stream
| LPAREN -> (Paren, []) :: t, stream
| RPAREN -> close t Paren, stream
| LBRACE ->
if stream0.last = INFIXOP3 "%" then t, stream else
(match parse_path stream with
| [], stream -> (Brace, []) :: t, stream
| path, stream -> (Brace, [Open path]) :: t, stream)
| RBRACE ->
if stream0.last = INFIXOP3 "%" then t, stream else
close t Brace, stream
| OPEN ->
let t = if Stream.previous stream = LET then t else maybe_close t Def in
let path, stream = parse_path stream in
push t (Open path), stream
| INCLUDE ->
let path, stream = parse_path stream in
push t (Open path), stream
| LET when close_def stream -> (Def, []) :: maybe_close t Def, stream
| MODULE ->
let t = if close_def stream then maybe_close t Def else t in
let ident, stream = match Stream.next stream with
| UIDENT u, stream -> u, stream
| TYPE, stream1 -> (match Stream.next stream1 with
| UIDENT u, stream -> u, stream
| _ -> "", stream)
| _ -> "", stream in
let functor_pre_args, stream = parse_functor_args stream in
let top_def, stream =
match Stream.next stream with
| EQUAL, stream1 ->
begin match parse_path stream1 with
| [] , _ -> [], stream
| path, stream -> path, stream
end
| _ -> [], stream
in
let functor_post_args, stream =
match Stream.next stream with
| EQUAL, stream -> parse_functor stream
| _ -> [], stream in
let aliases = functor_pre_args @ functor_post_args in
let t = if top_def <> [] then push t (Alias (ident, top_def)) else t in
(Def, Open [ident] :: aliases) :: t, stream
| UIDENT _ ->
let path, stream = parse_path stream0 in
(match Stream.next_two stream with
| DOT, LPAREN, stream -> (Paren, [Open path]) :: t, stream
| DOT, LBRACE, stream ->
(match parse_path stream with
| [], stream -> (Brace, [Open path]) :: t, stream
| path2, stream -> (Brace, [Open path; Open path2]) :: t, stream)
| _ -> t, stream)
| _ -> t, stream
let pos_after line col pos =
let open Lexing in
pos.pos_lnum > line ||
pos.pos_lnum = line && pos.pos_cnum - pos.pos_bol >= col
let read_nstream ?line ?column nstream =
let rec parse_all (t,stream) =
if Stream.previous stream = EOF then t else parse_all (parse t stream)
in
let stop = match line, column with
| Some l, Some c -> Some (pos_after l c)
| Some l, None -> Some (pos_after l 0)
| _ -> None
in
parse_all ([Block,[]], Stream.of_nstream ?stop nstream)
let read ?line ?column chan =
read_nstream ?line ?column (Nstream.of_channel chan)
let read_string string =
read_nstream (Nstream.of_string string)
let to_list =
let aux acc t =
List.fold_left (fun acc -> function
| Brace, _ -> acc
| _, ctx -> List.rev_append ctx acc)
acc t
in
function
| (Brace, ctx) :: t -> aux (List.rev ctx) t
| t -> aux [] t
let fold_nstream f acc ?(init=[]) ?stop nstream =
let rec aux acc t stream =
if Stream.previous stream = EOF then acc else
let t1, stream1 = parse t stream in
let rec catch_up acc stream =
let tok, stream = Stream.next stream in
if Stream.equals stream stream1 then acc
else catch_up (f acc t tok (Stream.pos stream)) stream
in
let acc = catch_up acc stream in
let acc = f acc t1 (Stream.token stream1) (Stream.pos stream1) in
aux acc t1 stream1
in
let stream = Stream.of_nstream ?stop nstream in
aux acc [Block,init] stream
let fold f acc ?init ?stop chan =
fold_nstream f acc ?init ?stop (Nstream.of_channel chan)
let fold_string f acc ?init ?stop chan =
fold_nstream f acc ?init ?stop (Nstream.of_string chan)
let from_dot_merlin dir =
try
let ic = open_in (Filename.concat dir ".merlin") in
try
let rec scan ic =
match IndexMisc.string_split ' ' (input_line ic) with
| "FLG" :: flags ->
let rec aux = function
| "-open" :: modname :: r ->
Open (IndexMisc.string_split '.' modname) :: aux r
| _ :: r -> aux r
| [] -> []
in
aux flags @ scan ic
| _ -> scan ic
| exception End_of_file -> []
in
let r = scan ic in
close_in ic; r
with e -> close_in ic; raise e
with _ -> []