Merge pull request #9803 from trefis/pr9799

pat_env points to the correct environment

Changes

@@ -523,6 +523,9 @@ Working version
   (Jacques Garrigue, report by Thomas Refis,
    review by Thomas Refis and Gabriel Scherer)
 
+- #9799, #9803: pat_env points to the correct environment
+  (Thomas Refis, report by Alex Fedoseev, review by Gabriel Scherer)
+
 - #9825, #9830: the C global variable caml_fl_merge and the C function
   caml_spacetime_my_profinfo (bytecode version) were declared and
   defined with different types.  This is undefined behavior and

testsuite/tests/typing-gadts/pr9799.ml

@@ -0,0 +1,22 @@
+(* TEST
+   * expect
+*)
+
+type 'a t =
+  | A: [`a|`z] t
+  | B: [`b|`z] t
+;;
+[%%expect{|
+type 'a t = A : [ `a | `z ] t | B : [ `b | `z ] t
+|}];;
+
+let fn: type a. a t -> a -> int = fun x y ->
+  match (x, y) with
+  | (A, `a)
+  | (B, `b) -> 0
+  | (A, `z)
+  | (B, `z) -> 1
+;;
+[%%expect{|
+val fn : 'a t -> 'a -> int = <fun>
+|}];;

typing/typecore.ml

@@ -1881,11 +1881,8 @@ and type_pat_aux
 let type_pat category ?no_existentials ?(mode=Normal)
     ?(lev=get_current_level()) env sp expected_ty =
   Misc.protect_refs [Misc.R (gadt_equations_level, Some lev)] (fun () ->
-      let r =
         type_pat category ~no_existentials ~mode
           ~env sp expected_ty (fun x -> x)
-      in
-      map_general_pattern { f = fun p -> { p with pat_env = !env } } r
     )
 
 (* this function is passed to Partial.parmatch

typing/typedtree.ml

@@ -714,15 +714,6 @@ let iter_pattern (f : pattern -> unit) =
           | Value -> f p
           | Computation -> () }
 
-let rec map_general_pattern
-  : type k . pattern_transformation -> k general_pattern -> k general_pattern
-  = fun f p ->
-  let pat_desc =
-    shallow_map_pattern_desc
-      { f = fun p -> map_general_pattern f p }
-      p.pat_desc in
-  f.f { p with pat_desc }
-
 type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
 let exists_general_pattern (f : pattern_predicate) p =
   let exception Found in

typing/typedtree.mli

@@ -780,11 +780,6 @@ type pattern_predicate = { f : 'k . 'k general_pattern -> bool }
 val exists_general_pattern: pattern_predicate -> 'k general_pattern -> bool
 val exists_pattern: (pattern -> bool) -> pattern -> bool
 
-(** bottom-up mapping of patterns: the transformation function is
-    called on the children before being called on the parent *)
-val map_general_pattern:
-  pattern_transformation -> 'k general_pattern -> 'k general_pattern
-
 val let_bound_idents: value_binding list -> Ident.t list
 val let_bound_idents_full:
     value_binding list -> (Ident.t * string loc * Types.type_expr) list