Skip to content

Commit 5cd2754

Browse files
nojafnojaf
committed
Extract cmt helper to ProcessCmt
1 parent 5f1e834 commit 5cd2754

2 files changed

Lines changed: 77 additions & 77 deletions

File tree

‎analysis/src/CompletionBackEnd.ml‎

Lines changed: 3 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -756,78 +756,6 @@ let getCompletionsForPath ~debug ~opens ~full ~pos ~exact ~scope
756756
findAllCompletions ~env ~prefix ~exact ~namesUsed ~completionContext
757757
| None -> []))
758758

759-
(* Collect exception constructor names from cmt infos. *)
760-
let exceptions_from_cmt_infos (infos : Cmt_format.cmt_infos) :
761-
(string * bool) list =
762-
let by_name : (string, bool) Hashtbl.t = Hashtbl.create 16 in
763-
let add_ext (ext : Typedtree.extension_constructor) : unit =
764-
let name = ext.ext_name.txt in
765-
let hasArgs =
766-
match ext.ext_kind with
767-
| Text_decl (Cstr_tuple args, _ret) -> args <> []
768-
| Text_decl (Cstr_record fields, _ret) -> fields <> []
769-
| Text_rebind _ -> true
770-
in
771-
let prev =
772-
match Hashtbl.find_opt by_name name with
773-
| Some b -> b
774-
| None -> false
775-
in
776-
Hashtbl.replace by_name name (prev || hasArgs)
777-
in
778-
(* Only collect top-level exception declarations (Tstr_exception/Tsig_exception).
779-
Avoid picking up exceptions from Texp_letexception by tracking context. *)
780-
let in_toplevel_exception = ref false in
781-
let module Iter = TypedtreeIter.MakeIterator (struct
782-
include TypedtreeIter.DefaultIteratorArgument
783-
784-
let enter_structure_item (item : Typedtree.structure_item) =
785-
(match item.str_desc with
786-
| Tstr_exception _ -> in_toplevel_exception := true
787-
| _ -> ());
788-
()
789-
790-
let leave_structure_item (_ : Typedtree.structure_item) =
791-
in_toplevel_exception := false
792-
793-
let enter_signature_item (item : Typedtree.signature_item) =
794-
(match item.sig_desc with
795-
| Tsig_exception _ -> in_toplevel_exception := true
796-
| _ -> ());
797-
()
798-
799-
let leave_signature_item (_ : Typedtree.signature_item) =
800-
in_toplevel_exception := false
801-
802-
let enter_extension_constructor (ext : Typedtree.extension_constructor) =
803-
if !in_toplevel_exception then add_ext ext
804-
end) in
805-
let () =
806-
match infos.cmt_annots with
807-
| Cmt_format.Implementation s -> Iter.iter_structure s
808-
| Interface s -> Iter.iter_signature s
809-
| Partial_implementation parts ->
810-
Array.iter
811-
(function
812-
| Cmt_format.Partial_structure s -> Iter.iter_structure s
813-
| Partial_structure_item si -> Iter.iter_structure_item si
814-
| Partial_signature s -> Iter.iter_signature s
815-
| Partial_signature_item si -> Iter.iter_signature_item si
816-
| _ -> ())
817-
parts
818-
| Partial_interface parts ->
819-
Array.iter
820-
(function
821-
| Cmt_format.Partial_structure s -> Iter.iter_structure s
822-
| Partial_structure_item si -> Iter.iter_structure_item si
823-
| Partial_signature s -> Iter.iter_signature s
824-
| Partial_signature_item si -> Iter.iter_signature_item si
825-
| _ -> ())
826-
parts
827-
| _ -> ()
828-
in
829-
Hashtbl.fold (fun name hasArgs acc -> (name, hasArgs) :: acc) by_name []
830-
831759
(* Predefined Stdlib/Pervasives exceptions. *)
832760
let predefined_exceptions : (string * bool) list =
833761
[
@@ -840,17 +768,15 @@ let predefined_exceptions : (string * bool) list =
840768
]
841769

