@@ -137,9 +137,6 @@ let rec forSignatureTypeItem env (exported : SharedTypes.exported) item =
137
137
env.stamps.types
138
138
in
139
139
[{declared with item = MType (declared.item, recStatus)}]
140
- (* | Sig_module({stamp, name}, {md_type: Mty_ident(path) | Mty_alias(path), md_attributes, md_loc}, _) =>
141
- let declared = addItem(~contents=Module.Ident(path), ~name=Location.mknoloc(name), ~stamp, ~env, md_attributes, exported.modules, env.stamps.modules);
142
- [{...declared, contents: Module.Module(declared.contents)}, ...items] *)
143
140
| Sig_module (ident , {md_type; md_attributes; md_loc} , _ ) ->
144
141
let declared =
145
142
addItem ~extent: md_loc
@@ -521,12 +518,12 @@ let fileForCmt ~moduleName ~uri cmt =
521
518
| Error e -> Error e
522
519
| Ok infos -> Ok (forCmt ~module Name ~uri infos)
523
520
521
+ let addLocItem extra loc locType =
522
+ if not loc.Warnings. loc_ghost then
523
+ extra.locItems < - {loc; locType} :: extra.locItems
524
+
524
525
let extraForFile ~(file : SharedTypes.file ) =
525
526
let extra = initExtra () in
526
- let addLocation loc ident =
527
- if not loc.Warnings. loc_ghost then
528
- extra.locations < - (loc, ident) :: extra.locations
529
- in
530
527
let addReference stamp loc =
531
528
Hashtbl. replace extra.internalReferences stamp
532
529
(loc
@@ -537,23 +534,23 @@ let extraForFile ~(file : SharedTypes.file) =
537
534
in
538
535
file.stamps.modules
539
536
|> Hashtbl. iter (fun stamp d ->
540
- addLocation d.name.loc (LModule (Definition (stamp, Module )));
537
+ addLocItem extra d.name.loc (LModule (Definition (stamp, Module )));
541
538
addReference stamp d.name.loc);
542
539
file.stamps.values
543
540
|> Hashtbl. iter (fun stamp d ->
544
- addLocation d.name.loc (Typed (d.item, Definition (stamp, Value )));
541
+ addLocItem extra d.name.loc (Typed (d.item, Definition (stamp, Value )));
545
542
addReference stamp d.name.loc);
546
543
file.stamps.types
547
544
|> Hashtbl. iter (fun stamp d ->
548
- addLocation d.name.loc
545
+ addLocItem extra d.name.loc
549
546
(TypeDefinition (d.name.txt, d.item.Type. decl, stamp));
550
547
addReference stamp d.name.loc;
551
548
match d.item.Type. kind with
552
549
| Record labels ->
553
550
labels
554
551
|> List. iter (fun {stamp; fname; typ} ->
555
552
addReference stamp fname.loc;
556
- addLocation fname.loc
553
+ addLocItem extra fname.loc
557
554
(Typed (typ, Definition (d.stamp, Field fname.txt))))
558
555
| Variant constructos ->
559
556
constructos
@@ -571,7 +568,7 @@ let extraForFile ~(file : SharedTypes.file) =
571
568
ref Types. Mnil );
572
569
}
573
570
in
574
- addLocation cname.loc
571
+ addLocItem extra cname.loc
575
572
(Typed (t, Definition (d.stamp, Constructor cname.txt))))
576
573
| _ -> () );
577
574
extra
@@ -684,8 +681,6 @@ struct
684
681
| None -> ()
685
682
| Some relpath -> tracker.used < - (relpath, tip, loc) :: tracker.used)
686
683
687
- let addLocation loc ident = extra.locations < - (loc, ident) :: extra.locations
688
-
689
684
let addReference stamp loc =
690
685
Hashtbl. replace extra.internalReferences stamp
691
686
(loc
@@ -732,7 +727,7 @@ struct
732
727
| None -> NotFound )
733
728
| `GlobalMod _ -> NotFound
734
729
in
735
- addLocation loc (Typed (typ, locType))
730
+ addLocItem extra loc (Typed (typ, locType))
736
731
737
732
let addForPathParent path loc =
738
733
let locType =
@@ -754,7 +749,7 @@ struct
754
749
LModule (LocalReference (stamp, Module ))
755
750
| None -> LModule NotFound )
756
751
in
757
- addLocation loc locType
752
+ addLocItem extra loc locType
758
753
759
754
let getTypeAtPath ~env path =
760
755
match fromCompilerPath ~env path with
@@ -809,7 +804,7 @@ struct
809
804
GlobalReference (moduleName, path, Field name)
810
805
| _ -> NotFound
811
806
in
812
- addLocation nameLoc (Typed (lbl_res, locType))
807
+ addLocItem extra nameLoc (Typed (lbl_res, locType))
813
808
| _ -> ()
814
809
815
810
let addForRecord recordType items =
@@ -837,7 +832,7 @@ struct
837
832
GlobalReference (moduleName, path, Field name)
838
833
| _ -> NotFound
839
834
in
840
- addLocation nameLoc (Typed (lbl_res, locType)))
835
+ addLocItem extra nameLoc (Typed (lbl_res, locType)))
841
836
| _ -> ()
842
837
843
838
let addForConstructor constructorType {Asttypes. txt; loc} {Types. cstr_name} =
@@ -863,7 +858,7 @@ struct
863
858
GlobalReference (moduleName, path, Constructor name)
864
859
| _ -> NotFound
865
860
in
866
- addLocation nameLoc (Typed (constructorType, locType))
861
+ addLocItem extra nameLoc (Typed (constructorType, locType))
867
862
| _ -> ()
868
863
869
864
let currentScopeExtent () =
@@ -973,14 +968,13 @@ struct
973
968
in
974
969
Hashtbl. add Collector. file.stamps.values stamp declared;
975
970
addReference stamp name.loc;
976
- addLocation name.loc
971
+ addLocItem extra name.loc
977
972
(Typed (val_desc.ctyp_type, Definition (stamp, Value ))))
978
973
| _ -> ()
979
974
980
975
let enter_core_type {ctyp_type; ctyp_desc} =
981
976
match ctyp_desc with
982
977
| Ttyp_constr (path , {txt; loc} , _args ) ->
983
- (* addForPath(path, txt, loc, Shared.makeFlexible(ctyp_type), Type) *)
984
978
addForLongident (Some (ctyp_type, Type )) path txt loc
985
979
| _ -> ()
986
980
@@ -1000,7 +994,7 @@ struct
1000
994
in
1001
995
Hashtbl. add Collector. file.stamps.values stamp declared;
1002
996
addReference stamp name.loc;
1003
- addLocation name.loc (Typed (pat_type, Definition (stamp, Value ))))
997
+ addLocItem extra name.loc (Typed (pat_type, Definition (stamp, Value ))))
1004
998
in
1005
999
(* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *)
1006
1000
match pat_desc with
@@ -1035,7 +1029,7 @@ struct
1035
1029
| Overridden (loc , _ ) -> Some (loc, desc, () )
1036
1030
| _ -> None ))
1037
1031
| Texp_constant constant ->
1038
- addLocation expression.exp_loc (Constant constant)
1032
+ addLocItem extra expression.exp_loc (Constant constant)
1039
1033
(* Skip unit and list literals *)
1040
1034
| Texp_construct ({txt = Lident (" ()" | " ::" ); loc}, _, _args)
1041
1035
when loc.loc_end.pos_cnum - loc.loc_start.pos_cnum <> 2 ->
0 commit comments