diff --git a/src/analysis/construct.ml b/src/analysis/construct.ml index b99b8cc53..3af7fa775 100644 --- a/src/analysis/construct.ml +++ b/src/analysis/construct.ml @@ -340,11 +340,11 @@ module Gen = struct match label with | Labelled s | Optional s -> (* Pun for labelled arguments *) - make_param label (Ast_helper.Pat.var ( Location.mknoloc s)), s + make_param label (Ast_helper.Pat.var (Location.mknoloc s)), s | Nolabel -> begin match get_desc ty with | Tconstr (path, _, _) -> let name = uniq_name env (Path.last path) in - make_param label (Ast_helper.Pat.var ( Location.mknoloc name)), name + make_param label (Ast_helper.Pat.var (Location.mknoloc name)), name | _ -> make_param label (Ast_helper.Pat.any ()), "_" end in diff --git a/src/analysis/env_lookup.ml b/src/analysis/env_lookup.ml index e51a2ad96..929ee982b 100644 --- a/src/analysis/env_lookup.ml +++ b/src/analysis/env_lookup.ml @@ -34,7 +34,7 @@ type item = { namespace: Shape.Sig_component_kind.t } -let loc path (namespace : Namespace.t) env = +let by_path path (namespace : Namespace.t) env = try let loc, uid, (namespace : Namespace.t) = match namespace with @@ -56,7 +56,6 @@ let loc path (namespace : Namespace.t) env = | Class_type -> let clty = Env.find_cltype path env in clty.clty_loc, clty.clty_uid, Class - in Some { uid; loc; namespace } with @@ -82,7 +81,7 @@ let path_and_loc_from_label desc env = path, typ_decl.Types.type_loc | _ -> assert false -let in_namespaces (nss : Namespace.inferred list) ident env = +let by_longident (nss : Namespace.inferred list) ident env = let open Shape.Sig_component_kind in try List.iter nss ~f:(fun namespace -> diff --git a/src/analysis/env_lookup.mli b/src/analysis/env_lookup.mli index 41e070fa0..cca3499e5 100644 --- a/src/analysis/env_lookup.mli +++ b/src/analysis/env_lookup.mli @@ -1,38 +1,48 @@ +(** Provides tools to lookup items in the typing environment. + + Establishing the namespace of an item before looking it up in the environement + is necessary to prevent mixing items which have the same name but are not of + the same namespace. (For example the environment can contain both type named + `t` and a value named `t`.) *) + +(** Namespaces describe in which section of the environment an item should be + looked for. *) module Namespace : sig - type t = Shape.Sig_component_kind.t - - val to_string : t -> string - - type under_type = [ `Constr | `Labels ] - type inferred_basic = - [ `Constr | `Labels | `Mod | `Modtype | `Type | `Vals ] - type inferred = - [ `Constr - | `Labels - | `Mod - | `Modtype - | `This_cstr of Types.constructor_description - | `This_label of Types.label_description - | `Type - | `Vals ] - - val from_context : Context.t -> inferred list - end - - type item = { - uid: Shape.Uid.t; - loc: Location.t; - namespace: Namespace.t - } - - val loc - : Path.t - -> Namespace.t - -> Env.t - -> item option - - val in_namespaces - : Namespace.inferred list - -> Longident.t - -> Env.t - -> (Path.t * item) option + type t = Shape.Sig_component_kind.t + + val to_string : t -> string + + type under_type = [ `Constr | `Labels ] + type inferred_basic = + [ `Constr | `Labels | `Mod | `Modtype | `Type | `Vals ] + type inferred = + [ `Constr + | `Labels + | `Mod + | `Modtype + | `This_cstr of Types.constructor_description + | `This_label of Types.label_description + | `Type + | `Vals ] + + (** Returns potential namespaces given the context of an expression *) + val from_context : Context.t -> inferred list +end + +type item = { + uid: Shape.Uid.t; + loc: Location.t; + namespace: Namespace.t +} + +val by_path + : Path.t + -> Namespace.t + -> Env.t + -> item option + +val by_longident + : Namespace.inferred list + -> Longident.t + -> Env.t + -> (Path.t * item) option diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index c795e4083..ac5cfabf6 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -652,13 +652,13 @@ let from_longident ~config ~env ~local_defs nss ident = try String.concat ~sep:"." (Longident.flatten ident) with _-> "Not a flat longident" in - match Env_lookup.in_namespaces nss ident env with + match Env_lookup.by_longident nss ident env with | None -> `Not_in_env str_ident | Some (path, decl) -> from_path ~config ~env ~local_defs ~decl path let from_path ~config ~env ~local_defs ~namespace path = File_switching.reset (); - match Env_lookup.loc path namespace env with + match Env_lookup.by_path path namespace env with | None -> `Not_in_env (Path.name path) | Some decl -> from_path ~config ~env ~local_defs ~decl path diff --git a/src/analysis/misc_utils.mli b/src/analysis/misc_utils.mli index d9baf0a72..c22829993 100644 --- a/src/analysis/misc_utils.mli +++ b/src/analysis/misc_utils.mli @@ -23,5 +23,5 @@ end (* Add parenthesis to qualified operators *) val parenthesize_name : string -> string -(** Extracts the loc from cmt's cmt_uid_to_decl tables *) +(** Extracts the location of a [uid] from a [Typedtree.item_declaration] *) val loc_of_decl : uid:Shape.Uid.t -> Typedtree.item_declaration -> string Location.loc option diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index edb205c97..34b51bd33 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -23,7 +23,7 @@ let decl_of_path_or_lid env namespace path lid = | {lbl_uid; lbl_loc; _ } -> Some { Env_lookup.uid = lbl_uid; loc = lbl_loc; namespace } end - | _ -> Env_lookup.loc path namespace env + | _ -> Env_lookup.by_path path namespace env let index_buffer_ ~current_buffer_path ~local_defs () = let {Logger. log} = Logger.for_section "index" in diff --git a/src/analysis/tail_analysis.ml b/src/analysis/tail_analysis.ml index 2b9891483..d05e2ac37 100644 --- a/src/analysis/tail_analysis.ml +++ b/src/analysis/tail_analysis.ml @@ -74,7 +74,8 @@ let tail_positions = function (* If the expression is a function, return all of its entry-points (which are in tail-positions). Returns an empty list otherwise *) let expr_entry_points = function - (* TODO UPGRADE *) + (* FIXME This was broken with the upgrade to 5.2 + It seems like that feature was already broket before that upgrade. *) (* | Texp_function (cases, _) -> List.map cases ~f:(fun c -> Case c) *) | _ -> [] diff --git a/tests/test-dirs/type-enclosing/te-tail.t b/tests/test-dirs/type-enclosing/te-tail.t new file mode 100644 index 000000000..75a7d40f6 --- /dev/null +++ b/tests/test-dirs/type-enclosing/te-tail.t @@ -0,0 +1,11 @@ + $ cat >test.ml < let rec rev acc = function + > | [] -> acc + > | hd :: tl -> rev (hd::acc) tl + > + > let _ = rev [] + > EOF + + $ $MERLIN single type-enclosing -position 2:12 \ + > -filename test.ml < test.ml | + > jq '.value' diff --git a/tests/test-dirs/type-enclosing/underscore-ids.t b/tests/test-dirs/type-enclosing/underscore-ids.t index 97eb6eb78..ba304a318 100644 --- a/tests/test-dirs/type-enclosing/underscore-ids.t +++ b/tests/test-dirs/type-enclosing/underscore-ids.t @@ -282,7 +282,6 @@ We try several places in the identifier to check the result stability } 3.1 -FIXME UPGRADE 5.2: there is something wrong with the recovery here $ $MERLIN single type-enclosing -position 5:10 -filename under.ml < let aa = 4.2 > let f (x) : int = function @@ -332,84 +331,3 @@ FIXME UPGRADE 5.2: there is something wrong with the recovery here ], "notifications": [] } - - $ $MERLIN single dump -what typedtree -filename under.ml < let aa = 4.2 - > let f (x) : int = function - > | None -> 3 - > | Some 5 -> 4 - > | Some _aa -> 4 - > EOF - { - "class": "return", - "value": "[ - structure_item (under.ml[1,0+0]..under.ml[1,0+12]) - Tstr_value Nonrec - [ - - pattern (under.ml[1,0+4]..under.ml[1,0+6]) - Tpat_var \"aa/276\" - expression (under.ml[1,0+9]..under.ml[1,0+12]) - Texp_constant Const_float 4.2 - ] - structure_item (under.ml[2,13+0]..under.ml[5,70+17]) - Tstr_value Nonrec - [ - - pattern (under.ml[2,13+4]..under.ml[2,13+5]) - Tpat_var \"f/277\" - expression (under.ml[2,13+6]..under.ml[5,70+17]) ghost - Texp_function - [ - Nolabel - Param_pat - pattern (under.ml[2,13+6]..under.ml[2,13+9]) - Tpat_var \"x/279\" - ] - Tfunction_cases (under.ml[2,13+18]..under.ml[5,70+17]) - Texp_constraint - core_type (under.ml[2,13+12]..under.ml[2,13+15]) - Ttyp_constr \"int/1!\" - [] - [ - - pattern (under.ml[3,40+4]..under.ml[3,40+8]) - Tpat_construct \"None\" - [] - None - expression (under.ml[3,40+12]..under.ml[3,40+13]) - attribute \"merlin.loc\" - [] - Texp_constant Const_int 3 - - pattern (under.ml[4,54+4]..under.ml[4,54+10]) - Tpat_construct \"Some\" - [ - pattern (under.ml[4,54+9]..under.ml[4,54+10]) - Tpat_constant Const_int 5 - ] - None - expression (under.ml[4,54+14]..under.ml[4,54+15]) - attribute \"merlin.loc\" - [] - Texp_constant Const_int 4 - - pattern (under.ml[5,70+4]..under.ml[5,70+12]) - Tpat_construct \"Some\" - [ - pattern (under.ml[5,70+9]..under.ml[5,70+12]) - Tpat_var \"_aa/280\" - ] - None - expression (under.ml[5,70+16]..under.ml[5,70+17]) - attribute \"merlin.loc\" - [] - Texp_constant Const_int 4 - ] - ] - ] - - - ", - "notifications": [] - }