Incorporate upstream comments into type-variable refactor (ocaml-flam…

…bda#121)

* Comments from upstream review of tyvars patch

* @stedolan's comments

typing/typeclass.ml

@@ -259,9 +259,9 @@ let unify_delayed_method_type loc env label ty expected_ty=
       raise(Error(loc, env, Field_type_mismatch ("method", label, trace)))
 
 let type_constraint val_env sty sty' loc =
-  let cty  = transl_simple_type val_env ~fixed:false Global sty in
+  let cty  = transl_simple_type val_env ~closed:false Global sty in
   let ty = cty.ctyp_type in
-  let cty' = transl_simple_type val_env ~fixed:false Global sty' in
+  let cty' = transl_simple_type val_env ~closed:false Global sty' in
   let ty' = cty'.ctyp_type in
   begin
     try Ctype.unify val_env ty ty' with Ctype.Unify err ->
@@ -301,7 +301,7 @@ let rec class_type_field env sign self_scope ctf =
   | Pctf_val ({txt=lab}, mut, virt, sty) ->
       mkctf_with_attrs
         (fun () ->
-          let cty = transl_simple_type env ~fixed:false Global sty in
+          let cty = transl_simple_type env ~closed:false Global sty in
           let ty = cty.ctyp_type in
           add_instance_variable ~strict:false loc env lab mut virt ty sign;
           Tctf_val (lab, mut, virt, cty))
@@ -325,7 +325,7 @@ let rec class_type_field env sign self_scope ctf =
                  ) :: !delayed_meth_specs;
                Tctf_method (lab, priv, virt, returned_cty)
            | _ ->
-               let cty = transl_simple_type env ~fixed:false Global sty in
+               let cty = transl_simple_type env ~closed:false Global sty in
                let ty = cty.ctyp_type in
                add_method loc env lab priv virt ty sign;
                Tctf_method (lab, priv, virt, cty))
@@ -349,7 +349,7 @@ and class_signature virt env pcsig self_scope loc =
   (* Introduce a dummy method preventing self type from being closed. *)
   Ctype.add_dummy_method env ~scope:self_scope sign;
 
-  let self_cty = transl_simple_type env ~fixed:false Global sty in
+  let self_cty = transl_simple_type env ~closed:false Global sty in
   let self_type = self_cty.ctyp_type in
   begin try
     Ctype.unify env self_type sign.csig_self
