type_pat: pass a generalized type forward when typing the pattern of …

…a record field
ocaml · Jul 17, 2018 · 2d09e12 · 2d09e12
1 parent cd0cd28
commit 2d09e12
Showing 1 changed file with 10 additions and 2 deletions.
diff --git a/typing/typecore.ml b/typing/typecore.ml
@@ -1352,17 +1352,25 @@ and type_pat_aux ~exception_allowed ~constrs ~labels ~no_existentials ~mode
       let opath, record_ty =
         try
           let (p0, p,_) = extract_concrete_record !env expected_ty in
-          Some (p0, p, true), instance expected_ty
+          begin_def ();
+          let ty = instance expected_ty in
+          end_def ();
+          generalize_structure ty;
+          Some (p0, p, true), ty
         with Not_found -> None, newvar ()
       in
       let type_label_pat (label_lid, label, sarg) k =
+        begin_def ();
         let (_, ty_arg, ty_res) = instance_label false label in
         begin try
-          unify_pat_types loc !env ty_res record_ty
+          unify_pat_types loc !env ty_res (instance record_ty)
         with Error(_loc, _env, Pattern_type_clash(trace)) ->
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
+        end_def ();
+        generalize_structure ty_res;
+        generalize_structure ty_arg;
         type_pat sarg ty_arg (fun arg ->
           k (label_lid, label, arg))
       in