flambda-backend: Port ocaml/ocaml#11727 and ocaml/ocaml#11732 (ocaml-…

…flambda#965)

lambda/translcore.ml

@@ -183,6 +183,8 @@ let rec trivial_pat pat =
   match pat.pat_desc with
     Tpat_var _
   | Tpat_any -> true
+  | Tpat_alias (p, _, _) ->
+      trivial_pat p
   | Tpat_construct (_, cd, [], _) ->
       not cd.cstr_generalized && cd.cstr_consts = 1 && cd.cstr_nonconsts = 0
   | Tpat_tuple patl ->

testsuite/tests/basic-more/pr10338.ml

@@ -19,3 +19,8 @@ let f ?(y=1) : empty -> int = function _ -> .;;
 module type E = sig exception Ex end;;
 let f ((module M) : (module E)) (M.Ex | _) = "42";;
 print_endline (f (module struct exception Ex end) Exit);;
+
+(* push_defaults should push past the module pattern *)
+let f ?(x = assert false) ((module M) : (module E)) () = 1;;
+(* so partial application of the module doesn't raise *)
+let partial = f (module struct exception Ex end);;

testsuite/tests/typing-modules/packed_module_levels.ml

@@ -0,0 +1,42 @@
+(* TEST
+   * expect
+*)
+type (_, _) equ = Refl : ('q, 'q) equ
+
+module type Ty = sig type t end
+type 'a modu = (module Ty with type t = 'a)
+
+type 'q1 packed =
+    P : 'q0 modu * ('q0, 'q1) equ -> 'q1 packed
+
+(* Adds a module M to the environment where M.t equals an existential *)
+let repack (type q) (x : q packed) : q modu =
+  match x with
+  | P (p, eq) ->
+    let module M = (val p) in
+    let Refl = eq in
+    (module M)
+
+[%%expect{|
+type (_, _) equ = Refl : ('q, 'q) equ
+module type Ty = sig type t end
+type 'a modu = (module Ty with type t = 'a)
+type 'q1 packed = P : 'q0 modu * ('q0, 'q1) equ -> 'q1 packed
+val repack : 'q packed -> 'q modu = <fun>
+|}]
+
+(* Same, using a polymorphic function rather than an existential *)
+
+let mkmod (type a) () : a modu =
+  (module struct type t = a end)
+
+let f (type foo) (intish : (foo, int) equ) =
+  let module M = (val (mkmod () : foo modu)) in
+  let Refl = intish in
+  let module C : sig type t = int end = M in
+  ()
+
+[%%expect{|
+val mkmod : unit -> 'a modu = <fun>
+val f : ('foo, int) equ -> unit = <fun>
+|}]

typing/typemod.ml

@@ -2141,8 +2141,10 @@ and package_constraints env loc mty constrs =
   end
 
 let modtype_of_package env loc p fl =
+  (* We call Ctype.correct_levels to ensure that the types being added to the
+     module type are at generic_level. *)
   package_constraints env loc (Mty_ident p)
-    (List.map (fun (n, t) -> (Longident.flatten n, t)) fl)
+    (List.map (fun (n, t) -> Longident.flatten n, Ctype.correct_levels t) fl)
 
 let package_subtype env p1 fl1 p2 fl2 =
   let mkmty p fl =