Merge pull request ocaml#1333 from voodoos/construct-part-I.I-module-holes

Add Module holes to the parser and AST

Author: voodoos

CHANGES.md

@@ -8,6 +8,7 @@ git version
       ocaml/ocaml-lsp#375)
     - fix location of module definitions done via functors (#1329, fixes #1199)
     - fix -cmt-path dirs mistakenly added to build path (#1330)
+    - add new module holes that can replace module expressions (#1333)
 
 merlin 4.2
 ==========

src/analysis/type_enclosing.ml

@@ -24,6 +24,7 @@ let from_nodes ~path =
       ret (Type (env, t))
     | Type_declaration { typ_id = id; typ_type = t} ->
       ret (Type_decl (env, id, t))
+    | Module_expr {mod_type = Types.Mty_for_hole} -> None
     | Module_expr {mod_type = m}
     | Module_type {mty_type = m}
     | Module_binding {mb_expr = {mod_type = m}}

src/analysis/typedtrie.ml

@@ -214,6 +214,7 @@ let remove_indir_me me =
   | Typedtree.Tmod_apply (me1, me2, _) -> `Apply (me1, me2)
   | Typedtree.Tmod_constraint (me, _, _, _) -> `Mod_expr me
   | Typedtree.Tmod_unpack _ -> `Unpack
+  | Typedtree.Tmod_hole -> `Hole
 
 let remove_indir_mty mty =
   match mty.Typedtree.mty_desc with
@@ -287,10 +288,13 @@ let rec build ~local_buffer ~trie browses : t =
       Apply { funct; arg }
     | `Unpack -> (* TODO! *)
       Leaf
+    | `Hole ->
+      Leaf
   and functor_ : _ -> Trie.functor_ = function
     | `Alias path
     | `Ident path -> Named (Namespaced_path.of_path ~namespace:`Mod path)
     | `Str _
+    | `Hole
     | `Sg _ -> assert false
     | `Mod_expr me -> functor_ (remove_indir_me me)
     | `Mod_type _ -> assert false
@@ -380,6 +384,7 @@ let rec build ~local_buffer ~trie browses : t =
           | `Sg  sg ->
             let sg = lazy (build ~local_buffer ~trie [of_signature sg]) in
             f (Included (Items sg))
+          | `Hole -> f Leaf
         in
         helper packed
       end

src/frontend/query_commands.ml

@@ -622,14 +622,25 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
     let verbosity = verbosity pipeline in
     let nodes = Mbrowse.of_typedtree (Mtyper.get_typedtree typer) in
     let ppf = Format.str_formatter in
+    let print ~nodes loc env type_ () =
+      match type_ with
+      | `Exp type_expr ->
+        Type_utils.print_type_with_decl ~verbosity env ppf type_expr
+      | `Mod module_type ->
+        (* For module_expr holes we need the type of the next enclosing
+          to get a useful result *)
+        match Mbrowse.enclosing (loc.Location.loc_start) [nodes] with
+        | _ :: (_, Browse_raw.Module_expr { mod_type; _}) :: _ ->
+          Printtyp.modtype env ppf mod_type
+        | _ ->
+          Printtyp.modtype env ppf module_type
+    in
     let loc_and_types_of_holes node =
-      List.map (Browse_raw.all_holes node)
-        ~f:(fun (loc, env, type_expr) ->
+      List.map (Browse_raw.all_holes node) ~f:(
+        fun (loc, env, type_) ->
           Printtyp.wrap_printing_env env ~verbosity
-            (fun () ->
-              Type_utils.print_type_with_decl ~verbosity env ppf type_expr);
-          (loc, Format.flush_str_formatter ())
-        )
+            (print ~nodes loc env type_);
+          (loc, Format.flush_str_formatter ()))
     in
     List.concat_map ~f:loc_and_types_of_holes nodes
 

src/ocaml/merlin_specific/browse_raw.ml

@@ -428,6 +428,7 @@ and of_module_expr_desc = function
     app (Module_type_constraint mtc)
   | Tmod_unpack (e,_) ->
     of_expression e
+  | Tmod_hole -> id_fold
 
 and of_structure_item_desc = function
   | Tstr_eval (e,_) ->
@@ -903,7 +904,14 @@ let all_holes (env, node) =
           exp_type;
           exp_env;
           _
-        } -> (exp_loc, exp_env, exp_type) :: acc
+        } -> (exp_loc, exp_env, `Exp exp_type) :: acc
+      | Module_expr {
+          mod_desc = Tmod_hole;
+          mod_loc;
+          mod_type;
+          mod_env;
+          _
+        } -> (mod_loc, mod_env, `Mod mod_type) :: acc
       | _ -> aux acc (env, node)
     in
     fold_node f env node acc

src/ocaml/merlin_specific/browse_raw.mli

@@ -116,4 +116,8 @@ val node_is_constructor : node ->
 
 val node_of_binary_part : Env.t -> Cmt_format.binary_part -> node
 
-val all_holes : Env.t * node -> (Location.t * Env.t * Types.type_expr) list
+val all_holes :
+  Env.t * node ->
+  (Location.t *
+    Env.t *
+    [`Exp of Types.type_expr | `Mod of Types.module_type]) list

src/ocaml/merlin_specific/typer_raw.ml

@@ -529,6 +529,7 @@ module Rewrite_loc = struct
       Pmod_constraint (u_module_expr me, u_module_type mt)
     | Pmod_unpack e -> Pmod_unpack (u_expression e)
     | Pmod_extension ext -> Pmod_extension (u_extension ext)
+    | Pmod_hole -> Pmod_hole
 
   and u_structure l = List.map ~f:u_structure_item l
 

src/ocaml/parsing/ast_helper.ml

@@ -266,6 +266,7 @@ let mk ?(loc = !default_loc) ?(attrs = []) d =
   let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
   let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
+  let hole ?loc ?attrs () = mk ?loc ?attrs Pmod_hole
 end
 
 module Sig = struct

src/ocaml/parsing/ast_helper.mli

@@ -278,6 +278,7 @@ module Mod:
       module_expr
     val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr
+    val hole: ?loc:loc -> ?attrs:attrs -> unit -> module_expr
   end
 
 (** Signature items *)

src/ocaml/parsing/ast_iterator.ml

@@ -312,6 +312,7 @@ module M = struct
         sub.module_expr sub m; sub.module_type sub mty
     | Pmod_unpack e -> sub.expr sub e
     | Pmod_extension x -> sub.extension sub x
+    | Pmod_hole -> ()
 
   let iter_structure_item sub {pstr_loc = loc; pstr_desc = desc} =
     sub.location sub loc;