Track the "newtype level" in the environment again

15 files changed, 99 insertions, 110 deletions

diff --git a/testsuite/tests/typing-gadts/pr7222.ml b/testsuite/tests/typing-gadts/pr7222.ml
index 290f4448a5..4316e10e53 100644
--- a/testsuite/tests/typing-gadts/pr7222.ml
+++ b/testsuite/tests/typing-gadts/pr7222.ml
@@ -38,7 +38,6 @@ Line _, characters 6-22:
     let Cons(Elt dim, _) = sh in ()
         ^^^^^^^^^^^^^^^^
 Error: This pattern matches values of type ('a -> $0 -> nil) t
-       but a pattern was expected which matches values of type
-         ('a -> 'b -> nil) t
+       but a pattern was expected which matches values of type 'b
        The type constructor $0 would escape its scope
 |}];;
diff --git a/typing/ctype.ml b/typing/ctype.ml
index f53631be97..ce4e584e39 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -684,8 +684,15 @@ let forward_try_expand_once = (* Forward declaration *)
       module M = struct type t let _ = (x : t list ref) end
     (without this constraint, the type system would actually be unsound.)
 *)
-let get_path_scope p =
-  Path.binding_time p
+let get_path_scope env p =
+  try
+    match (Env.find_type p env).type_newtype_level with
+      | None -> Path.binding_time p
+      | Some (x, _) -> x
+  with
+    | Not_found ->
+      (* no newtypes in predef *)
+      Path.binding_time p
 
 let rec normalize_package_path env p =
   let t =
@@ -745,7 +752,7 @@ let rec update_level env level expand ty =
     | None -> ()
     end;
     match ty.desc with
-      Tconstr(p, _tl, _abbrev) when level < get_path_scope p ->
+      Tconstr(p, _tl, _abbrev) when level < get_path_scope env p ->
         (* Try first to replace an abbreviation by its expansion. *)
         begin try
           link_type ty (!forward_try_expand_once env ty);