@@ -399,7 +399,7 @@ and class_type_aux env virt self_scope scty =
                                                    List.length styl)));
       let ctys = List.map2
         (fun sty ty ->
-          let cty' = transl_simple_type env ~fixed:false Global sty in
+          let cty' = transl_simple_type env ~closed:false Global sty in
           let ty' = cty'.ctyp_type in
           begin
            try Ctype.unify env ty' ty with Ctype.Unify err ->
@@ -419,7 +419,7 @@ and class_type_aux env virt self_scope scty =
       cltyp (Tcty_signature clsig) typ
 
   | Pcty_arrow (l, sty, scty) ->
-      let cty = transl_simple_type env ~fixed:false Global sty in
+      let cty = transl_simple_type env ~closed:false Global sty in
       let ty = cty.ctyp_type in
       let ty =
         if Btype.is_optional l
@@ -651,7 +651,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
       with_attrs
         (fun () ->
            if !Clflags.principal then Ctype.begin_def ();
-           let cty = Typetexp.transl_simple_type val_env ~fixed:false Global styp in
+           let cty = Typetexp.transl_simple_type val_env ~closed:false Global styp in
            let ty = cty.ctyp_type in
            if !Clflags.principal then begin
              Ctype.end_def ();
@@ -725,7 +725,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
       with_attrs
         (fun () ->
            let sty = Ast_helper.Typ.force_poly sty in
-           let cty = transl_simple_type val_env ~fixed:false Global sty in
+           let cty = transl_simple_type val_env ~closed:false Global sty in
            let ty = cty.ctyp_type in
            add_method loc val_env label.txt priv Virtual ty sign;
            let field =
@@ -765,7 +765,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
              | Some sty ->
                  let sty = Ast_helper.Typ.force_poly sty in
                  let cty' =
-                   Typetexp.transl_simple_type val_env ~fixed:false Global sty
+                   Typetexp.transl_simple_type val_env ~closed:false Global sty
                  in
                  cty'.ctyp_type
            in
@@ -1073,7 +1073,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
       if Path.same decl.cty_path unbound_class then
         raise(Error(scl.pcl_loc, val_env, Unbound_class_2 lid.txt));
       let tyl = List.map
-          (fun sty -> transl_simple_type val_env ~fixed:false Global sty)
+          (fun sty -> transl_simple_type val_env ~closed:false Global sty)
           styl
       in
       let (params, clty) =
@@ -1375,11 +1375,11 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
          }
   | Pcl_constraint (scl', scty) ->
       Ctype.begin_class_def ();
-      let cl = Typetexp.TyVarEnv.narrow_in (fun () ->
+      let cl = Typetexp.TyVarEnv.with_local_scope (fun () ->
         let cl = class_expr cl_num val_env met_env virt self_scope scl' in
         complete_class_type cl.cl_loc val_env virt Class_type cl.cl_type;
         cl) in
-      let clty = Typetexp.TyVarEnv.narrow_in (fun () ->
+      let clty = Typetexp.TyVarEnv.with_local_scope (fun () ->
         let clty = class_type val_env virt self_scope scty in
         complete_class_type clty.cltyp_loc val_env virt Class clty.cltyp_type;
         clty) in

typing/typecore.ml

@@ -3294,7 +3294,7 @@ let rec approx_type env sty =
           (* Polymorphic types will only unify with types that match all of their
            polymorphic parts, so we need to fully translate the type here
            unlike in the monomorphic case *)
-          Typetexp.transl_simple_type env ~fixed:false arg_mode arg_sty
+          Typetexp.transl_simple_type env ~closed:false arg_mode arg_sty
         in
         let ret = approx_type env sty in
         let marg = Alloc_mode.of_const arg_mode in
@@ -3335,7 +3335,7 @@ let type_pattern_approx env spat ty_expected =
         else Alloc_mode.Global
       in
       let ty_pat =
-        Typetexp.transl_simple_type env ~fixed:false arg_type_mode sty
+        Typetexp.transl_simple_type env ~closed:false arg_type_mode sty
       in
       begin try unify env ty_pat.ctyp_type ty_expected with Unify trace ->
         raise(Error(spat.ppat_loc, env, Pattern_type_clash(trace, None)))
@@ -4543,7 +4543,7 @@ and type_expect_
         if has_local_attr_exp sexp then Alloc_mode.Local
         else Alloc_mode.Global
       in
-      let cty = Typetexp.transl_simple_type env ~fixed:false type_mode sty in
+      let cty = Typetexp.transl_simple_type env ~closed:false type_mode sty in
       let ty = cty.ctyp_type in
       end_def ();
       generalize_structure ty;
@@ -4836,7 +4836,7 @@ and type_expect_
       let ty = newvar() in
       (* remember original level *)
       begin_def ();
-      let modl, pres, id, new_env = Typetexp.TyVarEnv.narrow_in begin fun () ->
+      let modl, pres, id, new_env = Typetexp.TyVarEnv.with_local_scope begin fun () ->
         let modl, md_shape = !type_module env smodl in
         Mtype.lower_nongen (get_level ty) modl.mod_type;
         let pres =
@@ -4936,7 +4936,7 @@ and type_expect_
         match sty with None -> ty_expected, None
         | Some sty ->
             let sty = Ast_helper.Typ.force_poly sty in
-            let cty = Typetexp.transl_simple_type env ~fixed:false Global sty in
+            let cty = Typetexp.transl_simple_type env ~closed:false Global sty in
             cty.ctyp_type, Some cty
       in
       if !Clflags.principal then begin
@@ -6215,7 +6215,7 @@ and type_unpacks ?(in_function : (Location.t * type_expr * bool) option)
   let extended_env, tunpacks =
     List.fold_left (fun (env, tunpacks) unpack ->
       begin_def ();
-      Typetexp.TyVarEnv.narrow_in begin fun () ->
+      Typetexp.TyVarEnv.with_local_scope begin fun () ->
         let modl, md_shape =
           !type_module env
             Ast_helper.(

typing/typedecl.ml

@@ -237,7 +237,7 @@ let transl_labels env univars closed lbls =
     Builtin_attributes.warning_scope attrs
       (fun () ->
          let arg = Ast_helper.Typ.force_poly arg in
-         let cty = transl_simple_type env ?univars ~fixed:closed Global arg in
+         let cty = transl_simple_type env ?univars ~closed Global arg in
          let gbl =
            match mut with
            | Mutable -> Types.Global
@@ -268,7 +268,7 @@ let transl_labels env univars closed lbls =
 
 let transl_types_gf env univars closed tyl =
   let mk arg =
-    let cty = transl_simple_type env ?univars ~fixed:closed Global arg in
+    let cty = transl_simple_type env ?univars ~closed Global arg in
     let gf = transl_global_flags arg.ptyp_loc arg.ptyp_attributes in
     (cty, gf)
   in
@@ -293,7 +293,7 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
         transl_constructor_arguments env None true sargs
       in
         targs, None, args, None
-  | Some sret_type -> TyVarEnv.narrow_in begin fun () ->
+  | Some sret_type -> TyVarEnv.with_local_scope begin fun () ->
       (* if it's a generalized constructor we must work in a narrowed
          context so as to not introduce any new constraints *)
       TyVarEnv.reset ();
@@ -307,7 +307,7 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
       let args, targs =
         transl_constructor_arguments env univars closed sargs
       in
-      let tret_type = transl_simple_type env ?univars ~fixed:closed Global sret_type in
+      let tret_type = transl_simple_type env ?univars ~closed Global sret_type in
       let ret_type = tret_type.ctyp_type in
       (* TODO add back type_path as a parameter ? *)
       begin match get_desc ret_type with
@@ -331,7 +331,7 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
          Ctype.end_def();
          Btype.iter_type_expr_cstr_args Ctype.generalize args;
          Ctype.generalize ret_type;
-         let _vars = instance_poly_univars env loc univars in
+         let _vars = TyVarEnv.instance_poly_univars env loc univars in
          let set_level t = Ctype.unify_var env (Ctype.newvar()) t in
          Btype.iter_type_expr_cstr_args set_level args;
          set_level ret_type;
@@ -347,8 +347,8 @@ let transl_declaration env sdecl (id, uid) =
   let params = List.map (fun (cty, _) -> cty.ctyp_type) tparams in
   let cstrs = List.map
     (fun (sty, sty', loc) ->
-      transl_simple_type env ~fixed:false Global sty,
-      transl_simple_type env ~fixed:false Global sty', loc)
+      transl_simple_type env ~closed:false Global sty,
+      transl_simple_type env ~closed:false Global sty', loc)
     sdecl.ptype_cstrs
   in
   let unboxed_attr = get_unboxed_from_attributes sdecl in
@@ -463,7 +463,7 @@ let transl_declaration env sdecl (id, uid) =
         None -> None, None
       | Some sty ->
         let no_row = not (is_fixed_type sdecl) in
-        let cty = transl_simple_type env ~fixed:no_row Global sty in
+        let cty = transl_simple_type env ~closed:no_row Global sty in
         Some cty, Some cty.ctyp_type
     in
     let arity = List.length params in
@@ -1499,8 +1499,8 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
   let arity = List.length params in
   let constraints =
     List.map (fun (ty, ty', loc) ->
-      let cty = transl_simple_type env ~fixed:false Global ty in
-      let cty' = transl_simple_type env ~fixed:false Global ty' in
+      let cty = transl_simple_type env ~closed:false Global ty in
+      let cty' = transl_simple_type env ~closed:false Global ty' in
       (* Note: We delay the unification of those constraints
          after the unification of parameters, so that clashing
          constraints report an error on the constraint location
@@ -1512,7 +1512,7 @@ let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
   let (tman, man) =  match sdecl.ptype_manifest with
       None -> None, None
     | Some sty ->
-        let cty = transl_simple_type env ~fixed:no_row Global sty in
+        let cty = transl_simple_type env ~closed:no_row Global sty in
         Some cty, Some cty.ctyp_type
   in
   (* In the second part, we check the consistency between the two

typing/typemod.ml

@@ -3037,7 +3037,7 @@ let type_package env m p fl =
   (* Same as Pexp_letmodule *)
   (* remember original level *)
   Ctype.begin_def ();
-  let modl, scope = Typetexp.TyVarEnv.narrow_in begin fun () ->
+  let modl, scope = Typetexp.TyVarEnv.with_local_scope begin fun () ->
     let modl, _mod_shape = type_module env m in
     let scope = Ctype.create_scope () in
     modl, scope