Skip to content

Commit 9226c38

Browse files
committed
more refactor
1 parent c657167 commit 9226c38

File tree

1 file changed

+65
-69
lines changed

1 file changed

+65
-69
lines changed

analysis/src/ProcessCmt.ml

Lines changed: 65 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -626,78 +626,72 @@ let fromCompilerPath ~(env : QueryEnv.t) path =
626626
| Some (`Local (env, name)) -> `Exported (env, name)
627627
| Some (`Global (moduleName, fullPath)) -> `Global (moduleName, fullPath))
628628

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 []))
639637

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
647643
in
644+
Hashtbl.replace extra.fileReferences moduleName newLocs
648645

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 ->
657665
addReference ~extra stamp identLoc;
658666
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
676669
in
670+
addLocItem extra loc (Typed (identName, typ, locType))
677671

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 ->
685688
addReference ~extra stamp loc;
686689
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)
699691
in
692+
addLocItem extra loc locType
700693

694+
let getIterator ~env ~(extra : extra) ~(file : File.t) =
701695
let getTypeAtPath ~env path =
702696
match fromCompilerPath ~env path with
703697
| `GlobalMod _ -> `Not_found
@@ -740,7 +734,7 @@ let getIterator (extra : extra) (file : File.t) =
740734
LocalReference (stamp, Field name)
741735
| None -> NotFound)
742736
| `Global (moduleName, path) ->
743-
addExternalReference moduleName path (Field name) nameLoc;
737+
addExternalReference ~extra moduleName path (Field name) nameLoc;
744738
GlobalReference (moduleName, path, Field name)
745739
| _ -> NotFound
746740
in
@@ -768,7 +762,8 @@ let getIterator (extra : extra) (file : File.t) =
768762
LocalReference (stamp, Field name)
769763
| None -> NotFound)
770764
| `Global (moduleName, path) ->
771-
addExternalReference moduleName path (Field name) nameLoc;
765+
addExternalReference ~extra moduleName path (Field name)
766+
nameLoc;
772767
GlobalReference (moduleName, path, Field name)
773768
| _ -> NotFound
774769
in
@@ -794,7 +789,7 @@ let getIterator (extra : extra) (file : File.t) =
794789
LocalReference (stamp, Constructor name)
795790
| None -> NotFound)
796791
| `Global (moduleName, path) ->
797-
addExternalReference moduleName path (Constructor name) nameLoc;
792+
addExternalReference ~extra moduleName path (Constructor name) nameLoc;
798793
GlobalReference (moduleName, path, Constructor name)
799794
| _ -> NotFound
800795
in
@@ -818,13 +813,13 @@ let getIterator (extra : extra) (file : File.t) =
818813
let isPpx = idLength <> reportedLength in
819814
if isPpx then
820815
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
823818
else
824819
let l = Utils.endOfLocation loc (String.length (Longident.last txt)) in
825820
(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);
828823
match (path, txt) with
829824
| Pdot (pinner, _pname, _), Ldot (inner, name) ->
830825
addForLongident None pinner inner
@@ -1042,7 +1037,8 @@ let fullForCmt ~moduleName ~package ~uri cmt =
10421037
| Some infos ->
10431038
let file = forCmt ~moduleName ~uri infos in
10441039
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
10461042
extraForCmt ~iterator infos;
10471043
Some {file; extra; package}
10481044

0 commit comments

Comments
 (0)