Comments from @Octachron

5 files changed, 40 insertions, 46 deletions

diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 27b6e71410..dd8dac1250 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -251,9 +251,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 sty in
+  let cty  = transl_simple_type val_env ~closed:false sty in
   let ty = cty.ctyp_type in
-  let cty' = transl_simple_type val_env ~fixed:false sty' in
+  let cty' = transl_simple_type val_env ~closed:false sty' in
   let ty' = cty'.ctyp_type in
   begin
     try Ctype.unify val_env ty ty' with Ctype.Unify err ->
@@ -293,7 +293,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 sty in
+          let cty = transl_simple_type env ~closed:false 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))
@@ -317,7 +317,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 sty in
+               let cty = transl_simple_type env ~closed:false sty in
                let ty = cty.ctyp_type in
                add_method loc env lab priv virt ty sign;
                Tctf_method (lab, priv, virt, cty))
@@ -341,7 +341,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 sty in
+  let self_cty = transl_simple_type env ~closed:false sty in
   let self_type = self_cty.ctyp_type in
   begin try
     Ctype.unify env self_type sign.csig_self
@@ -391,7 +391,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 sty in
+          let cty' = transl_simple_type env ~closed:false sty in
           let ty' = cty'.ctyp_type in
           begin
            try Ctype.unify env ty' ty with Ctype.Unify err ->
@@ -411,7 +411,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 sty in
+      let cty = transl_simple_type env ~closed:false sty in
       let ty = cty.ctyp_type in
       let ty =
         if Btype.is_optional l
@@ -644,7 +644,7 @@ let rec class_field_first_pass self_loc cl_num sign self_scope acc cf =
         (fun () ->
            let cty =
              Ctype.with_local_level_if_principal
-               (fun () -> Typetexp.transl_simple_type val_env ~fixed:false styp)
+               (fun () -> Typetexp.transl_simple_type val_env ~closed:false styp)
                ~post:(fun cty -> Ctype.generalize_structure cty.ctyp_type)
            in
            add_instance_variable ~strict:true loc val_env
@@ -714,7 +714,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 sty in
+           let cty = transl_simple_type val_env ~closed:false sty in
            let ty = cty.ctyp_type in
            add_method loc val_env label.txt priv Virtual ty sign;
            let field =
@@ -754,7 +754,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 sty
+                   Typetexp.transl_simple_type val_env ~closed:false sty
                  in
                  cty'.ctyp_type
            in
@@ -1058,7 +1058,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 sty)
+          (fun sty -> transl_simple_type val_env ~closed:false sty)
           styl
       in
       let (params, clty) =
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 94b9e755b5..234ec86da6 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -3420,7 +3420,7 @@ and type_expect_
       (* Pretend separate = true, 1% slowdown for lablgtk *)
       let cty =
         with_local_level begin fun () ->
-          Typetexp.transl_simple_type env ~fixed:false sty
+          Typetexp.transl_simple_type env ~closed:false sty
         end
         ~post:(fun cty -> generalize_structure cty.ctyp_type)
       in
@@ -3739,7 +3739,7 @@ and type_expect_
             match sty with None -> protect_expansion env ty_expected, None
             | Some sty ->
                 let sty = Ast_helper.Typ.force_poly sty in
-                let cty = Typetexp.transl_simple_type env ~fixed:false sty in
+                let cty = Typetexp.transl_simple_type env ~closed:false sty in
                 cty.ctyp_type, Some cty
           end
       in
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index e39254b792..631130c6f8 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -229,7 +229,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 arg in
+         let cty = transl_simple_type env ?univars ~closed arg in
          {ld_id = Ident.create_local name.txt;
           ld_name = name; ld_mutable = mut;
           ld_type = cty; ld_loc = loc; ld_attributes = attrs}
@@ -254,7 +254,7 @@ let transl_labels env univars closed lbls =
 
 let transl_constructor_arguments env univars closed = function
   | Pcstr_tuple l ->
-      let l = List.map (transl_simple_type env ?univars ~fixed:closed) l in
+      let l = List.map (transl_simple_type env ?univars ~closed) l in
       Types.Cstr_tuple (List.map (fun t -> t.ctyp_type) l),
       Cstr_tuple l
   | Pcstr_record l ->
@@ -285,7 +285,7 @@ let make_constructor env loc type_path type_params svars sargs sret_type =
             transl_constructor_arguments env univars closed sargs
           in
           let tret_type =
-            transl_simple_type env ?univars ~fixed:closed sret_type in
+            transl_simple_type env ?univars ~closed 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
@@ -325,8 +325,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 sty,
-      transl_simple_type env ~fixed:false sty', loc)
+      transl_simple_type env ~closed:false sty,
+      transl_simple_type env ~closed:false sty', loc)
     sdecl.ptype_cstrs
   in
   let unboxed_attr = get_unboxed_from_attributes sdecl in
