diff --git a/CHANGES.md b/CHANGES.md
index 3da1d2499..cf1c19a2f 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,8 @@
 unreleased
 ==========
+
   + merlin library
+    - Implement new refactor-extract-region command for extracting region to a fresh let binding (#1948)
     - Fix `merlin_reader` for OpenBSD (#1956)
 
 merlin 5.5
diff --git a/doc/dev/PROTOCOL.md b/doc/dev/PROTOCOL.md
index a6b86a0ef..bb69c4c94 100644
--- a/doc/dev/PROTOCOL.md
+++ b/doc/dev/PROTOCOL.md
@@ -485,6 +485,25 @@ The result is returned as a list of:
 }
 ```
 
+### `refactor-extract-region -start <position> -end <position> -extract-name <name>`
+
+```
+    -start <position>  Where extracted region start
+    -end <position>  Where extracted region end
+    -extract-name <name>  Name used for the generated let binding
+```
+
+Returns the string `Nothing to do` (if extractor is not ables to select an expression to extract in the given position interval) or the following object:
+
+```javascript
+{
+  'start': position, // the start of the region to be substituted
+  'end': position, // the end of the region to be substituted
+  'content' string, // the content of the substitution
+  'selection_range': location // the location where to position the cursor for easy renaming of the generated let binding 
+}
+```
+
 ### `syntax-document -position <position>`
 
 	-position <position>  The position of the keyword to be documented
diff --git a/src/analysis/parsetree_utils.ml b/src/analysis/parsetree_utils.ml
index 071358601..79f7080c4 100644
--- a/src/analysis/parsetree_utils.ml
+++ b/src/analysis/parsetree_utils.ml
@@ -1,5 +1,21 @@
+open Std
+
 open Parsetree
 
 type nonrec constant_desc = constant_desc
 
 let constant_desc c = c.pconst_desc
+
+let filter_merlin_attr =
+  let default = Ast_mapper.default_mapper in
+  let keep attr =
+    let { Location.txt; _ }, _ = Ast_helper.Attr.as_tuple attr in
+    not (Std.String.is_prefixed ~by:"merlin." txt)
+  in
+  let attributes mapper attrs =
+    default.Ast_mapper.attributes mapper (List.filter ~f:keep attrs)
+  in
+  { default with Ast_mapper.attributes }
+
+let expr_remove_merlin_attributes expr =
+  filter_merlin_attr.Ast_mapper.expr filter_merlin_attr expr
diff --git a/src/analysis/parsetree_utils.mli b/src/analysis/parsetree_utils.mli
index eb5bab8eb..f3b5487f9 100644
--- a/src/analysis/parsetree_utils.mli
+++ b/src/analysis/parsetree_utils.mli
@@ -6,3 +6,6 @@ open Parsetree
 type nonrec constant_desc = constant_desc
 
 val constant_desc : constant -> constant_desc
+
+(** Filter parsetree attributes which are prefixed by ["merlin."] in given expression. *)
+val expr_remove_merlin_attributes : expression -> expression
diff --git a/src/analysis/refactor_extract_region.ml b/src/analysis/refactor_extract_region.ml
new file mode 100644
index 000000000..c2e06bcd2
--- /dev/null
+++ b/src/analysis/refactor_extract_region.ml
@@ -0,0 +1,534 @@
+open Std
+
+exception Nothing_to_do
+exception Not_allowed_in_interface_file
+
+let () =
+  Location.register_error_of_exn (function
+    | Nothing_to_do -> Some (Location.error "Nothing to do")
+    | Not_allowed_in_interface_file ->
+      Some
+        (Location.error
+           "Expression extraction is only allowed in implementation file")
+    | _ -> None)
+
+module Fresh_name = struct
+  (* Generate a fresh name that does not already exist in given environment. *)
+  let gen_val_name ~is_bound basename env =
+    let rec loop n =
+      let guess = basename ^ Int.to_string n in
+      if is_bound guess env then succ n |> loop else guess
+    in
+    loop 1
+
+  let gen_val_name_env = gen_val_name ~is_bound:Env.bound_value
+end
+
+let clean_up_for_printing expr =
+  let mapper =
+    { Ast_mapper.default_mapper with
+      expr =
+        (fun mapper expr ->
+          match expr.pexp_desc with
+          | Pexp_construct
+              ( ident,
+                Some
+                  { pexp_desc =
+                      Pexp_tuple
+                        (_
+                        :: ({ pexp_desc =
+                                Pexp_constant
+                                  { pconst_desc = Pconst_string _; _ };
+                              _
+                            } as const)
+                        :: _);
+                    _
+                  } )
+            when Longident.head ident.txt = "CamlinternalFormatBasics" ->
+            (* We need to retransform format specification which has been desugared into string. *)
+            const
+          | Pexp_poly (expr, _) ->
+            (* We also have to remove poly extra that cause unexpected "!poly!"
+               to be printed in generated code. This happens when you try
+               to extract the body of a method. *)
+            expr
+          | _ -> Ast_mapper.default_mapper.expr mapper expr)
+    }
+  in
+  mapper.expr mapper expr |> Parsetree_utils.expr_remove_merlin_attributes
+
+module Gen = struct
+  let unit = Longident.Lident "()" |> Location.mknoloc
+
+  let untyped_toplevel_let ~name ~body =
+    let open Ast_helper in
+    let pattern = Pat.mk (Ppat_var { txt = name; loc = Location.none }) in
+    Str.value Nonrecursive [ Vb.mk pattern (clean_up_for_printing body) ]
+
+  (* Generates [let name = body]. *)
+  let toplevel_let ~name ~body =
+    untyped_toplevel_let ~name ~body:(Untypeast.untype_expression body)
+
+  (* Generates [let name () = body]. *)
+  let let_unit_toplevel ~name ~body =
+    let open Ast_helper in
+    let unit_param =
+      { Parsetree.pparam_loc = Location.none;
+        pparam_desc = Pparam_val (Nolabel, None, Pat.construct unit None)
+      }
+    in
+    let body =
+      Exp.function_ [ unit_param ] None
+        (Pfunction_body (Untypeast.untype_expression body))
+    in
+    untyped_toplevel_let ~name ~body
+
+  module Id_map = Map.Make (struct
+    type t = string list
+
+    let compare = List.compare ~cmp:String.compare
+  end)
+
+  let param_name_of_path path =
+    match Path.flatten path with
+    | `Contains_apply -> "_functor_paths_not_handled"
+    | `Ok (id, path) ->
+      Ident.name id :: path
+      |> List.map ~f:String.lowercase_ascii
+      |> String.concat ~sep:"_"
+
+  (* Generates [let name params = body]. *)
+  let toplevel_function params ~name ~body =
+    let choose_param_name ~basename ~already_used param_path =
+      let param_name = Path.last param_path in
+      if String.Set.mem param_name already_used then
+        let other_name = param_name_of_path param_path in
+        if String.Set.mem other_name already_used then
+          Fresh_name.gen_val_name ~is_bound:String.Set.mem other_name
+            already_used
+        else other_name
+      else basename
+    in
+    let _used_params, params =
+      List.fold_left_map
+        ~f:(fun already_used param ->
+          let param_name =
+            choose_param_name ~basename:(param_name_of_path param) ~already_used
+              param
+          in
+          let param_pattern =
+            Ast_helper.Pat.var (Location.mknoloc param_name)
+          in
+          let fun_param =
+            { Parsetree.pparam_loc = Location.none;
+              pparam_desc = Pparam_val (Nolabel, None, param_pattern)
+            }
+          in
+          (String.Set.add param_name already_used, fun_param))
+        ~init:String.Set.empty params
+    in
+    let body =
+      Ast_helper.Exp.function_ params None
+        (Parsetree.Pfunction_body (Untypeast.untype_expression body))
+    in
+    untyped_toplevel_let ~name ~body
+
+  let ident ~name =
+    Longident.Lident name |> Location.mknoloc |> Ast_helper.Exp.ident
+
+  let fun_apply params ~name =
+    let open Ast_helper in
+    let params =
+      List.map
+        ~f:(fun param -> (Asttypes.Nolabel, clean_up_for_printing param))
+        params
+    in
+    Exp.apply (ident ~name) params
+
+  (* [fun_apply_unit ~name] generates a call to the function named [name] to which we apply unit. *)
+  let fun_apply_unit = fun_apply [ Ast_helper.Exp.ident unit ]
+
+  (* [fun_apply_params params ~name] generates a call to the function named [name]
+     to which we apply the list of arguments [params]. *)
+  let fun_apply_params params =
+    params
+    |> List.map ~f:(fun param -> ident ~name:(Path.name param))
+    |> fun_apply
+end
+
+let extract_source_around_loc src loc =
+  let (`Offset start_offset) =
+    let line, col = Lexing.split_pos loc.Location.loc_start in
+    Msource.get_offset src (`Logical (line, col))
+  in
+  let (`Offset end_offset) =
+    `Logical (Lexing.split_pos loc.loc_end) |> Msource.get_offset src
+  in
+  String.sub (Msource.text src) ~pos:start_offset
+    ~len:(end_offset - start_offset)
+  |> Msource.make
+
+type analysis = { bounded_vars : Path.t list; binding_kind : rec_flag }
+
+and rec_flag = Non_recursive | Rec_and
+
+type extraction =
+  { expr : Typedtree.expression;  (** Expression that being extracted *)
+    expr_env : Env.t;  (** Environment of the extracted expression *)
+    toplevel_item : toplevel_item;
+        (** The value binding toplevel or class declaration enclosing the extracted expression. *)
+    name : extraction_name;  (** Binding name of the extracted expression. *)
+    gen_binding_kind : rec_flag;
+    binding_generator :
+      name:string -> body:Typedtree.expression -> Parsetree.structure_item;
+    call_generator : name:string -> Parsetree.expression;
+    call_need_parenthesis : bool
+        (** Sometime we must parenthised call in order to type check. *)
+  }
+
+and extraction_name = Default of { basename : string } | Fixed of string
+
+and toplevel_item =
+  { rec_flag : Asttypes.rec_flag;
+    env : Env.t;
+    loc : Location.t;
+    kind : toplevel_item_kind
+  }
+(* A convenient type for grouping info. *)
+
+and toplevel_item_kind = Let of Typedtree.value_binding list | Class_decl
+
+let is_recursive = function
+  | { rec_flag = Asttypes.Recursive; _ } -> true
+  | { rec_flag = Nonrecursive; _ } -> false
+
+let rec find_pattern_var : type a. a Typedtree.general_pattern -> Path.t list =
+ fun { Typedtree.pat_desc; _ } ->
+  match pat_desc with
+  | Typedtree.Tpat_var (ident, _, _) -> [ Pident ident ]
+  | Tpat_tuple pats -> List.concat_map ~f:find_pattern_var pats
+  | Tpat_alias (pat, ident, _, _) -> Pident ident :: find_pattern_var pat
+  | Tpat_construct (_, _, pats, _) -> List.concat_map ~f:find_pattern_var pats
+  | Tpat_variant (_, Some pat, _) -> find_pattern_var pat
+  | Tpat_record (fields, _) ->
+    List.concat_map ~f:(fun (_, _, field) -> find_pattern_var field) fields
+  | Tpat_array arr -> List.concat_map ~f:find_pattern_var arr
+  | Tpat_lazy pat | Tpat_exception pat -> find_pattern_var pat
+  | Tpat_value pat ->
+    find_pattern_var (pat :> Typedtree.value Typedtree.general_pattern)
+  | Tpat_or (l, r, _) -> find_pattern_var l @ find_pattern_var r
+  | _ -> []
+
+let occuring_vars_path node =
+  let rec loop acc node =
+    match node.Browse_tree.t_node with
+    | Browse_raw.Expression { exp_desc = Texp_ident (path, _, _); _ } ->
+      Path.Set.add path acc
+    | Pattern pat ->
+      let paths = find_pattern_var pat |> List.to_seq in
+      Path.Set.add_seq paths acc
+    | _ -> Lazy.force node.t_children |> List.fold_left ~f:loop ~init:acc
+  in
+  loop Path.Set.empty node
+  |> Path.Set.filter (fun path ->
+         (* Filter identifier that are in Stdlib to avoid cluttering the list
+            of generated parameters.
+            TODO: there probably a more correct way to do this *)
+         Ident.name (Path.head path) <> "Stdlib")
+
+let analyze_expr expr expr_env ~toplevel_item =
+  let is_value_bound_locally path =
+    let is_bound path env =
+      try
+        let _ = Env.find_value path env in
+        true
+      with Not_found -> false
+    in
+    is_bound path expr_env && not (is_bound path toplevel_item.env)
+  in
+  let is_one_of_value_decl var_path bindings =
+    List.exists
+      ~f:(fun vb ->
+        let names = find_pattern_var vb.Typedtree.vb_pat |> Path.Set.of_list in
+        Path.Set.mem var_path names)
+      bindings
+  in
+  let vars_path =
+    Browse_tree.of_node ~env:expr_env (Browse_raw.Expression expr)
+    |> occuring_vars_path
+  in
+  let analysis =
+    Path.Set.fold
+      (fun var_path acc ->
+        if is_value_bound_locally var_path then
+          match toplevel_item.kind with
+          | Let bindings
+            when is_recursive toplevel_item
+                 && is_one_of_value_decl var_path bindings ->
+            { acc with binding_kind = Rec_and }
+          | _ -> { acc with bounded_vars = var_path :: acc.bounded_vars }
+        else acc)
+      vars_path
+      { bounded_vars = []; binding_kind = Non_recursive }
+  in
+  { analysis with bounded_vars = List.rev analysis.bounded_vars }
+
+let choose_name name env =
+  match name with
+  | Default { basename } -> Fresh_name.gen_val_name_env basename env
+  | Fixed name ->
+    if Env.bound_value name env then Fresh_name.gen_val_name_env name env
+    else name
+
+let extract_to_toplevel
+    { expr;
+      expr_env;
+      name;
+      gen_binding_kind;
+      binding_generator;
+      call_generator;
+      toplevel_item;
+      call_need_parenthesis
+    } buffer =
+  let val_name = choose_name name expr_env in
+  let fresh_call =
+    let parenthised_opt s =
+      if call_need_parenthesis then "(" ^ s ^ ")" else s
+    in
+    call_generator ~name:val_name
+    |> Format.asprintf "%a" Pprintast.expression
+    |> parenthised_opt
+  in
+  let toplevel_item_source =
+    extract_source_around_loc buffer toplevel_item.loc
+  in
+  let subst_loc =
+    let start_lnum =
+      1 + expr.exp_loc.Location.loc_start.pos_lnum
+      - toplevel_item.loc.loc_start.pos_lnum
+    in
+    let end_lnum =
+      start_lnum + expr.exp_loc.loc_end.pos_lnum
+      - expr.exp_loc.loc_start.pos_lnum
+    in
+    { expr.exp_loc with
+      loc_start = { expr.exp_loc.loc_start with pos_lnum = start_lnum };
+      loc_end = { expr.exp_loc.loc_end with pos_lnum = end_lnum }
+    }
+  in
+  let substituted_binding =
+    Msource.substitute toplevel_item_source
+      (`Logical (Lexing.split_pos subst_loc.loc_start))
+      (`Logical (Lexing.split_pos subst_loc.loc_end))
+      fresh_call
+    |> Msource.text
+  in
+  let content =
+    match gen_binding_kind with
+    | Non_recursive ->
+      let fresh_let_binding =
+        binding_generator ~name:val_name ~body:expr
+        |> Format.asprintf "%a" Pprintast.structure_item
+      in
+      fresh_let_binding ^ "\n" ^ substituted_binding
+    | Rec_and ->
+      let fresh_let_binding =
+        binding_generator ~name:val_name ~body:expr
+        |> Format.asprintf "%a" Pprintast.structure_item
+      in
+      let fresh_and_binding =
+        "and" ^ String.drop 3 fresh_let_binding (* Sorry *)
+      in
+      substituted_binding ^ "\n" ^ fresh_and_binding
+  in
+  let selection_range =
+    let lnum =
+      match gen_binding_kind with
+      | Non_recursive -> toplevel_item.loc.loc_start.pos_lnum
+      | Rec_and -> toplevel_item.loc.loc_end.pos_lnum + String.length "\n"
+    in
+    let prefix_length =
+      match gen_binding_kind with
+      | Non_recursive ->
+        if is_recursive toplevel_item then String.length "let rec "
+        else String.length "let "
+      | Rec_and -> String.length "and "
+    in
+    { Location.loc_start = Lexing.make_pos (lnum, prefix_length);
+      loc_end = Lexing.make_pos (lnum, prefix_length + String.length val_name);
+      loc_ghost = false
+    }
+  in
+  { Query_protocol.loc = toplevel_item.loc; content; selection_range }
+
+let extract_const_to_toplevel ?extract_name expr ~expr_env ~toplevel_item =
+  let name =
+    match extract_name with
+    | None -> Default { basename = "const_name" }
+    | Some name -> Fixed name
+  in
+  extract_to_toplevel
+    { expr;
+      expr_env;
+      toplevel_item;
+      name;
+      gen_binding_kind = Non_recursive;
+      binding_generator = Gen.toplevel_let;
+      call_generator = Gen.ident;
+      call_need_parenthesis = false
+    }
+
+let extract_expr_to_toplevel ?extract_name expr ~expr_env ~toplevel_item =
+  let is_function = function
+    | { Typedtree.exp_desc = Texp_function _; _ } -> true
+    | _ -> false
+  in
+  let is_module_bound_in_toplevel_env path =
+    try
+      let _ = Env.find_module path toplevel_item.env in
+      false
+    with Not_found -> true
+  in
+  let { bounded_vars; binding_kind } =
+    analyze_expr expr expr_env ~toplevel_item
+  in
+  let bounded_vars_stamp =
+    List.map ~f:(fun p -> Path.head p |> Ident.stamp) bounded_vars
+  in
+  let is_bound_var ident =
+    List.exists ~f:(Int.equal (Ident.stamp ident)) bounded_vars_stamp
+  in
+  let binding_generator, call_generator =
+    match bounded_vars with
+    | [] when not (is_function expr) ->
+      (* If the extracted expr is already a function, no need to delayed computation
+         with a unit parameter. *)
+      (Gen.let_unit_toplevel, Gen.fun_apply_unit)
+    | _ ->
+      (Gen.toplevel_function bounded_vars, Gen.fun_apply_params bounded_vars)
+  in
+  let name =
+    match extract_name with
+    | None -> Default { basename = "fun_name" }
+    | Some name -> Fixed name
+  in
+  let remove_path_prefix_of_bound_values expr =
+    (* We need to unqualify bound values. Otherwise, the generated call will use
+       the qualified name even if it does not exist in the scope. Examples:
+
+      let f () =
+        let module X = struct let x = 10 end in
+        X.x
+        ^^^ If we extract this, the corresponding extracted call will be:
+
+      let fun_name1 x = X.x *)
+    let mapper =
+      { Tast_mapper.default with
+        expr =
+          (fun mapper expr ->
+            match expr.Typedtree.exp_desc with
+            | Texp_ident (Pdot (path, name), longident, vd)
+              when is_bound_var (Path.head path)
+                   && is_module_bound_in_toplevel_env path ->
+              let name = Gen.param_name_of_path (Pdot (path, name)) in
+              let ident = { longident with txt = Longident.Lident name } in
+              { expr with exp_desc = Texp_ident (path, ident, vd) }
+            | _ -> Tast_mapper.default.expr mapper expr)
+      }
+    in
+    mapper.expr mapper expr
+  in
+  extract_to_toplevel
+    { expr = remove_path_prefix_of_bound_values expr;
+      expr_env;
+      toplevel_item;
+      name;
+      gen_binding_kind = binding_kind;
+      binding_generator;
+      call_generator;
+      call_need_parenthesis = true
+    }
+
+(* [largest_expr_between ~start ~stop nodes] tries to find the most inclusive expression
+   within the range [start]-[stop] among [nodes].
+
+   [nodes] is a list of enclosings around the start position from the deepest
+   to the topelevel. It's reversed searched for an expression that fits the range. *)
+let largest_expr_between ~start ~stop nodes =
+  let is_inside_region =
+    Location_aux.included
+      ~into:{ Location.loc_start = start; loc_end = stop; loc_ghost = true }
+  in
+  let rec select_among_child env node =
+    let node_loc = Mbrowse.node_loc node in
+    match node with
+    | Expression expr
+      when node_loc.loc_ghost = false && is_inside_region node_loc ->
+      (* We filter expression that have a ghost location. Otherwise, expression
+        such as [let f x = 10 + x] can be extracted and this can lead to invalid
+        code gen.      ^^^^^^^^^^ *)
+      Some (expr, env)
+    | _ ->
+      (* Continue to browse through the child of [node]. *)
+      let node = Browse_tree.of_node ~env node in
+      Lazy.force node.t_children |> List.rev
+      |> Stdlib.List.find_map (fun node ->
+             select_among_child node.Browse_tree.t_env node.t_node)
+  in
+  nodes |> Stdlib.List.find_map (fun (env, node) -> select_among_child env node)
+
+let find_associated_toplevel_item expr enclosing =
+  Stdlib.List.find_map
+    (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)
+    enclosing
+
+let extract_region ~start ~stop enclosing =
+  let open Option.Infix in
+  (* We want to traverse [enclosing] in ascending order. *)
+  let enclosing = List.rev enclosing in
+  largest_expr_between ~start ~stop enclosing >>= fun (expr, expr_env) ->
+  find_associated_toplevel_item expr enclosing >>| fun toplevel_item ->
+  (expr, expr_env, toplevel_item)
+
+let is_region_extractable ~start ~stop enclosing =
+  match extract_region ~start ~stop enclosing with
+  | None -> false
+  | Some _ -> true
+
+let substitute ~start ~stop ?extract_name buffer structure =
+  let enclosing = Mbrowse.enclosing start [ Mbrowse.of_structure structure ] in
+  match extract_region ~start ~stop enclosing with
+  | None -> raise Nothing_to_do
+  | Some (expr, expr_env, toplevel_item) -> begin
+    match expr.exp_desc with
+    | Texp_constant _ ->
+      (* Special case for constant. They can't produce side effect so it's not
+         necessary to add a trailing unit parameter to the let binding. *)
+      extract_const_to_toplevel ?extract_name expr ~expr_env buffer
+        ~toplevel_item
+    | _ ->
+      extract_expr_to_toplevel ?extract_name expr buffer ~expr_env
+        ~toplevel_item
+  end
diff --git a/src/analysis/refactor_extract_region.mli b/src/analysis/refactor_extract_region.mli
new file mode 100644
index 000000000..321ce7e2c
--- /dev/null
+++ b/src/analysis/refactor_extract_region.mli
@@ -0,0 +1,113 @@
+(** Region extractor allows extracting arbitrary expressions into a fresh
+    toplevel binding. The extractor detects bound variables inside the extracted
+    expression and performs code generation accordingly.
+
+    For instance, let's assume that we want to extract the pi value oustide of
+    the body of [circle_area]:
+    {[
+      let circle_area radius = 3.14159 *. (radius ** 2.)
+                            (* ^^^^^^^ *)
+    ]}
+
+    The generated code will look like this:
+    {[
+      let const_name1 = 3.14159
+      let circle_area radius = const_name1 *. (radius ** 2.)
+    ]}
+
+    Extraction also works on expressions that are functions:
+    {[
+      let all_empty l =
+        List.for_all
+          (function
+            | [] -> true
+            | _ -> false)
+       (* ^^^^^^^^^^^^^^^ *)
+          l
+    ]}
+
+    {[
+      let is_empty = (function | [] -> true | _ -> false)
+      let all_empty l = List.for_all is_empty l
+    ]}
+
+    Let's look at a more complicated example where we want to extract the entire
+    body of [f]:
+    {[
+      let rec f x = 10 + y + x
+                 (* ^^^^^^^^^^ *)
+
+      and y = 80
+    ]}
+
+    Performing the extraction leads to this code:
+    {[
+      let rec f x = fun_name2 x
+
+      and y = 80
+
+      and fun_name2 x = 10 + y + x
+    ]}
+
+    We can see that extractor detects this kind of pattern and extracts the
+    expression inside an [and] binding. It also substitutes the expression by a
+    call to the fresh generated function with the correct parameters.
+
+    Finally, if there is no bound variable in the expression, a trailing unit
+    parameter is added to the generated let binding in order to preserve the
+    evaluation order. Let's extract the entire body of [my_list]:
+    {[
+      let my_list =
+        print_endline "Wild side effect!";
+        1 :: [ 2; 3; 4 ]
+    ]}
+
+    {[
+      let my_list () =
+        print_endline "Wild side effect!";
+        [ 1; 2; 3; 4 ]
+      let f = my_list ()
+    ]}
+
+    Final remarks:
+    - Extraction currently works on any typedtree expression that doesn't have a
+      ghost location. This restriction prevents the generation of invalid code.
+
+    - The generated code is pretty printed by the compiler libs and may not be
+      formatted according to OCamlformat conventions.
+
+*)
+
+(** Raised when extractor is not ables to select an expression to extract in
+    given location interval. *)
+exception Nothing_to_do
+
+(** Raised when extraction is called inside an interface file. *)
+exception Not_allowed_in_interface_file
+
+(** Is an expression is extractable in the given region? *)
+val is_region_extractable :
+  start:Lexing.position -> stop:Lexing.position -> Mbrowse.t -> bool
+
+(** [substitute ~start ~stop ~extract_name buffer typedtree_structure] tries to
+    extract the most inclusive expression located in interval [start-stop] into
+    a fresh toplevel generated let binding.
+
+    Returns a {!Query_protocol.substitution_result} consisting of three fields:
+    - [loc]: the location where [content] musts be inserted.
+    - [content]: the code where the substitution takes places completed by the
+      generated let binding.
+    - [selection_range]: the location where to position the cursor for easy
+      renaming of the generated let binding.
+
+    If there is no [extract_name] provided, the generated binding is named with
+    an untaken name in its current scope. Extracted constants will be named with
+    a name beginning with ["const_name"], while extracted functions will have a
+    name beginning with ["fun_name"]. *)
+val substitute :
+  start:Lexing.position ->
+  stop:Lexing.position ->
+  ?extract_name:string ->
+  Msource.t ->
+  Typedtree.structure ->
+  Query_protocol.substitution_result
diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml
index 7eed73d48..7790eae66 100644
--- a/src/commands/new_commands.ml
+++ b/src/commands/new_commands.ml
@@ -565,6 +565,35 @@ let all_commands =
           | Some action, (#Msource.position as pos) ->
             run buffer (Query_protocol.Refactor_open (action, pos))
       end;
+    command "refactoring-extract-region" ~doc:"extract a region as function"
+      ~spec:
+        [ arg "-start" "<position> Where extracted region start"
+            (marg_position (fun start (_start, stop, name) ->
+                 (start, stop, name)));
+          arg "-end" "<position> Where extracted region end"
+            (marg_position (fun stop (start, _stop, name) ->
+                 (start, stop, name)));
+          optional "-extract-name"
+            "<name> Name used by the generated let binding"
+            (Marg.param "string" (fun name (start, stop, _name) ->
+                 let name =
+                   match String.trim name with
+                   | "" -> None
+                   | n -> Some n
+                 in
+                 (start, stop, name)))
+        ]
+      ~default:(`None, `None, None)
+      begin
+        fun buffer (start, stop, name) ->
+          match (start, stop, name) with
+          | `None, `None, _ -> failwith "-start <pos> and -end are mandatory"
+          | `None, _, _ -> failwith "-start <pos> is mandatory"
+          | _, `None, _ -> failwith "-end <pos> is mandatory"
+          | (#Msource.position as start), (#Msource.position as stop), name ->
+            run buffer
+              (Query_protocol.Refactor_extract_region (start, stop, name))
+      end;
     command "search-by-polarity"
       ~doc:"search-by-polarity -position pos -query ident\n\tTODO"
       ~spec:
diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml
index f0c0939be..cf2e52269 100644
--- a/src/commands/query_json.ml
+++ b/src/commands/query_json.ml
@@ -211,6 +211,9 @@ let dump (type a) : a t -> json =
             | `Unqualify -> "unqualify") );
         ("position", mk_position pos)
       ]