@@ -767,13 +774,13 @@ let rec update_level env level expand ty =
         log_type ty; ty.desc <- Tpackage (p', nl, tl);
         update_level env level expand ty
     | Tobject(_, ({contents=Some(p, _tl)} as nm))
-      when level < get_path_scope p ->
+      when level < get_path_scope env p ->
         set_name nm None;
         update_level env level expand ty
     | Tvariant row ->
         let row = row_repr row in
         begin match row.row_name with
-        | Some (p, _tl) when level < get_path_scope p ->
+        | Some (p, _tl) when level < get_path_scope env p ->
             log_type ty;
             ty.desc <- Tvariant {row with row_name = None}
         | _ -> ()
@@ -1129,7 +1136,7 @@ let get_new_abstract_name s =
   if index = 0 && s <> "" && s.[String.length s - 1] <> '$' then s else
   Printf.sprintf "%s%d" s index
 
-let new_declaration expansion_scope manifest =
+let new_declaration newtype manifest =
   {
     type_params = [];
     type_arity = 0;
@@ -1137,8 +1144,7 @@ let new_declaration expansion_scope manifest =
     type_private = Public;
     type_manifest = manifest;
     type_variance = [];
-    type_is_newtype = true;
-    type_expansion_scope = expansion_scope;
+    type_newtype_level = newtype;
     type_loc = Location.none;
     type_attributes = [];
     type_immediate = false;
@@ -1148,9 +1154,9 @@ let new_declaration expansion_scope manifest =
 let instance_constructor ?in_pattern cstr =
   begin match in_pattern with
   | None -> ()
-  | Some (env, expansion_scope) ->
+  | Some (env, newtype_lev) ->
       let process existential =
-        let decl = new_declaration (Some expansion_scope) None in
+        let decl = new_declaration (Some (newtype_lev, newtype_lev)) None in
         let name =
           match repr existential with
             {desc = Tvar (Some name)} -> "$" ^ cstr.cstr_name ^ "_'" ^ name
@@ -1943,19 +1949,26 @@ let deep_occur t0 ty =
       information is indeed lost, but it probably does not worth it.
 *)
 
+let newtype_level = ref None
+
+let get_newtype_level () =
+  match !newtype_level with
+  | None -> assert false
+  | Some x -> x
+
 (* a local constraint can be added only if the rhs
    of the constraint does not contain any Tvars.
    They need to be removed using this function *)
 let reify env t =
+  let newtype_level = get_newtype_level () in
   let create_fresh_constr lev name =
+    let decl = new_declaration (Some (newtype_level, newtype_level)) None in
     let name = match name with Some s -> "$'"^s | _ -> "$" in
     let path = Path.Pident (Ident.create (get_new_abstract_name name)) in
-    let binding_time = Ident.current_time () in
-    let decl = new_declaration (Some binding_time) None in
     let new_env = Env.add_local_type path decl !env in
     let t = newty2 lev (Tconstr (path,[],ref Mnil))  in
     env := new_env;
-    t, binding_time
+    t
   in
   let visited = ref TypeSet.empty in
   let rec iterator ty =
@@ -1964,9 +1977,9 @@ let reify env t =
       visited := TypeSet.add ty !visited;
       match ty.desc with
         Tvar o ->
-          let t, binding_time = create_fresh_constr ty.level o in
+          let t = create_fresh_constr ty.level o in
           link_type ty t;
-          if ty.level < binding_time then
+          if ty.level < newtype_level then
             raise (Unify [t, newvar2 ty.level])
       | Tvariant r ->
           let r = row_repr r in
@@ -1975,11 +1988,11 @@ let reify env t =
             let m = r.row_more in
             match m.desc with
               Tvar o ->
-                let t, binding_time = create_fresh_constr m.level o in
+                let t = create_fresh_constr m.level o in
                 let row =
                   {r with row_fields=[]; row_fixed=true; row_more = t} in
                 link_type m (newty2 m.level (Tvariant row));
-                if m.level < binding_time then
+                if m.level < newtype_level then
                   raise (Unify [t, newvar2 m.level])
             | _ -> assert false
           end;
@@ -1995,14 +2008,14 @@ let reify env t =
 let is_newtype env p =
   try
     let decl = Env.find_type p env in
-    decl.type_expansion_scope <> None &&
+    decl.type_newtype_level <> None &&
     decl.type_kind = Type_abstract &&
     decl.type_private = Public
   with Not_found -> false
 
 let non_aliasable p decl =
   (* in_pervasives p ||  (subsumed by in_current_module) *)
-  in_current_module p && not decl.type_is_newtype
+  in_current_module p && decl.type_newtype_level = None
 
 let is_instantiable env p =
   try
@@ -2245,27 +2258,22 @@ let find_lowest_level ty =
     end
   in find ty; unmark_type ty; !lowest
 
-let find_expansion_scope env path =
-  match (Env.find_type path env).type_expansion_scope with
-  | Some x -> x
-  | None -> assert false
-
-let gadt_equations_level = ref None
-
-let get_gadt_equations_level () =
-  match !gadt_equations_level with
+let find_expansion_level env path =
+  (* always guarded by a call to [is_newtype], so we *always* have a newtype
+     level. *)
+  match (Env.find_type path env).type_newtype_level with
+  | Some (_, x) -> x
   | None -> assert false
-  | Some x -> x
 
 let add_gadt_equation env source destination =
   (* Format.eprintf "@[add_gadt_equation %s %a@]@."
     (Path.name source) !Btype.print_raw destination; *)
   if local_non_recursive_abbrev !env source destination then begin
     let destination = duplicate_type destination in
-    let expansion_scope =
-      max (Path.binding_time source) (get_gadt_equations_level ())
+    let source_lev = get_path_scope !env source in
+    let decl =
+      new_declaration (Some (source_lev, get_newtype_level ())) (Some destination)
     in
-    let decl = new_declaration (Some expansion_scope) (Some destination) in
     env := Env.add_local_type source decl !env;
     cleanup_abbrev ()
   end
@@ -2412,7 +2420,7 @@ let rec unify (env:Env.t ref) t1 t2 =
       && is_newtype !env p1 && is_newtype !env p2 ->
         (* Do not use local constraints more than necessary *)
         begin try
-          if find_expansion_scope !env p1 > find_expansion_scope !env p2 then
+          if find_expansion_level !env p1 > find_expansion_level !env p2 then
             unify env t1 (try_expand_once !env t2)
           else
             unify env (try_expand_once !env t1) t2
@@ -2532,7 +2540,7 @@ and unify3 env t1 t1' t2 t2' =
         when is_instantiable !env path && is_instantiable !env path'
         && !generate_equations ->
           let source, destination =
-            if get_path_scope path > get_path_scope path'
+            if get_path_scope !env path > get_path_scope !env path'
             then  path , t2'
             else  path', t1'
           in
@@ -2860,16 +2868,16 @@ let unify env ty1 ty2 =
       undo_compress snap;
       raise (Unification_recursive_abbrev (expand_trace !env [(ty1,ty2)]))
 
-let unify_gadt ~equations_level:lev (env:Env.t ref) ty1 ty2 =
+let unify_gadt ~newtype_level:lev (env:Env.t ref) ty1 ty2 =
   try
     univar_pairs := [];
-    gadt_equations_level := Some lev;
+    newtype_level := Some lev;
     set_mode_pattern ~generate:true ~injective:true
                      (fun () -> unify env ty1 ty2);
-    gadt_equations_level := None;
+    newtype_level := None;
     TypePairs.clear unify_eq_set;
   with e ->
-    gadt_equations_level := None;
+    newtype_level := None;
     TypePairs.clear unify_eq_set;
     raise e
 
@@ -4485,8 +4493,7 @@ let nondep_type_decl env mid id is_covariant decl =
       type_manifest = tm;
       type_private = priv;
       type_variance = decl.type_variance;
-      type_is_newtype = false;
-      type_expansion_scope = None;
+      type_newtype_level = None;
       type_loc = decl.type_loc;
       type_attributes = decl.type_attributes;
       type_immediate = decl.type_immediate;
diff --git a/typing/ctype.mli b/typing/ctype.mli
index e22d2694b7..c4d1e55f69 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -169,7 +169,7 @@ val enforce_constraints: Env.t -> type_expr -> unit
 
 val unify: Env.t -> type_expr -> type_expr -> unit
         (* Unify the two types given. Raise [Unify] if not possible. *)
-val unify_gadt: equations_level:int -> Env.t ref -> type_expr -> type_expr -> unit
+val unify_gadt: newtype_level:int -> Env.t ref -> type_expr -> type_expr -> unit
         (* Unify the two types given and update the environment with the
            local constraints. Raise [Unify] if not possible. *)
 val unify_var: Env.t -> type_expr -> type_expr -> unit
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 7bef64c9f2..052e7417a3 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -85,8 +85,7 @@ let constructor_args priv cd_args cd_res path rep =
           type_private = priv;
           type_manifest = None;
           type_variance = List.map (fun _ -> Variance.full) type_params;
-          type_is_newtype = false;
-          type_expansion_scope = None;
+          type_newtype_level = None;
           type_loc = Location.none;
           type_attributes = [];
           type_immediate = false;
diff --git a/typing/env.ml b/typing/env.ml
index cf5207ee85..f49a847801 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -1051,7 +1051,7 @@ let find_type_expansion path env =
   | Some body when decl.type_private = Public
               || decl.type_kind <> Type_abstract
               || Btype.has_constr_row body ->
-      (decl.type_params, body, decl.type_expansion_scope)
+                  (decl.type_params, body, may_map snd decl.type_newtype_level)
   (* The manifest type of Private abstract data types without
      private row are still considered unknown to the type system.
      Hence, this case is caught by the following clause that also handles
@@ -1067,8 +1067,7 @@ let find_type_expansion_opt path env =
   match decl.type_manifest with
   (* The manifest type of Private abstract data types can still get
      an approximation using their manifest type. *)
-  | Some body ->
-      (decl.type_params, body, decl.type_expansion_scope)
+  | Some body -> (decl.type_params, body, may_map snd decl.type_newtype_level)
   | _ -> raise Not_found
 
 let find_modtype_expansion path env =
diff --git a/typing/predef.ml b/typing/predef.ml
index 2989d426de..a7688ccc8c 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -125,8 +125,7 @@ let decl_abstr =
    type_private = Asttypes.Public;
    type_manifest = None;
    type_variance = [];
-   type_is_newtype = false;
-   type_expansion_scope = None;
+   type_newtype_level = None;
    type_attributes = [];
    type_immediate = false;
    type_unboxed = unboxed_false_default_false;
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index f2e6f19698..efb2ed090c 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1284,8 +1284,7 @@ let filter_rem_sig item rem =
 let dummy =
   { type_params = []; type_arity = 0; type_kind = Type_abstract;
     type_private = Public; type_manifest = None; type_variance = [];
-    type_is_newtype = false; type_expansion_scope = None;
-    type_loc = Location.none;
+    type_newtype_level = None; type_loc = Location.none;
     type_attributes = [];
     type_immediate = false;
     type_unboxed = unboxed_false_default_false;
diff --git a/typing/subst.ml b/typing/subst.ml
index ad9d8d6863..5ac528e1f0 100644
--- a/typing/subst.ml
+++ b/typing/subst.ml
@@ -299,8 +299,7 @@ let type_declaration s decl =
         end;
       type_private = decl.type_private;
       type_variance = decl.type_variance;
-      type_is_newtype = false;
-      type_expansion_scope = None;
+      type_newtype_level = None;
       type_loc = loc s decl.type_loc;
       type_attributes = attrs s decl.type_attributes;
       type_immediate = decl.type_immediate;
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 53542c5c0a..e03c2cd32d 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -1291,8 +1291,7 @@ let temp_abbrev loc env id arity =
        type_private = Public;
        type_manifest = Some ty;
        type_variance = Misc.replicate_list Variance.full arity;
-       type_is_newtype = false;
-       type_expansion_scope = None;
+       type_newtype_level = None;
        type_loc = loc;
        type_attributes = []; (* or keep attrs from the class decl? *)
        type_immediate = false;
@@ -1542,8 +1541,7 @@ let class_infos define_class kind
      type_private = Public;
      type_manifest = Some obj_ty;
      type_variance = List.map (fun _ -> Variance.full) obj_params;
-     type_is_newtype = false;
-     type_expansion_scope = None;
+     type_newtype_level = None;
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
@@ -1562,8 +1560,7 @@ let class_infos define_class kind
      type_private = Public;
      type_manifest = Some cl_ty;
      type_variance = List.map (fun _ -> Variance.full) cl_params;
-     type_is_newtype = false;
-     type_expansion_scope = None;
+     type_newtype_level = None;
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 402c0320ea..cd3df7040c 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -390,16 +390,22 @@ let unify_exp_types loc env ty expected_ty =
       raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2)))
 
 (* level at which to create the local type declarations *)
