@@ -626,78 +626,72 @@ let fromCompilerPath ~(env : QueryEnv.t) path =
626
626
| Some (`Local (env , name )) -> `Exported (env, name)
627
627
| Some (`Global (moduleName , fullPath )) -> `Global (moduleName, fullPath))
628
628
629
- let getIterator (extra : extra ) (file : File.t ) =
630
- let addExternalReference moduleName path tip loc =
631
- (* TODO need to follow the path, and be able to load the files to follow module references... *)
632
- Hashtbl. replace extra.externalReferences moduleName
633
- ((path, tip, loc)
634
- ::
635
- (if Hashtbl. mem extra.externalReferences moduleName then
636
- Hashtbl. find extra.externalReferences moduleName
637
- else [] ))
638
- in
629
+ let addExternalReference ~extra moduleName path tip loc =
630
+ (* TODO need to follow the path, and be able to load the files to follow module references... *)
631
+ Hashtbl. replace extra.externalReferences moduleName
632
+ ((path, tip, loc)
633
+ ::
634
+ (if Hashtbl. mem extra.externalReferences moduleName then
635
+ Hashtbl. find extra.externalReferences moduleName
636
+ else [] ))
639
637
640
- let addFileReference moduleName loc =
641
- let newLocs =
642
- match Hashtbl. find_opt extra.fileReferences moduleName with
643
- | Some oldLocs -> LocationSet. add loc oldLocs
644
- | None -> LocationSet. singleton loc
645
- in
646
- Hashtbl. replace extra.fileReferences moduleName newLocs
638
+ let addFileReference ~extra moduleName loc =
639
+ let newLocs =
640
+ match Hashtbl. find_opt extra.fileReferences moduleName with
641
+ | Some oldLocs -> LocationSet. add loc oldLocs
642
+ | None -> LocationSet. singleton loc
647
643
in
644
+ Hashtbl. replace extra.fileReferences moduleName newLocs
648
645
649
- let env = QueryEnv. fromFile file in
650
-
651
- let addForPath path lident loc typ tip =
652
- let identName = Longident. last lident in
653
- let identLoc = Utils. endOfLocation loc (String. length identName) in
654
- let locType =
655
- match fromCompilerPath ~env path with
656
- | `Stamp stamp ->
646
+ let addForPath ~env ~extra path lident loc typ tip =
647
+ let identName = Longident. last lident in
648
+ let identLoc = Utils. endOfLocation loc (String. length identName) in
649
+ let locType =
650
+ match fromCompilerPath ~env path with
651
+ | `Stamp stamp ->
652
+ addReference ~extra stamp identLoc;
653
+ LocalReference (stamp, tip)
654
+ | `Not_found -> NotFound
655
+ | `Global (moduleName , path ) ->
656
+ addExternalReference ~extra moduleName path tip identLoc;
657
+ GlobalReference (moduleName, path, tip)
658
+ | `Exported (env , name ) -> (
659
+ match
660
+ match tip with
661
+ | Type -> Exported. find env.exported Exported. Type name
662
+ | _ -> Exported. find env.exported Exported. Value name
663
+ with
664
+ | Some stamp ->
657
665
addReference ~extra stamp identLoc;
658
666
LocalReference (stamp, tip)
659
- | `Not_found -> NotFound
660
- | `Global (moduleName , path ) ->
661
- addExternalReference moduleName path tip identLoc;
662
- GlobalReference (moduleName, path, tip)
663
- | `Exported (env , name ) -> (
664
- match
665
- match tip with
666
- | Type -> Exported. find env.exported Exported. Type name
667
- | _ -> Exported. find env.exported Exported. Value name
668
- with
669
- | Some stamp ->
670
- addReference ~extra stamp identLoc;
671
- LocalReference (stamp, tip)
672
- | None -> NotFound )
673
- | `GlobalMod _ -> NotFound
674
- in
675
- addLocItem extra loc (Typed (identName, typ, locType))
667
+ | None -> NotFound )
668
+ | `GlobalMod _ -> NotFound
676
669
in
670
+ addLocItem extra loc (Typed (identName, typ, locType))
677
671
678
- let addForPathParent path loc =
679
- let locType =
680
- match fromCompilerPath ~env path with
681
- | `GlobalMod moduleName ->
682
- addFileReference moduleName loc;
683
- TopLevelModule moduleName
684
- | `Stamp stamp ->
672
+ let addForPathParent ~env ~extra path loc =
673
+ let locType =
674
+ match fromCompilerPath ~env path with
675
+ | `GlobalMod moduleName ->
676
+ addFileReference ~extra moduleName loc;
677
+ TopLevelModule moduleName
678
+ | `Stamp stamp ->
679
+ addReference ~extra stamp loc;
680
+ LModule (LocalReference (stamp, Module ))
681
+ | `Not_found -> LModule NotFound
682
+ | `Global (moduleName , path ) ->
683
+ addExternalReference ~extra moduleName path Module loc;
684
+ LModule (GlobalReference (moduleName, path, Module ))
685
+ | `Exported (env , name ) -> (
686
+ match Exported. find env.exported Exported. Module name with
687
+ | Some stamp ->
685
688
addReference ~extra stamp loc;
686
689
LModule (LocalReference (stamp, Module ))
687
- | `Not_found -> LModule NotFound
688
- | `Global (moduleName , path ) ->
689
- addExternalReference moduleName path Module loc;
690
- LModule (GlobalReference (moduleName, path, Module ))
691
- | `Exported (env , name ) -> (
692
- match Exported. find env.exported Exported. Module name with
693
- | Some stamp ->
694
- addReference ~extra stamp loc;
695
- LModule (LocalReference (stamp, Module ))
696
- | None -> LModule NotFound )
697
- in
698
- addLocItem extra loc locType
690
+ | None -> LModule NotFound )
699
691
in
692
+ addLocItem extra loc locType
700
693
694
+ let getIterator ~env ~(extra : extra ) ~(file : File.t ) =
701
695
let getTypeAtPath ~env path =
702
696
match fromCompilerPath ~env path with
703
697
| `GlobalMod _ -> `Not_found
@@ -740,7 +734,7 @@ let getIterator (extra : extra) (file : File.t) =
740
734
LocalReference (stamp, Field name)
741
735
| None -> NotFound )
742
736
| `Global (moduleName , path ) ->
743
- addExternalReference moduleName path (Field name) nameLoc;
737
+ addExternalReference ~extra moduleName path (Field name) nameLoc;
744
738
GlobalReference (moduleName, path, Field name)
745
739
| _ -> NotFound
746
740
in
@@ -768,7 +762,8 @@ let getIterator (extra : extra) (file : File.t) =
768
762
LocalReference (stamp, Field name)
769
763
| None -> NotFound )
770
764
| `Global (moduleName , path ) ->
771
- addExternalReference moduleName path (Field name) nameLoc;
765
+ addExternalReference ~extra moduleName path (Field name)
766
+ nameLoc;
772
767
GlobalReference (moduleName, path, Field name)
773
768
| _ -> NotFound
774
769
in
@@ -794,7 +789,7 @@ let getIterator (extra : extra) (file : File.t) =
794
789
LocalReference (stamp, Constructor name)
795
790
| None -> NotFound )
796
791
| `Global (moduleName , path ) ->
797
- addExternalReference moduleName path (Constructor name) nameLoc;
792
+ addExternalReference ~extra moduleName path (Constructor name) nameLoc;
798
793
GlobalReference (moduleName, path, Constructor name)
799
794
| _ -> NotFound
800
795
in
@@ -818,13 +813,13 @@ let getIterator (extra : extra) (file : File.t) =
818
813
let isPpx = idLength <> reportedLength in
819
814
if isPpx then
820
815
match top with
821
- | Some (t , tip ) -> addForPath path txt loc t tip
822
- | None -> addForPathParent path loc
816
+ | Some (t , tip ) -> addForPath ~env ~extra path txt loc t tip
817
+ | None -> addForPathParent ~env ~extra path loc
823
818
else
824
819
let l = Utils. endOfLocation loc (String. length (Longident. last txt)) in
825
820
(match top with
826
- | Some (t , tip ) -> addForPath path txt l t tip
827
- | None -> addForPathParent path l);
821
+ | Some (t , tip ) -> addForPath ~env ~extra path txt l t tip
822
+ | None -> addForPathParent ~env ~extra path l);
828
823
match (path, txt) with
829
824
| Pdot (pinner , _pname , _ ), Ldot (inner , name ) ->
830
825
addForLongident None pinner inner
@@ -1042,7 +1037,8 @@ let fullForCmt ~moduleName ~package ~uri cmt =
1042
1037
| Some infos ->
1043
1038
let file = forCmt ~module Name ~uri infos in
1044
1039
let extra = extraForFile ~file in
1045
- let iterator = getIterator extra file in
1040
+ let env = QueryEnv. fromFile file in
1041
+ let iterator = getIterator ~env ~extra ~file in
1046
1042
extraForCmt ~iterator infos;
1047
1043
Some {file; extra; package}
1048
1044
0 commit comments