+  | Refactor_extract_region (start, stop, _) ->
+    mk "refactoring-extract-region"
+      [ ("start", mk_position start); ("stop", mk_position stop) ]
   | Signature_help { position; _ } ->
     mk "signature-help" [ ("position", mk_position position) ]
   | Version -> mk "version" []
@@ -408,6 +411,16 @@ let json_of_search_result list =
   in
   `List list
 
+let json_of_substitution_result { loc; content; selection_range } =
+  with_location loc
+    [ ("content", `String content);
+      ( "selection-range",
+        `Assoc
+          [ ("start", Lexing.json_of_position selection_range.Location.loc_start);
+            ("end", Lexing.json_of_position selection_range.loc_end)
+          ] )
+    ]
+
 let json_of_response (type a) (query : a t) (response : a) : json =
   match (query, response) with
   | Type_expr _, str -> `String str
@@ -422,6 +435,8 @@ let json_of_response (type a) (query : a t) (response : a) : json =
     `List
       (List.map locations ~f:(fun (name, loc) ->
            with_location loc [ ("content", `String name) ]))
+  | Refactor_extract_region _, subst_res ->
+    json_of_substitution_result subst_res
   | Document _, resp -> begin
     match resp with
     | `No_documentation -> `String "No documentation available"
@@ -501,7 +516,7 @@ let json_of_response (type a) (query : a t) (response : a) : json =
   | Occurrences (_, scope), (occurrences, _project) ->
     let with_file = scope = `Project || scope = `Renaming in
     `List
-      (List.map occurrences ~f:(fun occurrence ->
+      (List.map occurrences ~f:(fun (occurrence : Query_protocol.occurrence) ->
            with_location ~with_file occurrence.loc
              [ ("stale", Json.bool occurrence.is_stale) ]))
   | Signature_help _, s -> json_of_signature_help s
diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml
index 818246ceb..98732cd69 100644
--- a/src/frontend/query_commands.ml
+++ b/src/frontend/query_commands.ml
@@ -812,6 +812,18 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
         Inlay_hints.of_structure ~hint_let_binding ~hint_pattern_binding
           ~hint_function_params ~avoid_ghost_location ~start ~stop structure
     end
+  | Refactor_extract_region (start, stop, extract_name) ->
+    let start = Mpipeline.get_lexing_pos pipeline start
+    and stop = Mpipeline.get_lexing_pos pipeline stop in
+    let raw_source = Mpipeline.raw_source pipeline in
+    begin
+      match Mpipeline.typer_result pipeline |> Mtyper.get_typedtree with
+      | `Interface _ ->
+        raise Refactor_extract_region.Not_allowed_in_interface_file
+      | `Implementation structure ->
+        Refactor_extract_region.substitute ~start ~stop ?extract_name raw_source
+          structure
+    end
   | Signature_help { position; _ } -> (
     (* Todo: additionnal contextual information could help us provide better
        results.*)
diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml
index ba845dfb2..fadcf8b91 100644
--- a/src/frontend/query_protocol.ml
+++ b/src/frontend/query_protocol.ml
@@ -133,6 +133,9 @@ type occurrences_status =
 
 type occurrence = { loc : Location.t; is_stale : bool }
 
+type substitution_result =
+  { loc : Location.t; content : string; selection_range : Location.t }
+
 type _ t =
   | Type_expr (* *) : string * Msource.position -> string t
   | Type_enclosing (* *) :
@@ -158,6 +161,9 @@ type _ t =
   | Refactor_open :
       [ `Qualify | `Unqualify ] * Msource.position
       -> (string * Location.t) list t
+  | Refactor_extract_region :
+      Msource.position * Msource.position * string option
+      -> substitution_result t
   | Document (* *) :
       string option * Msource.position
       -> [ `Found of string
