Small refactors, added documentation and tests update

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
 

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 ->

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

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
 

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

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

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) *)
   | _ -> []
 

tests/test-dirs/type-enclosing/te-tail.t

@@ -0,0 +1,11 @@
+  $ cat >test.ml <<EOF
+  > 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'

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 <<EOF
   > 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 <<EOF
-  > 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
-      [
-        <def>
-          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
-      [
-        <def>
-          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!\"
-                []
-              [
-                <case>
-                  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
-                <case>
-                  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
-                <case>
-                  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": []
-  }