842770
let completionsForThrow ~(env : QueryEnv.t) ~full =
843-
let exn_typ = Ctype.newconstr Predef.path_exn [] in
771+
let exn_typ = Predef.type_exn in
844772
let names_from_cmt =
845773
let moduleName = env.file.moduleName in
846774
match Hashtbl.find_opt full.package.pathsForModule moduleName with
847775
| None -> []
848-
| Some paths -> (
776+
| Some paths ->
849777
let uri = getUri paths in
850778
let cmt_path = getCmtPath ~uri paths in
851-
match Shared.tryReadCmt cmt_path with
852-
| None -> []
853-
| Some infos -> exceptions_from_cmt_infos infos)
779+
ProcessCmt.exceptionsForCmt ~cmt:cmt_path
854780
in
855781
let all = names_from_cmt @ predefined_exceptions in
856782
all

‎analysis/src/ProcessCmt.ml‎

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -793,3 +793,77 @@ let fileForModule moduleName ~package =
793793
| None ->
794794
Log.log ("No path for module " ^ moduleName);
795795
None
796+
797+
(* Collect top-level exception constructors from typedtree/CMT file. *)
798+
let exceptionsForCmt ~cmt : (string * bool) list =
799+
match Shared.tryReadCmt cmt with
800+
| None -> []
801+
| Some infos ->
802+
let by_name : (string, bool) Hashtbl.t = Hashtbl.create 16 in
803+
let add_ext (ext : Typedtree.extension_constructor) : unit =
804+
let name = ext.ext_name.txt in
805+
let hasArgs =
806+
match ext.ext_kind with
807+
| Text_decl (Cstr_tuple args, _ret) -> args <> []
808+
| Text_decl (Cstr_record fields, _ret) -> fields <> []
809+
| Text_rebind _ -> true
810+
in
811+
let prev =
812+
match Hashtbl.find_opt by_name name with
813+
| Some b -> b
814+
| None -> false
815+
in
816+
Hashtbl.replace by_name name (prev || hasArgs)
817+
in
818+
(* Only collect top-level exception declarations (Tstr_exception/Tsig_exception).
819+
Avoid picking up exceptions from Texp_letexception by tracking context. *)
820+
let in_toplevel_exception = ref false in
821+
let module Iter = TypedtreeIter.MakeIterator (struct
822+
include TypedtreeIter.DefaultIteratorArgument
823+
824+
let enter_structure_item (item : Typedtree.structure_item) =
825+
(match item.str_desc with
826+
| Tstr_exception _ -> in_toplevel_exception := true
827+
| _ -> ());
828+
()
829+
830+
let leave_structure_item (_ : Typedtree.structure_item) =
831+
in_toplevel_exception := false
832+
833+
let enter_signature_item (item : Typedtree.signature_item) =
834+
(match item.sig_desc with
835+
| Tsig_exception _ -> in_toplevel_exception := true
836+
| _ -> ());
837+
()
838+
839+
let leave_signature_item (_ : Typedtree.signature_item) =
840+
in_toplevel_exception := false
841+
842+
let enter_extension_constructor (ext : Typedtree.extension_constructor) =
843+
if !in_toplevel_exception then add_ext ext
844+
end) in
845+
let () =
846+
match infos.cmt_annots with
847+
| Cmt_format.Implementation s -> Iter.iter_structure s
848+
| Interface s -> Iter.iter_signature s
849+
| Partial_implementation parts ->
850+
Array.iter
851+
(function
852+
| Cmt_format.Partial_structure s -> Iter.iter_structure s
853+
| Partial_structure_item si -> Iter.iter_structure_item si
854+
| Partial_signature s -> Iter.iter_signature s
855+
| Partial_signature_item si -> Iter.iter_signature_item si
856+
| _ -> ())
857+
parts
858+
| Partial_interface parts ->
859+
Array.iter
860+
(function
861+
| Cmt_format.Partial_structure s -> Iter.iter_structure s
862+
| Partial_structure_item si -> Iter.iter_structure_item si
863+
| Partial_signature s -> Iter.iter_signature s
864+
| Partial_signature_item si -> Iter.iter_signature_item si
865+
| _ -> ())
866+
parts
867+
| _ -> ()
868+
in
869+
Hashtbl.fold (fun name hasArgs acc -> (name, hasArgs) :: acc) by_name []

0 commit comments

Comments
 (0)