@@ -441,7 +441,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 sty in
+        let cty = transl_simple_type env ~closed:no_row 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 ty in
-      let cty' = transl_simple_type env ~fixed:false ty' in
+      let cty = transl_simple_type env ~closed:false ty in
+      let cty' = transl_simple_type env ~closed:false 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 sty in
+        let cty = transl_simple_type env ~closed:no_row sty in
         Some cty, Some cty.ctyp_type
   in
   (* In the second part, we check the consistency between the two
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 1799ef1f5d..2460ebf37b 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -106,12 +106,9 @@ module TyVarEnv : sig
   val remember_used : string -> type_expr -> Location.t -> unit
     (* remember that a given name is bound to a given type *)
 
-  val globalize_used_variables : globals_only:bool -> Env.t ->
-    fixed:bool -> unit -> unit
+  val globalize_used_variables : policy -> Env.t -> unit -> unit
     (* after finishing with a type signature, add used variables to the
-       global type variable scope; with globals_only, only already-in-scope
-       variables are considered (but they are still unified with the global
-       type variables *)
+       global type variable scope *)
 
 end = struct
   (** Map indexed by type variable names. *)
@@ -277,18 +274,18 @@ end = struct
     | { extensibility = Fixed } -> raise(Error(loc, env, No_type_wildcards))
     | policy -> new_var policy
 
-  let globalize_used_variables ~globals_only env ~fixed =
+  let globalize_used_variables { flavor; extensibility } env =
     let r = ref [] in
     TyVarMap.iter
       (fun name (ty, loc) ->
-        if not globals_only || is_in_scope name then
+        if flavor = Unification || is_in_scope name then
           let v = new_global_var () in
           let snap = Btype.snapshot () in
           if try unify env v ty; true with _ -> Btype.backtrack snap; false
           then try
             r := (loc, v, lookup_global_type_variable name) :: !r
           with Not_found ->
-            if fixed && Btype.is_Tvar ty then
+            if extensibility = Fixed && Btype.is_Tvar ty then
               raise(Error(loc, env,
                           Unbound_type_variable ("'"^name,
                                                  get_in_scope_names ())));
@@ -749,11 +746,11 @@ let make_fixed_univars ty =
   make_fixed_univars ty;
   Btype.unmark_type ty
 
-let transl_simple_type env ?univars ~fixed styp =
+let transl_simple_type env ?univars ~closed styp =
   TyVarEnv.reset_locals ?univars ();
-  let policy = TyVarEnv.(if fixed then fixed_policy else extensible_policy) in
+  let policy = TyVarEnv.(if closed then fixed_policy else extensible_policy) in
   let typ = transl_type env policy styp in
-  TyVarEnv.globalize_used_variables ~globals_only:false env ~fixed ();
+  TyVarEnv.globalize_used_variables policy env ();
   make_fixed_univars typ.ctyp_type;
   typ
 
@@ -762,12 +759,9 @@ let transl_simple_type_univars env styp =
   let typ, univs =
     TyVarEnv.collect_univars begin fun () ->
       with_local_level ~post:generalize_ctyp begin fun () ->
-        let typ = transl_type env TyVarEnv.univars_policy styp in
-        (* Globalize only local occurrences of variables that are already in
-           global scope; others will be univars and dealt with in
-           make_fixed_univars. *)
-        TyVarEnv.globalize_used_variables
-          ~globals_only:true env ~fixed:false ();
+        let policy = TyVarEnv.univars_policy in
+        let typ = transl_type env policy styp in
+        TyVarEnv.globalize_used_variables policy env ();
         typ
       end
   end in
@@ -779,13 +773,13 @@ let transl_simple_type_delayed env styp =
   TyVarEnv.reset_locals ();
   let typ, force =
     with_local_level begin fun () ->
-      let typ = transl_type env TyVarEnv.extensible_policy styp in
+      let policy = TyVarEnv.extensible_policy in
+      let typ = transl_type env policy styp in
       make_fixed_univars typ.ctyp_type;
       (* This brings the used variables to the global level, but doesn't link
          them to their other occurrences just yet. This will be done when
          [force] is  called. *)
-      let force = TyVarEnv.globalize_used_variables
-                    ~globals_only:false env ~fixed:false in
+      let force = TyVarEnv.globalize_used_variables policy env in
       (typ, force)
     end
     (* Generalize everything except the variables that were just globalized. *)
@@ -801,7 +795,7 @@ let transl_type_scheme env styp =
      let univars, typ =
        with_local_level begin fun () ->
          let univars = TyVarEnv.make_poly_univars vars in
-         let typ = transl_simple_type env ~univars ~fixed:true st in
+         let typ = transl_simple_type env ~univars ~closed:true st in
          (univars, typ)
        end
        ~post:(fun (_,typ) -> generalize_ctyp typ)
@@ -813,7 +807,7 @@ let transl_type_scheme env styp =
        ctyp_loc = styp.ptyp_loc;
        ctyp_attributes = styp.ptyp_attributes }
   | _ ->
-      with_local_level (fun () -> transl_simple_type env ~fixed:false styp)
+      with_local_level (fun () -> transl_simple_type env ~closed:false styp)
         ~post:generalize_ctyp
 
 
@@ -828,7 +822,7 @@ let report_error env ppf = function
       name
       did_you_mean (fun () -> Misc.spellcheck in_scope_names name )
   | No_type_wildcards ->
-    fprintf ppf "A type wildcard \"_\" is not allowed here."
+    fprintf ppf "A type wildcard \"_\" is not allowed in this type declaration."
   | Undefined_type_constructor p ->
     fprintf ppf "The type constructor@ %a@ is not yet completely defined"
       path p
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index df20dfa6f2..ca058a5cf0 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -48,7 +48,7 @@ end
 val valid_tyvar_name : string -> bool
 
 val transl_simple_type:
-        Env.t -> ?univars:TyVarEnv.poly_univars -> fixed:bool
+        Env.t -> ?univars:TyVarEnv.poly_univars -> closed:bool
         -> Parsetree.core_type -> Typedtree.core_type
 val transl_simple_type_univars:
         Env.t -> Parsetree.core_type -> Typedtree.core_type