Make extraction works in submodule.

Author: Tim-ats-d

src/analysis/refactor_extract_region.ml

@@ -370,6 +370,7 @@ let most_inclusive_expr ~start ~stop nodes =
              select_among_child node.Browse_tree.t_env node.t_node)
     in
     let node_loc = Mbrowse.node_loc node in
+
     match node with
     | Expression expr
       when node_loc.loc_ghost = false && is_inside_region node_loc ->
@@ -387,38 +388,42 @@ let most_inclusive_expr ~start ~stop nodes =
          the body of a method. *)
          (remove_poly expr, env))
 
-let find_associated_toplevel_item expr structure =
+let find_associated_toplevel_item expr enclosing =
   Stdlib.List.find_map
-    (fun { Typedtree.str_desc; str_loc; str_env } ->
-      match str_desc with
-      | Tstr_value (rec_flag, vb)
-        when Location_aux.included expr.Typedtree.exp_loc ~into:str_loc ->
-        Some { rec_flag; env = str_env; loc = str_loc; kind = Let vb }
-      | Tstr_class cs ->
-        Stdlib.List.find_map
-          (fun (class_decl, _) ->
-            let loc = class_decl.Typedtree.ci_loc in
-            if Location_aux.included expr.exp_loc ~into:loc then
-              Some
-                { rec_flag = Nonrecursive;
-                  env = str_env;
-                  loc;
-                  kind = Class_decl
-                }
-            else None)
-          cs
+    (fun (_, item) ->
+      match item with
+      | Browse_raw.Structure_item ({ str_desc; str_loc; str_env }, _) -> begin
+        match str_desc with
+        | Tstr_value (rec_flag, vb)
+          when Location_aux.included expr.Typedtree.exp_loc ~into:str_loc ->
+          Some { rec_flag; env = str_env; loc = str_loc; kind = Let vb }
+        | Tstr_class cs ->
+          Stdlib.List.find_map
+            (fun (class_decl, _) ->
+              let loc = class_decl.Typedtree.ci_loc in
+              if Location_aux.included expr.exp_loc ~into:loc then
+                Some
+                  { rec_flag = Nonrecursive;
+                    env = str_env;
+                    loc;
+                    kind = Class_decl
+                  }
+              else None)
+            cs
+        | _ -> None
+      end
       | _ -> None)
-    structure.Typedtree.str_items
+    enclosing
 
-let extract_region ~start ~stop enclosing structure =
+let extract_region ~start ~stop enclosing =
   let open Option.Infix in
   most_inclusive_expr ~start ~stop enclosing >>= fun (expr, expr_env) ->
   (* si contenu de l'expr contient une expression local alors inextrayable *)
-  find_associated_toplevel_item expr structure >>| fun toplevel_item ->
+  find_associated_toplevel_item expr enclosing >>| fun toplevel_item ->
   (expr, expr_env, toplevel_item)
 
-let is_region_extractable ~start ~stop enclosing structure =
-  match extract_region ~start ~stop enclosing structure with
+let is_region_extractable ~start ~stop enclosing =
+  match extract_region ~start ~stop enclosing with
   | None -> false
   | Some _ -> true
 
@@ -429,7 +434,7 @@ let substitute ~start ~stop ?extract_name buffer typedtree =
     let enclosing =
       Mbrowse.enclosing start [ Mbrowse.of_structure structure ]
     in
-    match extract_region ~start ~stop enclosing structure with
+    match extract_region ~start ~stop enclosing with
     | None -> raise Nothing_to_do
     | Some (expr, expr_env, toplevel_item) -> begin
       match expr.exp_desc with

src/analysis/refactor_extract_region.mli

@@ -90,7 +90,6 @@ val is_region_extractable :
   start:Lexing.position ->
   stop:Lexing.position ->
   (Env.t * Browse_raw.node) list ->
-  Typedtree.structure ->
   bool
 
 (** [substitute ~start ~stop ~extract_name buffer typedtree] tries to

tests/test-dirs/refactor-extract-region/func-extraction.t/func.ml

@@ -143,4 +143,16 @@ let f x =
     end
     let z = 0
   end in
-  x * M.z * M.MM.y + A.a
+  (x * M.z * M.MM.y) + A.a
+
+module T = struct
+  let on_list x = x + 1
+  let k : (int, int) Result.t = Ok 10
+  let r = Ok 10
+
+  let x =
+    let a_list = List.map on_list [ 1; 2; 3 ] in
+    let open Format in
+    let printer = pp_print_list pp_print_int in
+    printf "%a\n" printer a_list
+end

tests/test-dirs/refactor-extract-region/func-extraction.t/run.t

@@ -763,3 +763,68 @@ TODO: This extraction shouldn't be allowed.
     },
     "notifications": []
   }
+
+  $ $MERLIN single refactoring-extract-region -start 154:17 -end 154:45 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 153,
+        "col": 2
+      },
+      "end": {
+        "line": 157,
+        "col": 32
+      },
+      "content": "let fun_name2 () = List.map on_list [1; 2; 3]
+  let x =
+      let a_list = (fun_name2 ()) in
+      let open Format in
+      let printer = pp_print_list pp_print_int in
+      printf \"%a\
+  \" printer a_list",
+      "selection-range": {
+        "start": {
+          "line": 153,
+          "col": 4
+        },
+        "end": {
+          "line": 153,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+  $ $MERLIN single refactoring-extract-region -start 154:18 -end 154:44 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 153,
+        "col": 2
+      },
+      "end": {
+        "line": 157,
+        "col": 32
+      },
+      "content": "let fun_name2 () = on_list
+  let x =
+      let a_list = List.map (fun_name2 ()) [ 1; 2; 3 ] in
+      let open Format in
+      let printer = pp_print_list pp_print_int in
+      printf \"%a\
+  \" printer a_list",
+      "selection-range": {
+        "start": {
+          "line": 153,
+          "col": 4
+        },
+        "end": {
+          "line": 153,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }