@@ -29,8 +29,6 @@ module Token = struct
29
29
| Property (* * {x:...} *)
30
30
| JsxLowercase (* * div in <div> *)
31
31
32
- type tokenModifiers = NoModifier
33
-
34
32
let tokenTypeToString = function
35
33
| Operator -> " 0"
36
34
| Variable -> " 1"
@@ -51,9 +49,9 @@ module Token = struct
51
49
| Property -> " Property"
52
50
| JsxLowercase -> " JsxLowercase"
53
51
54
- let tokenModifiersToString = function NoModifier -> " 0"
52
+ let tokenModifiersString = " 0" (* None at the moment *)
55
53
56
- type token = int * int * int * tokenType * tokenModifiers
54
+ type token = int * int * int * tokenType
57
55
58
56
type emitter = {
59
57
mutable tokens : token list ;
@@ -64,24 +62,27 @@ module Token = struct
64
62
let createEmitter () = {tokens = [] ; lastLine = 0 ; lastChar = 0 }
65
63
66
64
let add ~line ~char ~length ~type_ e =
67
- let modifiers = NoModifier in
68
- e.tokens < - (line, char , length, type_, modifiers) :: e.tokens
65
+ e.tokens < - (line, char , length, type_) :: e.tokens
69
66
70
- let emitToken buf (line , char , length , type_ , modifiers ) e =
67
+ let emitToken buf (line , char , length , type_ ) e =
71
68
let deltaLine = line - e.lastLine in
72
69
let deltaChar = if deltaLine = 0 then char - e.lastChar else char in
73
70
e.lastLine < - line;
74
71
e.lastChar < - char ;
75
72
if Buffer. length buf > 0 then Buffer. add_char buf ',' ;
76
- Buffer. add_string buf
77
- (string_of_int deltaLine ^ " ," ^ string_of_int deltaChar ^ " ,"
78
- ^ string_of_int length ^ " ," ^ tokenTypeToString type_ ^ " ,"
79
- ^ tokenModifiersToString modifiers)
73
+ if
74
+ deltaLine > = 0 && deltaChar > = 0 && length > = 0
75
+ (* Defensive programming *)
76
+ then
77
+ Buffer. add_string buf
78
+ (string_of_int deltaLine ^ " ," ^ string_of_int deltaChar ^ " ,"
79
+ ^ string_of_int length ^ " ," ^ tokenTypeToString type_ ^ " ,"
80
+ ^ tokenModifiersString)
80
81
81
82
let emit e =
82
83
let sortedTokens =
83
84
e.tokens
84
- |> List. sort (fun (l1 , c1 , _ , _ , _ ) (l2 , c2 , _ , _ , _ ) ->
85
+ |> List. sort (fun (l1 , c1 , _ , _ ) (l2 , c2 , _ , _ ) ->
85
86
if l1 = l2 then compare c1 c2 else compare l1 l2)
86
87
in
87
88
let buf = Buffer. create 1 in
@@ -166,8 +167,9 @@ let emitVariable ~id ~debug ~loc emitter =
166
167
if debug then Printf. printf " Variable: %s %s\n " id (Loc. toString loc);
167
168
emitter |> emitFromLoc ~loc ~type_: Variable
168
169
169
- let emitJsxOpen ~lid ~debug ~loc emitter =
170
- emitter |> emitLongident ~pos: (Loc. start loc) ~lid ~jsx: true ~debug
170
+ let emitJsxOpen ~lid ~debug ~(loc : Location.t ) emitter =
171
+ if not loc.loc_ghost then
172
+ emitter |> emitLongident ~pos: (Loc. start loc) ~lid ~jsx: true ~debug
171
173
172
174
let emitJsxClose ~lid ~debug ~pos emitter =
173
175
emitter |> emitLongident ~backwards: true ~pos ~lid ~jsx: true ~debug
@@ -176,20 +178,23 @@ let emitJsxTag ~debug ~name ~pos emitter =
176
178
if debug then Printf. printf " JsxTag %s: %s\n " name (Pos. toString pos);
177
179
emitter |> emitFromRange (pos, (fst pos, snd pos + 1 )) ~type_: Token. JsxTag
178
180
179
- let emitType ~lid ~debug ~loc emitter =
180
- emitter
181
- |> emitLongident ~lower CaseToken:Token. Type ~pos: (Loc. start loc) ~lid ~debug
181
+ let emitType ~lid ~debug ~(loc : Location.t ) emitter =
182
+ if not loc.loc_ghost then
183
+ emitter
184
+ |> emitLongident ~lower CaseToken:Token. Type ~pos: (Loc. start loc) ~lid ~debug
182
185
183
186
let emitRecordLabel ~(label : Longident.t Location.loc ) ~debug emitter =
184
- emitter
185
- |> emitLongident ~lower CaseToken:Token. Property ~pos: (Loc. start label.loc)
186
- ~pos End:(Some (Loc. end_ label.loc))
187
- ~lid: label.txt ~debug
187
+ if not label.loc.loc_ghost then
188
+ emitter
189
+ |> emitLongident ~lower CaseToken:Token. Property ~pos: (Loc. start label.loc)
190
+ ~pos End:(Some (Loc. end_ label.loc))
191
+ ~lid: label.txt ~debug
188
192
189
193
let emitVariant ~(name : Longident.t Location.loc ) ~debug emitter =
190
- emitter
191
- |> emitLongident ~last Token:(Some Token. EnumMember ) ~pos: (Loc. start name.loc)
192
- ~lid: name.txt ~debug
194
+ if not name.loc.loc_ghost then
195
+ emitter
196
+ |> emitLongident ~last Token:(Some Token. EnumMember )
197
+ ~pos: (Loc. start name.loc) ~lid: name.txt ~debug
193
198
194
199
let command ~debug ~emitter ~path =
195
200
let processTypeArg (coreType : Parsetree.core_type ) =
@@ -235,10 +240,11 @@ let command ~debug ~emitter ~path =
235
240
match e.pexp_desc with
236
241
| Pexp_ident {txt = lid ; loc} ->
237
242
if lid <> Lident " not" then
238
- emitter
239
- |> emitLongident ~pos: (Loc. start loc)
240
- ~pos End:(Some (Loc. end_ loc))
241
- ~lid ~debug ;
243
+ if not loc.loc_ghost then
244
+ emitter
245
+ |> emitLongident ~pos: (Loc. start loc)
246
+ ~pos End:(Some (Loc. end_ loc))
247
+ ~lid ~debug ;
242
248
Ast_iterator. default_iterator.expr iterator e
243
249
| Pexp_apply ({pexp_desc = Pexp_ident lident; pexp_loc}, args)
244
250
when Res_parsetree_viewer. isJsxExpression e ->
@@ -320,50 +326,56 @@ let command ~debug ~emitter ~path =
320
326
(me : Parsetree.module_expr ) =
321
327
match me.pmod_desc with
322
328
| Pmod_ident {txt = lid ; loc} ->
323
- emitter |> emitLongident ~pos: (Loc. start loc) ~lid ~debug ;
329
+ if not loc.loc_ghost then
330
+ emitter |> emitLongident ~pos: (Loc. start loc) ~lid ~debug ;
324
331
Ast_iterator. default_iterator.module_expr iterator me
325
332
| _ -> Ast_iterator. default_iterator.module_expr iterator me
326
333
in
327
334
let module_binding (iterator : Ast_iterator.iterator )
328
335
(mb : Parsetree.module_binding ) =
329
- emitter
330
- |> emitLongident
331
- ~pos: (Loc. start mb.pmb_name.loc)
332
- ~lid: (Longident. Lident mb.pmb_name.txt) ~debug ;
336
+ if not mb.pmb_name.loc.loc_ghost then
337
+ emitter
338
+ |> emitLongident
339
+ ~pos: (Loc. start mb.pmb_name.loc)
340
+ ~lid: (Longident. Lident mb.pmb_name.txt) ~debug ;
333
341
Ast_iterator. default_iterator.module_binding iterator mb
334
342
in
335
343
let module_declaration (iterator : Ast_iterator.iterator )
336
344
(md : Parsetree.module_declaration ) =
337
- emitter
338
- |> emitLongident
339
- ~pos: (Loc. start md.pmd_name.loc)
340
- ~lid: (Longident. Lident md.pmd_name.txt) ~debug ;
345
+ if not md.pmd_name.loc.loc_ghost then
346
+ emitter
347
+ |> emitLongident
348
+ ~pos: (Loc. start md.pmd_name.loc)
349
+ ~lid: (Longident. Lident md.pmd_name.txt) ~debug ;
341
350
Ast_iterator. default_iterator.module_declaration iterator md
342
351
in
343
352
let module_type (iterator : Ast_iterator.iterator )
344
353
(mt : Parsetree.module_type ) =
345
354
match mt.pmty_desc with
346
355
| Pmty_ident {txt = lid ; loc} ->
347
- emitter
348
- |> emitLongident ~upper CaseToken:Token. Type ~pos: (Loc. start loc) ~lid
349
- ~debug ;
356
+ if not loc.loc_ghost then
357
+ emitter
358
+ |> emitLongident ~upper CaseToken:Token. Type ~pos: (Loc. start loc) ~lid
359
+ ~debug ;
350
360
Ast_iterator. default_iterator.module_type iterator mt
351
361
| _ -> Ast_iterator. default_iterator.module_type iterator mt
352
362
in
353
363
let module_type_declaration (iterator : Ast_iterator.iterator )
354
364
(mtd : Parsetree.module_type_declaration ) =
355
- emitter
356
- |> emitLongident ~upper CaseToken:Token. Type
357
- ~pos: (Loc. start mtd.pmtd_name.loc)
358
- ~lid: (Longident. Lident mtd.pmtd_name.txt) ~debug ;
365
+ if not mtd.pmtd_name.loc.loc_ghost then
366
+ emitter
367
+ |> emitLongident ~upper CaseToken:Token. Type
368
+ ~pos: (Loc. start mtd.pmtd_name.loc)
369
+ ~lid: (Longident. Lident mtd.pmtd_name.txt) ~debug ;
359
370
Ast_iterator. default_iterator.module_type_declaration iterator mtd
360
371
in
361
372
let open_description (iterator : Ast_iterator.iterator )
362
373
(od : Parsetree.open_description ) =
363
- emitter
364
- |> emitLongident
365
- ~pos: (Loc. start od.popen_lid.loc)
366
- ~lid: od.popen_lid.txt ~debug ;
374
+ if not od.popen_lid.loc.loc_ghost then
375
+ emitter
376
+ |> emitLongident
377
+ ~pos: (Loc. start od.popen_lid.loc)
378
+ ~lid: od.popen_lid.txt ~debug ;
367
379
Ast_iterator. default_iterator.open_description iterator od
368
380
in
369
381
let label_declaration (iterator : Ast_iterator.iterator )
0 commit comments