add label to newty2

typing/btype.ml

@@ -83,7 +83,7 @@ let pivot_level = 2 * lowest_level - 1
 
 (**** Some type creators ****)
 
-let newgenty desc      = newty2 generic_level desc
+let newgenty desc      = newty2 ~level:generic_level desc
 let newgenvar ?name () = newgenty (Tvar name)
 let newgenstub ~scope  = newty3 ~level:generic_level ~scope (Tvar None)
 

typing/ctype.ml

@@ -213,11 +213,11 @@ let proper_abbrevs path tl abbrev =
 
 (* Re-export generic type creators *)
 
-let newty desc              = newty2 !current_level desc
+let newty desc              = newty2 ~level:!current_level desc
 
-let newvar ?name ()         = newty2 !current_level (Tvar name)
-let newvar2 ?name level     = newty2 level (Tvar name)
-let new_global_var ?name () = newty2 !global_level (Tvar name)
+let newvar ?name ()         = newty2 ~level:!current_level (Tvar name)
+let newvar2 ?name level     = newty2 ~level:level (Tvar name)
+let new_global_var ?name () = newty2 ~level:!global_level (Tvar name)
 let newstub ~scope          = newty3 ~level:!current_level ~scope (Tvar None)
 
 let newobj fields      = newty (Tobject (fields, ref None))
@@ -306,7 +306,7 @@ let flatten_fields ty =
 
 let build_fields level =
   List.fold_right
-    (fun (s, k, ty1) ty2 -> newty2 level (Tfield(s, k, ty1, ty2)))
+    (fun (s, k, ty1) ty2 -> newty2 ~level (Tfield(s, k, ty1, ty2)))
 
 let associate_fields fields1 fields2 =
   let rec associate p s s' =
@@ -359,7 +359,7 @@ let close_object ty =
   let rec close ty =
     match get_desc ty with
       Tvar _ ->
