add some protect_expansion

typing/typecore.ml

@@ -273,16 +273,19 @@ let extract_option_type env ty =
     when Path.same path Predef.path_option -> ty
   | _ -> assert false
 
-let protect_extraction env ty =
+let protect_expansion env ty =
   if Env.has_local_constraints env then generic_instance ty else ty
 
+let extract_concrete_typedecl_protected env ty =
+  extract_concrete_typedecl env (protect_expansion env ty)
+
 let extract_concrete_record env ty =
-  match extract_concrete_typedecl env (protect_extraction env ty) with
+  match extract_concrete_typedecl_protected env ty with
     (p0, p, {type_kind=Type_record (fields, _)}) -> (p0, p, fields)
   | _ -> raise Not_found
 
 let extract_concrete_variant env ty =
-  match extract_concrete_typedecl env (protect_extraction env ty) with
+  match extract_concrete_typedecl_protected env ty with
     (p0, p, {type_kind=Type_variant (cstrs, _)}) -> (p0, p, cstrs)
   | (p0, p, {type_kind=Type_open}) -> (p0, p, [])
   | _ -> raise Not_found
@@ -2793,7 +2796,7 @@ and type_expect_
   | Pexp_constant(Pconst_string (str, _, _) as cst) -> (
     let cst = constant_or_raise env loc cst in
     (* Terrible hack for format strings *)
-    let ty_exp = expand_head env ty_expected in
+    let ty_exp = expand_head env (protect_expansion env ty_expected) in
     let fmt6_path =
       Path.(Pdot (Pident (Ident.create_persistent "CamlinternalFormatBasics"),
                   "format6"))
@@ -2995,7 +2998,7 @@ and type_expect_
       type_construct env loc lid sarg ty_expected_explained sexp.pexp_attributes
   | Pexp_variant(l, sarg) ->
       (* Keep sharing *)
-      let ty_expected1 = protect_extraction env ty_expected in
+      let ty_expected1 = protect_expansion env ty_expected in
       let ty_expected0 = instance ty_expected in
       begin try match
         sarg, expand_head env ty_expected1, expand_head env ty_expected0 with
@@ -3667,7 +3670,8 @@ and type_expect_
   | Pexp_poly(sbody, sty) ->
       if !Clflags.principal then begin_def ();
       let ty, cty =
-        match sty with None -> repr ty_expected, None
+        match sty with
+          None -> repr (protect_expansion env ty_expected), None
         | Some sty ->
             let sty = Ast_helper.Typ.force_poly sty in
             let cty = Typetexp.transl_simple_type env false sty in
@@ -3751,7 +3755,8 @@ and type_expect_
         match Ctype.expand_head env (instance ty_expected) with
           {desc = Tpackage (p, fl)} ->
             if !Clflags.principal &&
-              (Ctype.expand_head env ty_expected).level < Btype.generic_level
+              (Ctype.expand_head env (protect_expansion env ty_expected)).level
+                < Btype.generic_level
             then
               Location.prerr_warning loc
                 (Warnings.Not_principal "this module packing");
@@ -4350,7 +4355,7 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected =
         (lv <> generic_level || (repr ty_fun').level <> generic_level)
       and ty_fun = instance ty_fun' in
       let ty_arg, ty_res =
-        match expand_head env ty_expected' with
+        match expand_head env ty_expected with
           {desc = Tarrow(Nolabel,ty_arg,ty_res,_)} -> ty_arg, ty_res
         | _ -> assert false
       in