-let gadt_equations_level = ref None
-let get_gadt_equations_level () =
-  match !gadt_equations_level with
+let newtype_level = ref None
+let get_newtype_level () =
+  match !newtype_level with
     Some y -> y
   | None -> assert false
 
 let unify_pat_types_gadt loc env ty ty' =
-  try unify_gadt ~equations_level:(get_gadt_equations_level ()) env ty ty'
+  let newtype_level =
+    match !newtype_level with
+    | None -> assert false
+    | Some x -> x
+  in
+  try
+    unify_gadt ~newtype_level env ty ty'
   with
-  | Unify trace ->
+    Unify trace ->
       raise(Error(loc, !env, Pattern_type_clash(trace)))
   | Tags(l1,l2) ->
       raise(Typetexp.Error(loc, !env, Typetexp.Variant_tags (l1, l2)))
@@ -1185,8 +1191,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         raise(Error(loc, !env, Constructor_arity_mismatch(lid.txt,
                                      constr.cstr_arity, List.length sargs)));
       let (ty_args, ty_res) =
-        instance_constructor ~in_pattern:(env, get_gadt_equations_level ())
-          constr
+        instance_constructor ~in_pattern:(env, get_newtype_level ()) constr
       in
       (* PR#7214: do not use gadt unification for toplevel lets *)
       if not constr.cstr_generalized || mode = Inside_or || no_existentials
@@ -1409,16 +1414,16 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
 
 let type_pat ?(allow_existentials=false) ?constrs ?labels ?(mode=Normal)
     ?(explode=0) ?(lev=get_current_level()) env sp expected_ty =
-  gadt_equations_level := Some lev;
+  newtype_level := Some lev;
   try
     let r =
       type_pat ~no_existentials:(not allow_existentials) ~constrs ~labels
         ~mode ~explode ~env sp expected_ty (fun x -> x) in
     iter_pattern (fun p -> p.pat_env <- !env) r;
-    gadt_equations_level := None;
+    newtype_level := None;
     r
   with e ->
-    gadt_equations_level := None;
+    newtype_level := None;
     raise e
 
 
@@ -3742,6 +3747,7 @@ and type_expect_
       (* remember original level *)
       begin_def ();
       (* Create a fake abstract type declaration for name. *)
+      let level = get_current_level () in
       let decl = {
         type_params = [];
         type_arity = 0;
@@ -3749,8 +3755,7 @@ and type_expect_
         type_private = Public;
         type_manifest = None;
         type_variance = [];
-        type_is_newtype = true;
-        type_expansion_scope = None;
+        type_newtype_level = Some (level, level);
         type_loc = loc;
         type_attributes = [];
         type_immediate = false;
@@ -4656,17 +4661,8 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
     | _ -> true
   in
   let outer_level = get_current_level () in
-  let init_env () =
-    (* raise level for existentials *)
-    begin_def ();
-    Ident.set_current_time (get_current_level ());
-    let lev = Ident.current_time () in
-    Ctype.init_def (lev+1000);                 (* up to 1000 existentials *)
-    lev
-  in
-  let lev =
-    if may_contain_gadts then init_env () else get_current_level ()
-  in
+  if may_contain_gadts then begin_def ();
+  let lev = get_current_level () in
   (* Do we need to propagate polymorphism *)
   let propagate =
     !Clflags.principal || may_contain_gadts || (repr ty_arg).level = generic_level ||
@@ -4732,7 +4728,9 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
   if take_partial_instance <> None then unify_pats (instance ty_arg);
   if propagate then begin
     List.iter
-      (iter_pattern (fun {pat_type=t} -> unify_var env t (newvar()))) patl;
+      (fun (pat, _, (env, _)) ->
+         iter_pattern (fun {pat_type=t} -> unify_var env (newvar()) t) pat)
+      pat_env_list;
     end_def ();
     generalize ty_arg';
     List.iter (iter_pattern (fun {pat_type=t} -> generalize t)) patl;
@@ -4779,8 +4777,8 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
   (* We could check whether there actually is a GADT here instead of reusing
      [has_constructor], but I'm not sure it's worth it. *)
   let do_init = may_contain_gadts || needs_exhaust_check in
-  let lev =
-    if do_init && not may_contain_gadts then init_env () else lev in
+  if do_init && not may_contain_gadts then begin_def ();
+  let lev = get_current_level () in
   let ty_arg_check =
     if do_init then
       (* Hack: use for_saving to copy variables too *)
@@ -4793,20 +4791,19 @@ and type_cases ?in_function env ty_arg ty_res partial_flag loc caselist =
     else
       Partial
   in
-  let unused_check do_init =
-    let lev =
-      if do_init then init_env () else get_current_level ()
-    in
+  let unused_check () =
+    begin_def ();
+    init_def lev;
     List.iter (fun (pat, _, (env, _)) -> check_absent_variant env pat)
       pat_env_list;
-    check_unused ~lev env (instance ty_arg_check) cases ;
-    if do_init then end_def ();
-    Parmatch.check_ambiguous_bindings cases
+    check_unused ~lev env (instance ty_arg_check) cases;
+    Parmatch.check_ambiguous_bindings cases;
+    end_def ()
   in
   if contains_polyvars || do_init then
-    add_delayed_check (fun () -> unused_check do_init)
+    add_delayed_check unused_check
   else
-    unused_check false;
+    unused_check ();
   (* Check for unused cases, do not delay because of gadts *)
   if do_init then begin
     end_def ();
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 5e4b9d5ad9..18e56e8777 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -104,8 +104,7 @@ let enter_type rec_flag env sdecl id =
         begin match sdecl.ptype_manifest with None -> None
         | Some _ -> Some(Ctype.newvar ()) end;
       type_variance = List.map (fun _ -> Variance.full) sdecl.ptype_params;
-      type_is_newtype = false;
-      type_expansion_scope = None;
+      type_newtype_level = None;
       type_loc = sdecl.ptype_loc;
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
@@ -518,8 +517,7 @@ let transl_declaration env sdecl id =
         type_private = sdecl.ptype_private;
         type_manifest = man;
         type_variance = List.map (fun _ -> Variance.full) params;
-        type_is_newtype = false;
-        type_expansion_scope = None;
+        type_newtype_level = None;
         type_loc = sdecl.ptype_loc;
         type_attributes = sdecl.ptype_attributes;
         type_immediate = false;
@@ -1850,8 +1848,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
       type_private = priv;
       type_manifest = man;
       type_variance = [];
-      type_is_newtype = false;
-      type_expansion_scope = None;
+      type_newtype_level = None;
       type_loc = sdecl.ptype_loc;
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
@@ -1899,8 +1896,7 @@ let abstract_type_decl arity =
       type_private = Public;
       type_manifest = None;
       type_variance = replicate_list Variance.full arity;
-      type_is_newtype = false;
-      type_expansion_scope = None;
+      type_newtype_level = None;
       type_loc = Location.none;
       type_attributes = [];
       type_immediate = false;
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 1812e0899f..13c5c223d7 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -359,8 +359,7 @@ let merge_constraint initial_env remove_aliases loc sg constr =
                 )
                 sdecl.ptype_params;
             type_loc = sdecl.ptype_loc;
-            type_is_newtype = false;
-            type_expansion_scope = None;
+            type_newtype_level = None;
             type_attributes = [];
             type_immediate = false;
             type_unboxed = unboxed_false_default_false;
diff --git a/typing/types.ml b/typing/types.ml
index 3003fc9839..94b41a16e2 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -146,8 +146,7 @@ type type_declaration =
     type_private: private_flag;
     type_manifest: type_expr option;
     type_variance: Variance.t list;
-    type_is_newtype: bool;
-    type_expansion_scope: int option;
+    type_newtype_level: (int * int) option;
     type_loc: Location.t;
     type_attributes: Parsetree.attributes;
     type_immediate: bool;
diff --git a/typing/types.mli b/typing/types.mli
index b88c87eefd..1ca92c12c3 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -291,8 +291,8 @@ type type_declaration =
     type_manifest: type_expr option;
     type_variance: Variance.t list;
     (* covariant, contravariant, weakly contravariant, injective *)
-    type_is_newtype: bool;
-    type_expansion_scope: int option;
+    type_newtype_level: (int * int) option;
+    (* definition level * expansion level *)
     type_loc: Location.t;
     type_attributes: Parsetree.attributes;
     type_immediate: bool; (* true iff type should not be a pointer *)
diff --git a/utils/config.mlp b/utils/config.mlp
index 22750c4e0e..e97f192d7c 100644
--- a/utils/config.mlp
+++ b/utils/config.mlp
@@ -84,7 +84,7 @@ let afl_instrument = %%AFL_INSTRUMENT%%
 
 let exec_magic_number = "Caml1999X023"
     (* exec_magic_number is duplicated in byterun/caml/exec.h *)
-and cmi_magic_number = "Caml1999I023"
+and cmi_magic_number = "Caml1999I024"
 and cmo_magic_number = "Caml1999O023"
 and cma_magic_number = "Caml1999A023"
 and cmx_magic_number =