Skip to content

Commit 0769f30

Browse files
cristianoccristianoc
committed
more cleanup
1 parent 9226c38 commit 0769f30

File tree

1 file changed

+144
-151
lines changed

1 file changed

+144
-151
lines changed

‎analysis/src/ProcessCmt.ml

Lines changed: 144 additions & 151 deletions
Original file line numberDiff line numberDiff line change
@@ -691,165 +691,156 @@ let addForPathParent ~env ~extra path loc =
691691
in
692692
addLocItem extra loc locType
693693

694-
let getIterator ~env ~(extra : extra) ~(file : File.t) =
695-
let getTypeAtPath ~env path =
696-
match fromCompilerPath ~env path with
697-
| `GlobalMod _ -> `Not_found
698-
| `Global (moduleName, path) -> `Global (moduleName, path)
699-
| `Not_found -> `Not_found
700-
| `Exported (env, name) -> (
701-
match Exported.find env.exported Exported.Type name with
702-
| None -> `Not_found
703-
| Some stamp -> (
704-
let declaredType = Stamps.findType env.file.stamps stamp in
705-
match declaredType with
706-
| Some declaredType -> `Local declaredType
707-
| None -> `Not_found))
708-
| `Stamp stamp -> (
694+
let getTypeAtPath ~env path =
695+
match fromCompilerPath ~env path with
696+
| `GlobalMod _ -> `Not_found
697+
| `Global (moduleName, path) -> `Global (moduleName, path)
698+
| `Not_found -> `Not_found
699+
| `Exported (env, name) -> (
700+
match Exported.find env.exported Exported.Type name with
701+
| None -> `Not_found
702+
| Some stamp -> (
709703
let declaredType = Stamps.findType env.file.stamps stamp in
710704
match declaredType with
711705
| Some declaredType -> `Local declaredType
712-
| None -> `Not_found)
713-
in
706+
| None -> `Not_found))
707+
| `Stamp stamp -> (
708+
let declaredType = Stamps.findType env.file.stamps stamp in
709+
match declaredType with
710+
| Some declaredType -> `Local declaredType
711+
| None -> `Not_found)
714712

715-
let handleConstructor txt =
716-
match txt with
717-
| Longident.Lident name -> name
718-
| Ldot (_left, name) -> name
719-
| Lapply (_, _) -> assert false
720-
in
713+
let handleConstructor txt =
714+
match txt with
715+
| Longident.Lident name -> name
716+
| Ldot (_left, name) -> name
717+
| Lapply (_, _) -> assert false
721718

722-
let addForField recordType fieldType {Asttypes.txt; loc} =
723-
match (Shared.dig recordType).desc with
724-
| Tconstr (path, _args, _memo) ->
725-
let t = getTypeAtPath ~env path in
726-
let name = handleConstructor txt in
727-
let nameLoc = Utils.endOfLocation loc (String.length name) in
728-
let locType =
729-
match t with
730-
| `Local {stamp; item = {kind = Record fields}} -> (
731-
match fields |> List.find_opt (fun f -> f.fname.txt = name) with
732-
| Some {stamp = astamp} ->
733-
addReference ~extra astamp nameLoc;
734-
LocalReference (stamp, Field name)
735-
| None -> NotFound)
736-
| `Global (moduleName, path) ->
737-
addExternalReference ~extra moduleName path (Field name) nameLoc;
738-
GlobalReference (moduleName, path, Field name)
739-
| _ -> NotFound
740-
in
741-
addLocItem extra nameLoc (Typed (name, fieldType, locType))
742-
| _ -> ()
743-
in
719+
let addForField ~env ~extra recordType fieldType {Asttypes.txt; loc} =
720+
match (Shared.dig recordType).desc with
721+
| Tconstr (path, _args, _memo) ->
722+
let t = getTypeAtPath ~env path in
723+
let name = handleConstructor txt in
724+
let nameLoc = Utils.endOfLocation loc (String.length name) in
725+
let locType =
726+
match t with
727+
| `Local {stamp; item = {kind = Record fields}} -> (
728+
match fields |> List.find_opt (fun f -> f.fname.txt = name) with
729+
| Some {stamp = astamp} ->
730+
addReference ~extra astamp nameLoc;
731+
LocalReference (stamp, Field name)
732+
| None -> NotFound)
733+
| `Global (moduleName, path) ->
734+
addExternalReference ~extra moduleName path (Field name) nameLoc;
735+
GlobalReference (moduleName, path, Field name)
736+
| _ -> NotFound
737+
in
738+
addLocItem extra nameLoc (Typed (name, fieldType, locType))
739+
| _ -> ()
744740

745-
let addForRecord recordType items =
746-
match (Shared.dig recordType).desc with
747-
| Tconstr (path, _args, _memo) ->
748-
let t = getTypeAtPath ~env path in
749-
items
750-
|> List.iter (fun ({Asttypes.txt; loc}, {Types.lbl_res}, _) ->
751-
(* let name = Longident.last(txt); *)
752-
let name = handleConstructor txt in
753-
let nameLoc = Utils.endOfLocation loc (String.length name) in
754-
let locType =
755-
match t with
756-
| `Local {stamp; item = {kind = Record fields}} -> (
757-
match
758-
fields |> List.find_opt (fun f -> f.fname.txt = name)
759-
with
760-
| Some {stamp = astamp} ->
761-
addReference ~extra astamp nameLoc;
762-
LocalReference (stamp, Field name)
763-
| None -> NotFound)
764-
| `Global (moduleName, path) ->
765-
addExternalReference ~extra moduleName path (Field name)
766-
nameLoc;
767-
GlobalReference (moduleName, path, Field name)
768-
| _ -> NotFound
769-
in
770-
addLocItem extra nameLoc (Typed (name, lbl_res, locType)))
771-
| _ -> ()
772-
in
741+
let addForRecord ~env ~extra recordType items =
742+
match (Shared.dig recordType).desc with
743+
| Tconstr (path, _args, _memo) ->
744+
let t = getTypeAtPath ~env path in
745+
items
746+
|> List.iter (fun ({Asttypes.txt; loc}, {Types.lbl_res}, _) ->
747+
(* let name = Longident.last(txt); *)
748+
let name = handleConstructor txt in
749+
let nameLoc = Utils.endOfLocation loc (String.length name) in
750+
let locType =
751+
match t with
752+
| `Local {stamp; item = {kind = Record fields}} -> (
753+
match fields |> List.find_opt (fun f -> f.fname.txt = name) with
754+
| Some {stamp = astamp} ->
755+
addReference ~extra astamp nameLoc;
756+
LocalReference (stamp, Field name)
757+
| None -> NotFound)
758+
| `Global (moduleName, path) ->
759+
addExternalReference ~extra moduleName path (Field name) nameLoc;
760+
GlobalReference (moduleName, path, Field name)
761+
| _ -> NotFound
762+
in
763+
addLocItem extra nameLoc (Typed (name, lbl_res, locType)))
764+
| _ -> ()
773765

774-
let addForConstructor constructorType {Asttypes.txt; loc} {Types.cstr_name} =
775-
match (Shared.dig constructorType).desc with
776-
| Tconstr (path, _args, _memo) ->
777-
let name = handleConstructor txt in
778-
let nameLoc = Utils.endOfLocation loc (String.length name) in
779-
let t = getTypeAtPath ~env path in
780-
let locType =
781-
match t with
782-
| `Local {stamp; item = {kind = Variant constructors}} -> (
783-
match
784-
constructors
785-
|> List.find_opt (fun c -> c.Constructor.cname.txt = cstr_name)
786-
with
787-
| Some {stamp = cstamp} ->
788-
addReference ~extra cstamp nameLoc;
789-
LocalReference (stamp, Constructor name)
790-
| None -> NotFound)
791-
| `Global (moduleName, path) ->
792-
addExternalReference ~extra moduleName path (Constructor name) nameLoc;
793-
GlobalReference (moduleName, path, Constructor name)
794-
| _ -> NotFound
795-
in
796-
addLocItem extra nameLoc (Typed (name, constructorType, locType))
797-
| _ -> ()
798-
in
766+
let addForConstructor ~env ~extra constructorType {Asttypes.txt; loc}
767+
{Types.cstr_name} =
768+
match (Shared.dig constructorType).desc with
769+
| Tconstr (path, _args, _memo) ->
770+
let name = handleConstructor txt in
771+
let nameLoc = Utils.endOfLocation loc (String.length name) in
772+
let t = getTypeAtPath ~env path in
773+
let locType =
774+
match t with
775+
| `Local {stamp; item = {kind = Variant constructors}} -> (
776+
match
777+
constructors
778+
|> List.find_opt (fun c -> c.Constructor.cname.txt = cstr_name)
779+
with
780+
| Some {stamp = cstamp} ->
781+
addReference ~extra cstamp nameLoc;
782+
LocalReference (stamp, Constructor name)
783+
| None -> NotFound)
784+
| `Global (moduleName, path) ->
785+
addExternalReference ~extra moduleName path (Constructor name) nameLoc;
786+
GlobalReference (moduleName, path, Constructor name)
787+
| _ -> NotFound
788+
in
789+
addLocItem extra nameLoc (Typed (name, constructorType, locType))
790+
| _ -> ()
799791

800-
let rec lidIsComplex (lid : Longident.t) =
801-
match lid with
802-
| Lapply _ -> true
803-
| Ldot (lid, _) -> lidIsComplex lid
804-
| _ -> false
805-
in
792+
let rec lidIsComplex (lid : Longident.t) =
793+
match lid with
794+
| Lapply _ -> true
795+
| Ldot (lid, _) -> lidIsComplex lid
796+
| _ -> false
806797

807-
let rec addForLongident top (path : Path.t) (txt : Longident.t) loc =
808-
if (not loc.Location.loc_ghost) && not (lidIsComplex txt) then (
809-
let idLength =
810-
String.length (String.concat "." (Longident.flatten txt))
811-
in
812-
let reportedLength = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum in
813-
let isPpx = idLength <> reportedLength in
814-
if isPpx then
815-
match top with
816-
| Some (t, tip) -> addForPath ~env ~extra path txt loc t tip
817-
| None -> addForPathParent ~env ~extra path loc
818-
else
819-
let l = Utils.endOfLocation loc (String.length (Longident.last txt)) in
820-
(match top with
821-
| Some (t, tip) -> addForPath ~env ~extra path txt l t tip
822-
| None -> addForPathParent ~env ~extra path l);
823-
match (path, txt) with
824-
| Pdot (pinner, _pname, _), Ldot (inner, name) ->
825-
addForLongident None pinner inner
826-
(Utils.chopLocationEnd loc (String.length name + 1))
827-
| Pident _, Lident _ -> ()
828-
| _ -> ())
829-
in
798+
let rec addForLongident ~env ~extra top (path : Path.t) (txt : Longident.t) loc
799+
=
800+
if (not loc.Location.loc_ghost) && not (lidIsComplex txt) then (
801+
let idLength = String.length (String.concat "." (Longident.flatten txt)) in
802+
let reportedLength = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum in
803+
let isPpx = idLength <> reportedLength in
804+
if isPpx then
805+
match top with
806+
| Some (t, tip) -> addForPath ~env ~extra path txt loc t tip
807+
| None -> addForPathParent ~env ~extra path loc
808+
else
809+
let l = Utils.endOfLocation loc (String.length (Longident.last txt)) in
810+
(match top with
811+
| Some (t, tip) -> addForPath ~env ~extra path txt l t tip
812+
| None -> addForPathParent ~env ~extra path l);
813+
match (path, txt) with
814+
| Pdot (pinner, _pname, _), Ldot (inner, name) ->
815+
addForLongident ~env ~extra None pinner inner
816+
(Utils.chopLocationEnd loc (String.length name + 1))
817+
| Pident _, Lident _ -> ()
818+
| _ -> ())
830819

831-
let rec handle_module_expr expr =
832-
match expr with
833-
| Tmod_constraint (expr, _, _, _) -> handle_module_expr expr.mod_desc
834-
| Tmod_ident (path, {txt; loc}) ->
835-
if not (lidIsComplex txt) then
836-
Log.log ("Ident!! " ^ String.concat "." (Longident.flatten txt));
837-
addForLongident None path txt loc
838-
| Tmod_functor (_ident, _argName, _maybeType, resultExpr) ->
839-
handle_module_expr resultExpr.mod_desc
840-
| Tmod_apply (obj, arg, _) ->
841-
handle_module_expr obj.mod_desc;
842-
handle_module_expr arg.mod_desc
843-
| _ -> ()
844-
in
820+
let rec handle_module_expr ~env ~extra expr =
821+
match expr with
822+
| Tmod_constraint (expr, _, _, _) ->
823+
handle_module_expr ~env ~extra expr.mod_desc
824+
| Tmod_ident (path, {txt; loc}) ->
825+
if not (lidIsComplex txt) then
826+
Log.log ("Ident!! " ^ String.concat "." (Longident.flatten txt));
827+
addForLongident ~env ~extra None path txt loc
828+
| Tmod_functor (_ident, _argName, _maybeType, resultExpr) ->
829+
handle_module_expr ~env ~extra resultExpr.mod_desc
830+
| Tmod_apply (obj, arg, _) ->
831+
handle_module_expr ~env ~extra obj.mod_desc;
832+
handle_module_expr ~env ~extra arg.mod_desc
833+
| _ -> ()
845834

835+
let getIterator ~env ~(extra : extra) ~(file : File.t) =
846836
let enter_structure_item item =
847837
match item.str_desc with
848-
| Tstr_include {incl_mod = expr} -> handle_module_expr expr.mod_desc
849-
| Tstr_module {mb_expr} -> handle_module_expr mb_expr.mod_desc
838+
| Tstr_include {incl_mod = expr} ->
839+
handle_module_expr ~env ~extra expr.mod_desc
840+
| Tstr_module {mb_expr} -> handle_module_expr ~env ~extra mb_expr.mod_desc
850841
| Tstr_open {open_path; open_txt = {txt; loc}} ->
851842
(* Log.log("Have an open here"); *)
852-
addForLongident None open_path txt loc;
843+
addForLongident ~env ~extra None open_path txt loc;
853844
Hashtbl.replace extra.opens loc ()
854845
| _ -> ()
855846
in
@@ -873,7 +864,7 @@ let getIterator ~env ~(extra : extra) ~(file : File.t) =
873864
let enter_core_type {ctyp_type; ctyp_desc} =
874865
match ctyp_desc with
875866
| Ttyp_constr (path, {txt; loc}, _args) ->
876-
addForLongident (Some (ctyp_type, Type)) path txt loc
867+
addForLongident ~env ~extra (Some (ctyp_type, Type)) path txt loc
877868
| _ -> ()
878869
in
879870

@@ -891,9 +882,9 @@ let getIterator ~env ~(extra : extra) ~(file : File.t) =
891882
in
892883
(* Log.log("Entering pattern " ++ Utils.showLocation(pat_loc)); *)
893884
match pat_desc with
894-
| Tpat_record (items, _) -> addForRecord pat_type items
885+
| Tpat_record (items, _) -> addForRecord ~env ~extra pat_type items
895886
| Tpat_construct (lident, constructor, _) ->
896-
addForConstructor pat_type lident constructor
887+
addForConstructor ~env ~extra pat_type lident constructor
897888
| Tpat_alias (_inner, ident, name) ->
898889
let stamp = Ident.binding_time ident in
899890
addForPattern stamp name
@@ -912,9 +903,11 @@ let getIterator ~env ~(extra : extra) ~(file : File.t) =
912903
| _ -> ());
913904
match expression.exp_desc with
914905
| Texp_ident (path, {txt; loc}, _) ->
915-
addForLongident (Some (expression.exp_type, Value)) path txt loc
906+
addForLongident ~env ~extra
907+
(Some (expression.exp_type, Value))
908+
path txt loc
916909
| Texp_record {fields} ->
917-
addForRecord expression.exp_type
910+
addForRecord ~env ~extra expression.exp_type
918911
(fields |> Array.to_list
919912
|> Utils.filterMap (fun (desc, item) ->
920913
match item with
@@ -927,9 +920,9 @@ let getIterator ~env ~(extra : extra) ~(file : File.t) =
927920
when loc.loc_end.pos_cnum - loc.loc_start.pos_cnum <> 2 ->
928921
()
929922
| Texp_construct (lident, constructor, _args) ->
930-
addForConstructor expression.exp_type lident constructor
923+
addForConstructor ~env ~extra expression.exp_type lident constructor
931924
| Texp_field (inner, lident, _label_description) ->
932-
addForField inner.exp_type expression.exp_type lident
925+
addForField ~env ~extra inner.exp_type expression.exp_type lident
933926
| _ -> ()
934927
in
935928

0 commit comments

Comments
 (0)