-        link_type ty (newty2 (get_level ty) Tnil); true
+        link_type ty (newty2 ~level:(get_level ty) Tnil); true
     | Tfield(lab, _, _, _) when lab = dummy_method ->
         false
     | Tfield(_, _, _, ty') -> close ty'
@@ -760,7 +760,7 @@ let rec check_scope_escape env level ty =
         let p' = normalize_package_path env p in
         if Path.same p p' then raise_escape_exn (Module_type p);
         check_scope_escape env level
-          (newty2 orig_level (Tpackage (p', fl)))
+          (newty2 ~level:orig_level (Tpackage (p', fl)))
     | _ ->
         iter_type_expr (check_scope_escape env level) ty
     end;
@@ -1074,7 +1074,7 @@ let rec copy ?partial ?keep_names scope ty =
             if keep then level else !current_level
           else generic_level
     in
-    if forget <> generic_level then newty2 forget (Tvar None) else
+    if forget <> generic_level then newty2 ~level:forget (Tvar None) else
     let desc = get_desc ty in
     let t = newstub ~scope:(get_scope ty) in
     For_copy.redirect_desc scope ty (Tsubst (t, None));
@@ -1573,7 +1573,7 @@ let expand_abbrev_gen kind find_type_expansion env ty =
             (* another way to expand is to normalize the path itself *)
             let path' = Env.normalize_type_path None env path in
             if Path.same path path' then raise Cannot_expand
-            else newty2 level (Tconstr (path', args, abbrev))
+            else newty2 ~level (Tconstr (path', args, abbrev))
           | (params, body, lv) ->
             (* prerr_endline
               ("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
@@ -1725,7 +1725,7 @@ let full_expand ~may_forget_scope env ty =
   in
   match get_desc ty with
     Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar v ->
-      newty2 (get_level ty) (Tobject (fi, ref None))
+      newty2 ~level:(get_level ty) (Tobject (fi, ref None))
   | _ ->
       ty
 
@@ -2046,7 +2046,7 @@ let polyfy env ty vars =
   For_copy.with_scope (fun scope ->
     let vars' = List.filter_map (subst_univar scope) vars in
     let ty = copy scope ty in
-    let ty = newty2 (get_level ty) (Tpoly(ty, vars')) in
+    let ty = newty2 ~level:(get_level ty) (Tpoly(ty, vars')) in
     let complete = List.length vars = List.length vars' in
     ty, complete
   )
@@ -2121,7 +2121,7 @@ let reify env t =
       Env.enter_type (get_new_abstract_name name) decl !env
         ~scope:fresh_constr_scope in
     let path = Path.Pident id in
-    let t = newty2 lev (Tconstr (path,[],ref Mnil))  in
+    let t = newty2 ~level:lev (Tconstr (path,[],ref Mnil))  in
     env := new_env;
     path, t
   in
@@ -2148,7 +2148,7 @@ let reify env t =
                 let row =
                   let row_fixed = Some (Reified path) in
                   {r with row_fields=[]; row_fixed; row_more = t} in
-                link_type m (newty2 level (Tvariant row));
+                link_type m (newty2 ~level (Tvariant row));
                 if level < fresh_constr_scope then
                   raise_for Unify (Escape (escape (Constructor path)))
             | _ -> assert false
@@ -2889,7 +2889,7 @@ and make_rowvar level use1 rest1 use2 rest2  =
     | _ -> None
   in
   if use1 then rest1 else
-  if use2 then rest2 else Types.newty2 level (Tvar name)
+  if use2 then rest2 else newty2 ~level (Tvar name)
 
 and unify_fields env ty1 ty2 =          (* Optimization *)
   let (fields1, rest1) = flatten_fields ty1
@@ -2949,7 +2949,8 @@ and unify_row env row1 row2 =
     | Some _, Some _ -> if get_level rm2 < get_level rm1 then rm2 else rm1
     | Some _, None -> rm1
     | None, Some _ -> rm2
-    | None, None -> newty2 (min (get_level rm1) (get_level rm2)) (Tvar None)
+    | None, None ->
+        newty2 ~level:(min (get_level rm1) (get_level rm2)) (Tvar None)
   in
   let fixed = merge_fixed_explanation fixed1 fixed2
   and closed = row1.row_closed || row2.row_closed in
@@ -3027,7 +3028,7 @@ and unify_row env row1 row2 =
       pairs;
     if static_row row1 then begin
       let rm = row_more row1 in
-      if is_Tvar rm then link_type rm (newty2 (get_level rm) Tnil)
+      if is_Tvar rm then link_type rm (newty2 ~level:(get_level rm) Tnil)
     end
   with exn ->
     Transient_expr.set_desc tm1 md1;
@@ -3206,7 +3207,7 @@ let filter_arrow env t l =
     Tvar _ ->
       let lv = get_level t in
       let t1 = newvar2 lv and t2 = newvar2 lv in
-      let t' = newty2 lv (Tarrow (l, t1, t2, Cok)) in
+      let t' = newty2 ~level:lv (Tarrow (l, t1, t2, Cok)) in
       link_type t t';
       (t1, t2)
   | Tarrow(l', t1, t2, _)
@@ -3222,7 +3223,7 @@ let rec filter_method_field env name priv ty =
     Tvar _ ->
       let level = get_level ty in
       let ty1 = newvar2 level and ty2 = newvar2 level in
-      let ty' = newty2 level (Tfield (name,
+      let ty' = newty2 ~level (Tfield (name,
                                       begin match priv with
                                         Private -> Fvar (ref None)
                                       | Public  -> Fpresent
@@ -3524,10 +3525,10 @@ let rec rigidify_rec vars ty =
         let row = row_repr row in
         let more = row.row_more in
         if is_Tvar more && not (row_fixed row) then begin
-          let more' = newty2 (get_level more) (get_desc more) in
+          let more' = newty2 ~level:(get_level more) (get_desc more) in
           let row' =
             {row with row_fixed=Some Rigid; row_fields=[]; row_more=more'}
-          in link_type more (newty2 (get_level ty) (Tvariant row'))
+          in link_type more (newty2 ~level:(get_level ty) (Tvariant row'))
         end;
         iter_row (rigidify_rec vars) row;
         (* only consider the row variable if the variant is not static *)
@@ -4350,8 +4351,9 @@ let rec subtype_rec env trace t1 t2 cstrs =
               let (co, cn) = Variance.get_upper v in
               if co then
                 if cn then
-                  (trace, newty2 (get_level t1) (Ttuple[t1]),
-                   newty2 (get_level t2) (Ttuple[t2]), !univar_pairs) :: cstrs
+                  (trace, newty2 ~level:(get_level t1) (Ttuple[t1]),
+                   newty2 ~level:(get_level t2) (Ttuple[t2]), !univar_pairs)
+                  :: cstrs
                 else subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
               else
                 if cn
@@ -4518,9 +4520,9 @@ let rec unalias_object ty =
   let level = get_level ty in
   match get_desc ty with
     Tfield (s, k, t1, t2) ->
-      newty2 level (Tfield (s, k, t1, unalias_object t2))
+      newty2 ~level (Tfield (s, k, t1, unalias_object t2))
   | Tvar _ | Tnil as desc ->
-      newty2 level desc
+      newty2 ~level desc
   | Tunivar _ ->
       ty
   | Tconstr _ ->
@@ -4536,12 +4538,13 @@ let unalias ty =
   | Tvariant row ->
       let row = row_repr row in
       let more = row.row_more in
-      newty2 level
-        (Tvariant {row with row_more = newty2 (get_level more) (get_desc more)})
+      newty2 ~level
+        (Tvariant {row with
+                   row_more = newty2 ~level:(get_level more) (get_desc more)})
   | Tobject (ty, nm) ->
-      newty2 level (Tobject (unalias_object ty, nm))
+      newty2 ~level (Tobject (unalias_object ty, nm))
   | desc ->
-      newty2 level desc
+      newty2 ~level desc
 
 (* Return the arity (as for curried functions) of the given type. *)
 let rec arity ty =
@@ -4703,7 +4706,7 @@ let rec nondep_type_rec ?(expand_private=false) env ids ty =
           with (Nondep_cannot_erase _) as exn ->
             (* If that doesn't work, try expanding abbrevs *)
             try Tlink (nondep_type_rec ~expand_private env ids
-                         (try_expand env (newty2 (get_level ty) desc)))
+                         (try_expand env (newty2 ~level:(get_level ty) desc)))
               (*
                  The [Tlink] is important. The expanded type may be a
                  variable, or may not be completely copied yet

typing/printtyp.ml

@@ -1189,7 +1189,7 @@ let filter_params tyl =
     List.fold_left
       (fun tyl ty ->
         if List.exists (eq_type ty) tyl
-        then newty2 generic_level (Ttuple [ty]) :: tyl
+        then newty2 ~level:generic_level (Ttuple [ty]) :: tyl
         else ty :: tyl)
       (* Two parameters might be identical due to a constraint but we need to
          print them differently in order to make the output syntactically valid.
@@ -2071,7 +2071,7 @@ let type_path_list =
 let hide_variant_name t =
   match get_desc t with
   | Tvariant row when (row_repr row).row_name <> None ->
-      newty2 (get_level t)
+      newty2 ~level:(get_level t)
         (Tvariant {(row_repr row) with row_name = None;
                    row_more = newvar2 (get_level (row_more row))})
   | _ -> t

typing/subst.ml

@@ -154,7 +154,7 @@ let rec typexp copy_scope s ty =
       if s.for_saving || get_id ty < 0 then
         let ty' =
           if s.for_saving then newpersty (norm desc)
-          else newty2 (get_level ty) desc
+          else newty2 ~level:(get_level ty) desc
         in
         For_copy.redirect_desc copy_scope ty (Tsubst (ty', None));
         ty'

typing/typecore.ml

@@ -4423,7 +4423,7 @@ and type_application env funct sargs =
   (* funct.exp_type may be generic *)
   let result_type omitted ty_fun =
     List.fold_left
-      (fun ty_fun (l,ty,lv) -> newty2 lv (Tarrow(l,ty,ty_fun,Cok)))
+      (fun ty_fun (l,ty,lv) -> newty2 ~level:lv (Tarrow(l,ty,ty_fun,Cok)))
       ty_fun omitted
   in
   let has_label l ty_fun =

typing/typedecl.ml

@@ -790,10 +790,10 @@ let name_recursion sdecl id decl =
   | { type_kind = Type_abstract;
       type_manifest = Some ty;
       type_private = Private; } when is_fixed_type sdecl ->
-    let ty' = newty2 (get_level ty) (get_desc ty) in
+    let ty' = newty2 ~level:(get_level ty) (get_desc ty) in
     if Ctype.deep_occur ty ty' then
       let td = Tconstr(Path.Pident id, decl.type_params, ref Mnil) in
-      link_type ty (newty2 (get_level ty) td);
+      link_type ty (newty2 ~level:(get_level ty) td);
       {decl with type_manifest = Some ty'}
     else decl
   | _ -> decl

typing/types.ml

@@ -577,7 +577,7 @@ let newty3 ~level ~scope desc  =
   incr new_id;
   create_expr desc ~level ~scope ~id:!new_id
 
-let newty2 level desc =
+let newty2 ~level desc =
   newty3 ~level ~scope:Ident.lowest_scope desc
 
                   (**********************************)

typing/types.mli

@@ -271,7 +271,7 @@ val create_expr: type_desc -> level: int -> scope: int -> id: int -> type_expr
 val newty3: level:int -> scope:int -> type_desc -> type_expr
         (** Create a type with a fresh id *) 
 
-val newty2: int -> type_desc -> type_expr
+val newty2: level:int -> type_desc -> type_expr
         (** Create a type with a fresh id and no scope *)
 
 val field_kind_repr: field_kind -> field_kind