diff --git a/src/ocaml/typing/env.mli b/src/ocaml/typing/env.mli
index 6866dabe3..3d8cef430 100644
--- a/src/ocaml/typing/env.mli
+++ b/src/ocaml/typing/env.mli
@@ -355,7 +355,7 @@ val open_pers_signature: string -> t -> (t, [`Not_found]) result
 val remove_last_open: Path.t -> t -> t option
 
 (* Insertion by name *)
-
+(*  *)
 val enter_value:
     ?check:(string -> Warnings.t) ->
     string -> value_description -> t -> Ident.t * t
diff --git a/tests/test-dirs/refactor-extract-region/const-extraction.t/const.ml b/tests/test-dirs/refactor-extract-region/const-extraction.t/const.ml
new file mode 100644
index 000000000..882180ad2
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/const-extraction.t/const.ml
@@ -0,0 +1,41 @@
+let const_name1 = "before"
+
+let circle_area radius = 3.14159 *. (radius ** 2.)
+
+let read ?(chunk_size = 4096) ic =
+  let buf = Bytes.create chunk_size in
+  In_channel.input ic buf 0 (Bytes.length buf)
+
+(* My commentary *)
+let my_nested_long_int =
+  let o =
+    let c =
+      let a =
+        let m =
+          let l = 1_000_000_000L in
+          l
+        in
+        m
+      in
+      a
+    in
+    c
+  in
+  o
+
+let log ppf msg = Format.pp_print_string ppf ("CRITICAL: " ^ msg)
+
+module type EMPTY = sig end
+let f () : (module EMPTY) =
+  (module struct
+    let const_name2 = assert false
+    let secret = String.make 100 '@'
+  end)
+
+let g () =
+  let multilines_cst = {foo|
+multi
+lines
+constant
+|foo} in
+  print_endline multilines_cst
diff --git a/tests/test-dirs/refactor-extract-region/const-extraction.t/run.t b/tests/test-dirs/refactor-extract-region/const-extraction.t/run.t
new file mode 100644
index 000000000..80f34c3dc
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/const-extraction.t/run.t
@@ -0,0 +1,203 @@
+  $ $MERLIN single refactoring-extract-region -start 3:25 -end 3:34 -extract-name pi < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 3,
+        "col": 0
+      },
+      "end": {
+        "line": 3,
+        "col": 50
+      },
+      "content": "let pi = 3.14159
+  let circle_area radius = pi *. (radius ** 2.)",
+      "selection-range": {
+        "start": {
+          "line": 3,
+          "col": 4
+        },
+        "end": {
+          "line": 3,
+          "col": 6
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 5:24 -end 5:28 -extract-name chunk_size < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 5,
+        "col": 0
+      },
+      "end": {
+        "line": 7,
+        "col": 46
+      },
+      "content": "let chunk_size = 4096
+  let read ?(chunk_size = chunk_size) ic =
+    let buf = Bytes.create chunk_size in
+    In_channel.input ic buf 0 (Bytes.length buf)",
+      "selection-range": {
+        "start": {
+          "line": 5,
+          "col": 4
+        },
+        "end": {
+          "line": 5,
+          "col": 14
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 15:18 -end 15:32 < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 10,
+        "col": 0
+      },
+      "end": {
+        "line": 24,
+        "col": 3
+      },
+      "content": "let const_name2 = 1000000000L
+  let my_nested_long_int =
+    let o =
+      let c =
+        let a =
+          let m =
+            let l = const_name2 in
+            l
+          in
+          m
+        in
+        a
+      in
+      c
+    in
+    o",
+      "selection-range": {
+        "start": {
+          "line": 10,
+          "col": 4
+        },
+        "end": {
+          "line": 10,
+          "col": 15
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 26:46 -end 26:58 -extract-name header_log < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 26,
+        "col": 0
+      },
+      "end": {
+        "line": 26,
+        "col": 65
+      },
+      "content": "let header_log = \"CRITICAL: \"
+  let log ppf msg = Format.pp_print_string ppf (header_log ^ msg)",
+      "selection-range": {
+        "start": {
+          "line": 26,
+          "col": 4
+        },
+        "end": {
+          "line": 26,
+          "col": 14
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 32:33 -end 32:36 < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 29,
+        "col": 0
+      },
+      "end": {
+        "line": 33,
+        "col": 6
+      },
+      "content": "let const_name3 = '@'
+  let f () : (module EMPTY) =
+    (module struct
+      let const_name2 = assert false
+      let secret = String.make 100 const_name3
+    end)",
+      "selection-range": {
+        "start": {
+          "line": 29,
+          "col": 4
+        },
+        "end": {
+          "line": 29,
+          "col": 15
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 36:23 -end 40:5 -extract-name my_essay < const.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 35,
+        "col": 0
+      },
+      "end": {
+        "line": 41,
+        "col": 30
+      },
+      "content": "let my_essay = {foo|
+  multi
+  lines
+  constant
+  |foo}
+  let g () =
+    let multilines_cst = my_essay in
+    print_endline multilines_cst",
+      "selection-range": {
+        "start": {
+          "line": 35,
+          "col": 4
+        },
+        "end": {
+          "line": 35,
+          "col": 12
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 1:0 -end 2:0 \
+  > -filename foobar.mli <<EOF
+  > val f : int -> int
+  > EOF
+  {
+    "class": "error",
+    "value": "Expression extraction is only allowed in implementation file",
+    "notifications": []
+  }
diff --git a/tests/test-dirs/refactor-extract-region/extraction-issue.t/foo.ml b/tests/test-dirs/refactor-extract-region/extraction-issue.t/foo.ml
new file mode 100644
index 000000000..4bc6d7698
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/extraction-issue.t/foo.ml
@@ -0,0 +1,17 @@
+let z = 100
+
+let complicated_function x y =
+  let module D = struct
+    let x = 13
+  end in
+  (x * y) + D.x
+
+let f () =
+  let module D = struct
+    let x = 42
+  end in
+  let module M = struct
+    let x = 1
+  end in
+  let x = 10 in
+  D.x + x + M.x
diff --git a/tests/test-dirs/refactor-extract-region/extraction-issue.t/run.t b/tests/test-dirs/refactor-extract-region/extraction-issue.t/run.t
new file mode 100644
index 000000000..c61c72b90
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/extraction-issue.t/run.t
@@ -0,0 +1,71 @@
+Should be: (x * y) + d_x
+
+  $ $MERLIN single refactoring-extract-region -start 7:2 -end 7:15 < foo.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 3,
+        "col": 0
+      },
+      "end": {
+        "line": 7,
+        "col": 15
+      },
+      "content": "let fun_name1 x y d_x = (x * y) + d_x
+  let complicated_function x y =
+    let module D = struct
+      let x = 13
+    end in
+    (fun_name1 x y D.x)",
+      "selection-range": {
+        "start": {
+          "line": 3,
+          "col": 4
+        },
+        "end": {
+          "line": 3,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+Should be: d_x + x + m_x
+
+  $ $MERLIN single refactoring-extract-region -start 17:2 -end 17:16 < foo.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 9,
+        "col": 0
+      },
+      "end": {
+        "line": 17,
+        "col": 15
+      },
+      "content": "let fun_name1 x d_x m_x = (d_x + x) + m_x
+  let f () =
+    let module D = struct
+      let x = 42
+    end in
+    let module M = struct
+      let x = 1
+    end in
+    let x = 10 in
+    (fun_name1 x D.x M.x)",
+      "selection-range": {
+        "start": {
+          "line": 9,
+          "col": 4
+        },
+        "end": {
+          "line": 9,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
diff --git a/tests/test-dirs/refactor-extract-region/func-extraction.t/func.ml b/tests/test-dirs/refactor-extract-region/func-extraction.t/func.ml
new file mode 100644
index 000000000..5721ce1d8
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/func-extraction.t/func.ml
@@ -0,0 +1,158 @@
+let fun_name1 () = ()
+
+let all_empty l =
+  List.for_all
+    (function
+      | [] -> true
+      | _ -> false)
+    l
+
+let max l = List.fold_left (fun acc x -> if x > acc then x else acc) l
+
+(* A comment *)
+let z = "..."
+
+let test x y =
+  let fun_name2 = Fun.id in
+  let m =
+    let m = print_endline (x ^ y ^ z) in
+    m
+  in
+  m
+
+let rec x = object end
+
+and y _ =
+  object
+    method foo = x
+  end
+
+let rec z x = 10 + y + x
+
+and y = 80
+
+let f =
+  print_endline "Wild side effect!";
+  1 :: [ 2; 3; 4 ]
+
+class a =
+  let inner_expr =
+    let bar = 20 in
+    object
+      method foo = bar
+    end
+  in
+  object
+    method x = (Fun.const 10) ()
+    method y = print_endline
+    method z =
+      let x =
+        object
+          method x = "foobar"
+        end
+      in
+      x
+  end
+
+and b = object end
+
+let my_mutable_state =
+  let var = ref 0 in
+  var := y * 50;
+  !var
+
+let func () =
+  let x = [] in
+  Fun.protect
+    (fun () ->
+      let fun_name2 = ( / ) in
+      let y = [ ( + ); ( - ); fun_name2 ] @ x in
+      List.map2 (fun op (a, b) -> op a b) y [ (1, 1); (3, 2); (8, 2) ])
+    ~finally:(Fun.const ())
+
+let rec f = List.map Fun.id
+
+and y = [ 10; 20; 30 ]
+
+and z x =
+  object
+    method x = x
+    method y = y
+  end
+
+let f = 0 + 1
+
+let f x = (x * 2) + 3
+
+let f x =
+  let y = 0 in
+  (x * y) + 3
+
+let f x =
+  let exception Local in
+  raise Local
+
+let x = 0
+let f x = x + 1
+
+let x = 0
+let y = 1
+let f x = x + y
+
+let f x = List.map (fun y -> y + 1) x
+
+let f y =
+  let y = y + 1 in
+  y + 2
+
+let f () = y + 1
+
+let f x =
+  let module M = struct
+    let y = 0
+  end in
+  (x * M.y) + 3
+
+let f =
+  let x = 1 in
+  let y = 2 in
+  let z = x + y in
+  z + z + 1
+
+type document = markup list
+and markup = Text of string | Bold of string
+
+let pp_document ppf doc =
+  let open Format in
+  let bold_tag = "**" in
+  fprintf ppf "%a"
+    (pp_print_list (fun ppf markup ->
+         match markup with
+         | Text txt -> pp_print_string ppf txt
+         | Bold txt -> pp_print_string ppf (bold_tag ^ txt ^ bold_tag)))
+    doc
+
+module A = struct
+  let a = 10
+end
+let f x =
+  let module Empty = struct end in
+  let module M = struct
+    module MM = struct
+      let y = 0
+    end
+    let z = 0
+  end in
+  (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
diff --git a/tests/test-dirs/refactor-extract-region/func-extraction.t/run.t b/tests/test-dirs/refactor-extract-region/func-extraction.t/run.t
new file mode 100644
index 000000000..7d99fc410
--- /dev/null
+++ b/tests/test-dirs/refactor-extract-region/func-extraction.t/run.t
@@ -0,0 +1,869 @@
+  $ $MERLIN single refactoring-extract-region -start 5:4 -end 7:19 -extract-name is_empty < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 3,
+        "col": 0
+      },
+      "end": {
+        "line": 8,
+        "col": 5
+      },
+      "content": "let is_empty = (function | [] -> true | _ -> false)
+  let all_empty l =
+    List.for_all
+      (is_empty )
+      l",
+      "selection-range": {
+        "start": {
+          "line": 3,
+          "col": 4
+        },
+        "end": {
+          "line": 3,
+          "col": 12
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 10:20 -end 10:70 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 10,
+        "col": 0
+      },
+      "end": {
+        "line": 10,
+        "col": 70
+      },
+      "content": "let fun_name2 = fun acc x -> if x > acc then x else acc
+  let max l = List.fold_left (fun_name2 ) l",
+      "selection-range": {
+        "start": {
+          "line": 10,
+          "col": 4
+        },
+        "end": {
+          "line": 10,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 18:12 -end 18:37 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 15,
+        "col": 0
+      },
+      "end": {
+        "line": 21,
+        "col": 3
+      },
+      "content": "let fun_name3 x y = print_endline (x ^ (y ^ z))
+  let test x y =
+    let fun_name2 = Fun.id in
+    let m =
+      let m = (fun_name3 x y) in
+      m
+    in
+    m",
+      "selection-range": {
+        "start": {
+          "line": 15,
+          "col": 4
+        },
+        "end": {
+          "line": 15,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 30:14 -end 30:24 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 30,
+        "col": 0
+      },
+      "end": {
+        "line": 32,
+        "col": 10
+      },
+      "content": "let rec z x = (fun_name2 x)
+  
+  and y = 80
+  and fun_name2 x = (10 + y) + x",
+      "selection-range": {
+        "start": {
+          "line": 33,
+          "col": 4
+        },
+        "end": {
+          "line": 33,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 35:2 -end 36:18 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 34,
+        "col": 0
+      },
+      "end": {
+        "line": 36,
+        "col": 18
+      },
+      "content": "let fun_name2 () = print_endline \"Wild side effect!\"; [1; 2; 3; 4]
+  let f =
+    (fun_name2 ())",
+      "selection-range": {
+        "start": {
+          "line": 34,
+          "col": 4
+        },
+        "end": {
+          "line": 34,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 40:4 -end 43:7 -extract-name outsider_expr < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 38,
+        "col": 0
+      },
+      "end": {
+        "line": 55,
+        "col": 5
+      },
+      "content": "let outsider_expr () = let bar = 20 in object method foo = bar end
+  class a =
+    let inner_expr =
+      (outsider_expr ())
+    in
+    object
+      method x = (Fun.const 10) ()
+      method y = print_endline
+      method z =
+        let x =
+          object
+            method x = \"foobar\"
+          end
+        in
+        x
+    end",
+      "selection-range": {
+        "start": {
+          "line": 38,
+          "col": 4
+        },
+        "end": {
+          "line": 38,
+          "col": 17
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 49:6 -end 56:7 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 38,
+        "col": 0
+      },
+      "end": {
+        "line": 55,
+        "col": 5
+      },
+      "content": "let fun_name2 () = let x = object method x = \"foobar\" end in x
+  class a =
+    let inner_expr =
+      let bar = 20 in
+      object
+        method foo = bar
+      end
+    in
+    object
+      method x = (Fun.const 10) ()
+      method y = print_endline
+      method z =
+        (fun_name2 ())
+    end",
+      "selection-range": {
+        "start": {
+          "line": 38,
+          "col": 4
+        },
+        "end": {
+          "line": 38,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 60:2 -end 62:6 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 59,
+        "col": 0
+      },
+      "end": {
+        "line": 62,
+        "col": 6
+      },
+      "content": "let fun_name2 () = let var = ref 0 in var := (y * 50); !var
+  let my_mutable_state =
+    (fun_name2 ())",
+      "selection-range": {
+        "start": {
+          "line": 59,
+          "col": 4
+        },
+        "end": {
+          "line": 59,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 69:14 -end 69:45 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 64,
+        "col": 0
+      },
+      "end": {
+        "line": 71,
+        "col": 27
+      },
+      "content": "let fun_name3 x fun_name2 = [(+); (-); fun_name2] @ x
+  let func () =
+    let x = [] in
+    Fun.protect
+      (fun () ->
+        let fun_name2 = ( / ) in
+        let y = (fun_name3 x fun_name2) in
+        List.map2 (fun op (a, b) -> op a b) y [ (1, 1); (3, 2); (8, 2) ])
+      ~finally:(Fun.const ())",
+      "selection-range": {
+        "start": {
+          "line": 64,
+          "col": 4
+        },
+        "end": {
+          "line": 64,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 75:8 -end 75:22 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 73,
+        "col": 0
+      },
+      "end": {
+        "line": 81,
+        "col": 5
+      },
+      "content": "let fun_name2 () = [10; 20; 30]
+  let rec f = List.map Fun.id
+  
+  and y = (fun_name2 ())
+  
+  and z x =
+    object
+      method x = x
+      method y = y
+    end",
+      "selection-range": {
+        "start": {
+          "line": 73,
+          "col": 8
+        },
+        "end": {
+          "line": 73,
+          "col": 17
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 79:15 -end 79:16 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 73,
+        "col": 0
+      },
+      "end": {
+        "line": 81,
+        "col": 5
+      },
+      "content": "let fun_name2 x = x
+  let rec f = List.map Fun.id
+  
+  and y = [ 10; 20; 30 ]
+  
+  and z x =
+    object
+      method x = (fun_name2 x)
+      method y = y
+    end",
+      "selection-range": {
+        "start": {
+          "line": 73,
+          "col": 8
+        },
+        "end": {
+          "line": 73,
+          "col": 17
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 83:12 -end 83:13 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 83,
+        "col": 0
+      },
+      "end": {
+        "line": 83,
+        "col": 13
+      },
+      "content": "let const_name1 = 1
+  let f = 0 + const_name1",
+      "selection-range": {
+        "start": {
+          "line": 83,
+          "col": 4
+        },
+        "end": {
+          "line": 83,
+          "col": 15
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 85:10 -end 85:17 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 85,
+        "col": 0
+      },
+      "end": {
+        "line": 85,
+        "col": 21
+      },
+      "content": "let fun_name2 x = x * 2
+  let f x = (fun_name2 x) + 3",
+      "selection-range": {
+        "start": {
+          "line": 85,
+          "col": 4
+        },
+        "end": {
+          "line": 85,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 89:2 -end 89:10 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 87,
+        "col": 0
+      },
+      "end": {
+        "line": 89,
+        "col": 13
+      },
+      "content": "let fun_name2 x y = x * y
+  let f x =
+    let y = 0 in
+    (fun_name2 x y) + 3",
+      "selection-range": {
+        "start": {
+          "line": 87,
+          "col": 4
+        },
+        "end": {
+          "line": 87,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+TODO: This extraction shouldn't be allowed.
+  $ $MERLIN single refactoring-extract-region -start 93:2 -end 93:13 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 91,
+        "col": 0
+      },
+      "end": {
+        "line": 93,
+        "col": 13
+      },
+      "content": "let fun_name2 () = raise Local
+  let f x =
+    let exception Local in
+    (fun_name2 ())",
+      "selection-range": {
+        "start": {
+          "line": 91,
+          "col": 4
+        },
+        "end": {
+          "line": 91,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 96:10 -end 96:16 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 96,
+        "col": 0
+      },
+      "end": {
+        "line": 96,
+        "col": 15
+      },
+      "content": "let fun_name2 x = x + 1
+  let f x = (fun_name2 x)",
+      "selection-range": {
+        "start": {
+          "line": 96,
+          "col": 4
+        },
+        "end": {
+          "line": 96,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 100:10 -end 100:16 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 100,
+        "col": 0
+      },
+      "end": {
+        "line": 100,
+        "col": 15
+      },
+      "content": "let fun_name2 x = x + y
+  let f x = (fun_name2 x)",
+      "selection-range": {
+        "start": {
+          "line": 100,
+          "col": 4
+        },
+        "end": {
+          "line": 100,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 102:10 -end 102:38 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 102,
+        "col": 0
+      },
+      "end": {
+        "line": 102,
+        "col": 37
+      },
+      "content": "let fun_name2 x = List.map (fun y -> y + 1) x
+  let f x = (fun_name2 x)",
+      "selection-range": {
+        "start": {
+          "line": 102,
+          "col": 4
+        },
+        "end": {
+          "line": 102,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 106:2 -end 106:7 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 104,
+        "col": 0
+      },
+      "end": {
+        "line": 106,
+        "col": 7
+      },
+      "content": "let fun_name2 y = y + 2
+  let f y =
+    let y = y + 1 in
+    (fun_name2 y)",
+      "selection-range": {
+        "start": {
+          "line": 104,
+          "col": 4
+        },
+        "end": {
+          "line": 104,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 108:11 -end 108:16 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 108,
+        "col": 0
+      },
+      "end": {
+        "line": 108,
+        "col": 16
+      },
+      "content": "let fun_name2 () = y + 1
+  let f () = (fun_name2 ())",
+      "selection-range": {
+        "start": {
+          "line": 108,
+          "col": 4
+        },
+        "end": {
+          "line": 108,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 114:2 -end 114:11 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 110,
+        "col": 0
+      },
+      "end": {
+        "line": 114,
+        "col": 15
+      },
+      "content": "let fun_name2 x m_y = x * m_y
+  let f x =
+    let module M = struct
+      let y = 0
+    end in
+    (fun_name2 x M.y) + 3",
+      "selection-range": {
+        "start": {
+          "line": 110,
+          "col": 4
+        },
+        "end": {
+          "line": 110,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 119:2 -end 119:18 -extract-name z < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 116,
+        "col": 0
+      },
+      "end": {
+        "line": 120,
+        "col": 11
+      },
+      "content": "let z1 x y = x + y
+  let f =
+    let x = 1 in
+    let y = 2 in
+    let z = (z1 x y) in
+    z + z + 1",
+      "selection-range": {
+        "start": {
+          "line": 116,
+          "col": 4
+        },
+        "end": {
+          "line": 116,
+          "col": 6
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 129:19 -end 132:71 -extract-name pp_markup < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 125,
+        "col": 0
+      },
+      "end": {
+        "line": 133,
+        "col": 7
+      },
+      "content": "let pp_markup bold_tag =
+    fun ppf markup ->
+      match markup with
+      | Text txt -> pp_print_string ppf txt
+      | Bold txt -> pp_print_string ppf (bold_tag ^ (txt ^ bold_tag))
+  let pp_document ppf doc =
+    let open Format in
+    let bold_tag = \"**\" in
+    fprintf ppf \"%a\"
+      (pp_print_list (pp_markup bold_tag))
+      doc",
+      "selection-range": {
+        "start": {
+          "line": 125,
+          "col": 4
+        },
+        "end": {
+          "line": 125,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 146:2 -end 146:26 -extract-name add < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 138,
+        "col": 0
+      },
+      "end": {
+        "line": 146,
+        "col": 26
+      },
+      "content": "let add x m_z m_mm_y = ((x * m_z) * m_mm_y) + A.a
+  let f x =
+    let module Empty = struct end in
+    let module M = struct
+      module MM = struct
+        let y = 0
+      end
+      let z = 0
+    end in
+    (add x M.z M.MM.y)",
+      "selection-range": {
+        "start": {
+          "line": 138,
+          "col": 4
+        },
+        "end": {
+          "line": 138,
+          "col": 7
+        }
+      }
+    },
+    "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": []
+  }
+
+  $ $MERLIN single refactoring-extract-region -start 128:2 -end 133:7 < func.ml
+  {
+    "class": "return",
+    "value": {
+      "start": {
+        "line": 125,
+        "col": 0
+      },
+      "end": {
+        "line": 133,
+        "col": 7
+      },
+      "content": "let fun_name2 ppf doc bold_tag =
+    fprintf ppf \"%a\"
+      (pp_print_list ?pp_sep:None
+         (fun ppf markup ->
+            match markup with
+            | Text txt -> pp_print_string ppf txt
+            | Bold txt -> pp_print_string ppf (bold_tag ^ (txt ^ bold_tag))))
+      doc
+  let pp_document ppf doc =
+    let open Format in
+    let bold_tag = \"**\" in
+    (fun_name2 ppf doc bold_tag)",
+      "selection-range": {
+        "start": {
+          "line": 125,
+          "col": 4
+        },
+        "end": {
+          "line": 125,
+          "col": 13
+        }
+      }
+    },
+    "notifications": []
+  }