diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml
index 85b27f838e3..61f4e3c549f 100644
--- a/ocaml/lambda/translcore.ml
+++ b/ocaml/lambda/translcore.ml
@@ -58,6 +58,12 @@ let sort_must_not_be_void loc ty sort =
 
 let layout_exp sort e = layout e.exp_env e.exp_loc sort e.exp_type
 
+let layout_rhs sort = function
+  | Simple_rhs rhs | Boolean_guarded_rhs { bg_rhs = rhs; _ } ->
+      layout_exp sort rhs
+  | Pattern_guarded_rhs { pg_env; pg_loc; pg_type; _ } ->
+      layout pg_env pg_loc sort pg_type
+
 (* Forward declaration -- to be filled in by Translmod.transl_module *)
 let transl_module =
   ref((fun ~scopes:_ _cc _rootpath _modl -> assert false) :
@@ -216,32 +222,47 @@ let rec trivial_pat pat =
 let rec push_defaults loc bindings use_lhs arg_mode arg_sort cases
           partial warnings =
   match cases with
-    [{c_lhs=pat; c_guard=None;
-      c_rhs={exp_desc = Texp_function { arg_label; param; cases; partial;
+    [{c_lhs=pat;
+      c_rhs=
+        Simple_rhs
+          ({ exp_desc = Texp_function { arg_label; param; cases; partial;
                                         region; curry; warnings; arg_mode;
                                         arg_sort; ret_sort; alloc_mode } }
-        as exp}] when bindings = [] || trivial_pat pat ->
+           as exp)}]
+    when bindings = [] || trivial_pat pat ->
       let cases =
         push_defaults exp.exp_loc bindings false arg_mode arg_sort cases partial
           warnings
       in
-      [{c_lhs=pat; c_guard=None;
-        c_rhs={exp with exp_desc =
-                          Texp_function { arg_label; param; cases; partial;
-                                          region; curry; warnings; arg_mode;
-                                          arg_sort; ret_sort; alloc_mode }}}]
-  | [{c_lhs=pat; c_guard=None;
-      c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#default"};_}];
-             exp_desc = Texp_let
-               (Nonrecursive, binds,
-                ({exp_desc = Texp_function _} as e2))}}] ->
+      let exp_desc =
+        Texp_function
+          { arg_label; param; cases; partial; region; curry; warnings; arg_mode;
+            arg_sort; ret_sort; alloc_mode }
+      in
+      [ { c_lhs = pat; c_rhs = Simple_rhs { exp with exp_desc } } ]
+  | [{c_lhs=pat;
+      c_rhs=
+        Simple_rhs
+          { exp_attributes=[{Parsetree.attr_name = {txt="#default"};_}]
+          ; exp_desc =
+              Texp_let
+                (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}
+    ] ->
       push_defaults loc (binds :: bindings) true
-                   arg_mode arg_sort [{c_lhs=pat;c_guard=None;c_rhs=e2}]
+                   arg_mode arg_sort [{c_lhs=pat;c_rhs=Simple_rhs e2}]
                    partial warnings
-  | [{c_lhs=pat; c_guard=None; c_rhs=exp} as case]
+  | [{c_lhs=pat; c_rhs=Simple_rhs exp} as case]
     when use_lhs || trivial_pat pat && exp.exp_desc <> Texp_unreachable ->
-      [{case with c_rhs = wrap_bindings bindings exp}]
-  | {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
+      [{case with c_rhs = Simple_rhs (wrap_bindings bindings exp)}]
+  | {c_lhs=pat; c_rhs=rhs } :: _
+    when bindings <> [] ->
+      let exp_loc, exp_extra, exp_type, exp_env, exp_attributes =
+        match rhs with
+        | Simple_rhs e | Boolean_guarded_rhs { bg_rhs = e; _ } ->
+            e.exp_loc, e.exp_extra, e.exp_type, e.exp_env, e.exp_attributes
+        | Pattern_guarded_rhs { pg_loc; pg_env; pg_type; _ } ->
+            pg_loc, [], pg_type, pg_env, []
+      in
       let mode = Value_mode.of_alloc arg_mode in
       let param = Typecore.name_cases "param" cases in
       let desc =
@@ -249,24 +270,28 @@ let rec push_defaults loc bindings use_lhs arg_mode arg_sort cases
          val_attributes = []; Types.val_loc = Location.none;
          val_uid = Types.Uid.internal_not_actually_unique; }
       in
-      let env = Env.add_value ~mode param desc exp.exp_env in
+      let env = Env.add_value ~mode param desc exp_env in
       let name = Ident.name param in
       let exp =
         let cases =
           let pure_case ({c_lhs; _} as case) =
             {case with c_lhs = as_computation_pattern c_lhs} in
           List.map pure_case cases in
-        { exp with exp_loc = loc; exp_env = env; exp_desc =
-          Texp_match
-            ({exp with exp_type = pat.pat_type; exp_env = env; exp_desc =
-              Texp_ident
+        (* [exp_attributes] and [exp_extra] are shared by the outer match
+           expression and its scrutinee. This is a faithful translation of the
+           earlier code, which we won't interrogate too carefully as it is
+           deleted as part of syntactic arity changes. *)
+        { exp_loc = loc; exp_env = env; exp_extra; exp_type; exp_attributes;
+          exp_desc = Texp_match
+            ({ exp_type = pat.pat_type; exp_env = env; exp_loc; exp_extra;
+               exp_attributes; exp_desc = Texp_ident
                 (Path.Pident param, mknoloc (Longident.Lident name),
                  desc, Id_value)},
              arg_sort,
              cases, partial) }
       in
       [{c_lhs = {pat with pat_desc = Tpat_var (param, mknoloc name, mode)};
-        c_guard = None; c_rhs= wrap_bindings bindings exp}]
+        c_rhs = Simple_rhs (wrap_bindings bindings exp)}]
   | _ ->
       cases
 
@@ -280,18 +305,28 @@ let event_before ~scopes exp lam =
 let event_after ~scopes exp lam =
   Translprim.event_after (of_location ~scopes exp.exp_loc) exp lam
 
-let event_function ~scopes exp lam =
+let event_function ~scopes loc env lam =
   if !Clflags.debug && not !Clflags.native_code then
     let repr = Some (ref 0) in
     let (info, body) = lam repr in
     (info,
-     Levent(body, {lev_loc = of_location ~scopes exp.exp_loc;
+     Levent(body, {lev_loc = of_location ~scopes loc;
                    lev_kind = Lev_function;
                    lev_repr = repr;
-                   lev_env = exp.exp_env}))
+                   lev_env = env}))
   else
     lam None
 
+let event_function_expr ~scopes exp lam =
+  event_function ~scopes exp.exp_loc exp.exp_env lam
+
+let event_function_rhs ~scopes rhs lam =
+  match rhs with
+  | Simple_rhs rhs_exp | Boolean_guarded_rhs { bg_rhs = rhs_exp; _ } ->
+      event_function_expr ~scopes rhs_exp lam
+  | Pattern_guarded_rhs { pg_loc; pg_env; _ } ->
+      event_function ~scopes pg_loc pg_env lam
+
 (* Assertions *)
 
 let assert_failed ~scopes exp =
@@ -350,6 +385,10 @@ let can_apply_primitive p pmode pos args =
     end
   end
 
+let is_rhs_unreachable = function
+  | Simple_rhs { exp_desc = Texp_unreachable; _ } -> true
+  | _ -> false
+
 let rec transl_exp ~scopes sort e =
   transl_exp1 ~scopes ~in_new_scope:false sort e
 
@@ -1009,39 +1048,31 @@ and transl_list_with_shape ~scopes expr_list =
   in
   List.split (List.map transl_with_shape expr_list)
 
-and transl_guard ~scopes guard rhs_sort rhs =
-  let layout = layout_exp rhs_sort rhs in
-  match guard with
-  | None ->
+and transl_rhs ~scopes rhs_sort rhs =
+  let layout = layout_rhs rhs_sort rhs in
+  match rhs with
+  | Simple_rhs rhs ->
       Matching.mk_unguarded_rhs
         (event_before ~scopes rhs (transl_exp ~scopes rhs_sort rhs))
-  | Some (Predicate cond) ->
-    let translated_cond = transl_exp ~scopes Sort.for_predef_value cond in
-    let translated_rhs =
-      event_before ~scopes rhs (transl_exp ~scopes rhs_sort rhs)
-    in
-    let patch_guarded ~patch =
-      event_before ~scopes cond
-        (Lifthenelse (translated_cond, translated_rhs, patch, layout))
-    in
-    let free_variables =
-      Ident.Set.union
-        (free_variables translated_cond)
-        (free_variables translated_rhs)
-    in
-    Matching.mk_boolean_guarded_rhs ~patch_guarded ~free_variables
-  | Some (Pattern { pg_scrutinee; pg_scrutinee_sort; pg_pattern; pg_partial;
-                    pg_loc; pg_env }) ->
-      let guard_case : _ case =
-        { c_lhs = pg_pattern
-        ; c_guard = None
-        ; c_rhs = rhs }
+  | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+      let guard = transl_exp ~scopes Sort.for_predef_value bg_guard in
+      let body =
+        event_before ~scopes bg_rhs (transl_exp ~scopes rhs_sort bg_rhs)
+      in
+      let patch_guarded ~patch =
+        event_before ~scopes bg_guard (Lifthenelse (guard, body, patch, layout))
       in
+      let free_variables =
+        Ident.Set.union (free_variables guard) (free_variables body)
+      in
+      Matching.mk_boolean_guarded_rhs ~patch_guarded ~free_variables
+  | Pattern_guarded_rhs { pg_scrutinee; pg_scrutinee_sort; pg_cases; pg_partial;
+                          pg_loc; pg_env; pg_type } ->
       match pg_partial with
-      | Partial -> 
-          (* Partial pattern guards may fail to match, so we must construct a 
-             guarded rhs from a continuation that patches in the code to execute
-             on match failure.
+      | Partial ->
+          (* Partial pattern guards may fail to match, so we must construct a
+             guarded rhs from a continuation that later "patches" in the code to
+             execute on match failure.
           *)
           let patch_guarded ~patch =
             let any_pat : pattern =
@@ -1049,56 +1080,56 @@ and transl_guard ~scopes guard rhs_sort rhs =
               ; pat_loc = Location.none
               ; pat_extra = []
               ; pat_type = pg_scrutinee.exp_type
-              ; pat_env = Env.empty
+              ; pat_env = pg_env
               ; pat_attributes = []
               }
             in
             let extra_cases = [ any_pat, Matching.mk_unguarded_rhs patch ] in
             event_before ~scopes pg_scrutinee
               (transl_match ~scopes ~arg_sort:pg_scrutinee_sort
-                 ~return_sort:rhs_sort ~return_type:rhs.exp_type ~loc:pg_loc
-                 ~env:pg_env ~extra_cases pg_scrutinee [ guard_case ]
-                 pg_partial)
+                  ~return_sort:rhs_sort ~return_type:pg_type ~loc:pg_loc
+                  ~env:pg_env ~extra_cases pg_scrutinee pg_cases pg_partial)
           in
           Matching.mk_pattern_guarded_rhs ~patch_guarded
       | Total ->
           (* Total pattern guards are equivalent to nested matches. *)
           let nested_match =
             transl_match ~scopes ~arg_sort:pg_scrutinee_sort
-              ~return_sort:rhs_sort ~return_type:rhs.exp_type ~loc:pg_loc
-              ~env:pg_env ~extra_cases:[] pg_scrutinee [ guard_case ] pg_partial
+              ~return_sort:rhs_sort ~return_type:pg_type ~loc:pg_loc
+              ~env:pg_env ~extra_cases:[] pg_scrutinee pg_cases pg_partial
           in
           Matching.mk_unguarded_rhs
             (event_before ~scopes pg_scrutinee nested_match)
 
-and transl_case ~scopes rhs_sort {c_lhs; c_guard; c_rhs} =
-  c_lhs, transl_guard ~scopes c_guard rhs_sort c_rhs
+and transl_case ~scopes rhs_sort {c_lhs; c_rhs} =
+  c_lhs, transl_rhs ~scopes rhs_sort c_rhs
 
 and transl_cases ~scopes rhs_sort cases =
   let cases =
-    List.filter (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) cases in
+    List.filter (fun case -> not (is_rhs_unreachable case.c_rhs)) cases
+  in
   List.map (transl_case ~scopes rhs_sort) cases
 
-and transl_case_try ~scopes rhs_sort {c_lhs; c_guard; c_rhs} =
+and transl_case_try ~scopes rhs_sort {c_lhs; c_rhs} =
   iter_exn_names Translprim.add_exception_ident c_lhs;
   Misc.try_finally
-    (fun () -> c_lhs, transl_guard ~scopes c_guard rhs_sort c_rhs)
+    (fun () -> c_lhs, transl_rhs ~scopes rhs_sort c_rhs)
     ~always:(fun () ->
         iter_exn_names Translprim.remove_exception_ident c_lhs)
 
 and transl_cases_try ~scopes rhs_sort cases =
   let cases =
-    List.filter (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) cases in
+    List.filter (fun case -> not (is_rhs_unreachable case.c_rhs)) cases
+  in
   List.map (transl_case_try ~scopes rhs_sort) cases
 
-and transl_tupled_cases ~scopes rhs_sort patl_expr_list =
-  let patl_expr_list =
-    List.filter (fun (_,_,e) -> e.exp_desc <> Texp_unreachable)
-      patl_expr_list in
+and transl_tupled_cases ~scopes rhs_sort patl_rhs_list =
+  let patl_rhs_list =
+    List.filter (fun (_, rhs) -> not (is_rhs_unreachable rhs)) patl_rhs_list
+  in
   List.map
-    (fun (patl, guard, expr) ->
-       (patl, transl_guard ~scopes guard rhs_sort expr))
-    patl_expr_list
+    (fun (patl, rhs) -> (patl, transl_rhs ~scopes rhs_sort rhs))
+    patl_rhs_list
 
 and transl_apply ~scopes
       ?(tailcall=Default_tailcall)
@@ -1221,14 +1252,15 @@ and transl_curried_function
             ~arity ~region ~curry partial warnings (param:Ident.t) cases =
     match curry, cases with
       More_args {partial_mode},
-      [{c_lhs=pat; c_guard=None;
-        c_rhs={exp_desc =
-                 Texp_function
-                   { arg_label = _; param = param'; cases = cases';
-                     partial = partial'; region = region';
-                     curry = curry';
-                     warnings = warnings'; arg_sort; ret_sort };
-               exp_env; exp_type; exp_loc }}]
+      [{c_lhs=pat;
+        c_rhs=Simple_rhs
+                {exp_desc =
+                   Texp_function
+                     { arg_label = _; param = param'; cases = cases';
+                       partial = partial'; region = region';
+                       curry = curry';
+                       warnings = warnings'; arg_sort; ret_sort };
+                 exp_env; exp_type; exp_loc }}]
       when arity < max_arity ->
       (* Lfunctions must have local returns after the first local arg/ret *)
       if Parmatch.inactive ~partial pat
@@ -1295,10 +1327,10 @@ and transl_tupled_function
       && List.length pl <= (Lambda.max_arity ()) ->
       begin try
         let size = List.length pl in
-        let pats_expr_list =
+        let pats_rhs_list =
           List.map
-            (fun {c_lhs; c_guard; c_rhs} ->
-              (Matching.flatten_pattern size c_lhs, c_guard, c_rhs))
+            (fun {c_lhs; c_rhs} ->
+              (Matching.flatten_pattern size c_lhs, c_rhs))
             cases in
         let kinds =
           match arg_layout with
@@ -1317,7 +1349,7 @@ and transl_tupled_function
         let params = List.map fst tparams in
         let body =
           Matching.for_tupled_function ~scopes ~return_layout loc params
-            (transl_tupled_cases ~scopes return_sort pats_expr_list) partial
+            (transl_tupled_cases ~scopes return_sort pats_rhs_list) partial
         in
         let region = region || not (may_allocate_in_region body) in
         ((Tupled, tparams, return_layout, region), body)
@@ -1351,7 +1383,7 @@ and transl_function ~scopes e alloc_mode param arg_mode arg_sort return_sort
     function_arg_layout e.exp_env e.exp_loc arg_sort e.exp_type
   in
   let ((kind, params, return, region), body) =
-    event_function ~scopes e
+    event_function_expr ~scopes e
       (function repr ->
          let pl =
            push_defaults e.exp_loc arg_mode arg_sort cases partial warnings
@@ -1592,8 +1624,8 @@ and transl_match ~scopes ~arg_sort ~return_sort ~return_type ~loc ~env
       ~extra_cases arg pat_expr_list partial =
   let return_layout = layout env loc arg_sort return_type in
   let rewrite_case (val_cases, exn_cases, static_handlers as acc)
-        ({ c_lhs; c_guard; c_rhs } as case) =
-    if c_rhs.exp_desc = Texp_unreachable then acc else
+        ({ c_lhs; c_rhs } as case) =
+    if is_rhs_unreachable c_rhs then acc else
     let val_pat, exn_pat = split_pattern c_lhs in
     match val_pat, exn_pat with
     | None, None -> assert false
@@ -1608,7 +1640,11 @@ and transl_match ~scopes ~arg_sort ~return_sort ~return_type ~loc ~env
         in
         val_cases, exn_case :: exn_cases, static_handlers
     | Some pv, Some pe ->
-        assert (c_guard = None);
+        let rhs_exp =
+          match c_rhs with
+          | Simple_rhs rhs -> rhs
+          | Boolean_guarded_rhs _ | Pattern_guarded_rhs _ -> assert false
+        in
         let lbl  = next_raise_count () in
         let static_raise ids =
           Lstaticraise (lbl, List.map (fun id -> Lvar id) ids)
@@ -1628,8 +1664,8 @@ and transl_match ~scopes ~arg_sort ~return_sort ~return_type ~loc ~env
         iter_exn_names Translprim.add_exception_ident pe;
         let rhs =
           Misc.try_finally
-            (fun () -> event_before ~scopes c_rhs
-                         (transl_exp ~scopes return_sort c_rhs))
+            (fun () -> event_before ~scopes rhs_exp
+                         (transl_exp ~scopes return_sort rhs_exp))
             ~always:(fun () ->
                 iter_exn_names Translprim.remove_exception_ident pe)
         in
@@ -1764,17 +1800,22 @@ and transl_letop ~scopes loc env let_ ands param param_sort case case_sort
                 "Translcore.transl_letop: letop should have at least two arguments"
           | Some (lhs, _) -> Typeopt.function_arg_layout env loc param_sort lhs
     in
-    let return_layout = layout_exp case_sort case.c_rhs in
+    let return_layout = layout_rhs case_sort case.c_rhs in
     let curry = More_args { partial_mode = Alloc_mode.global } in
+    let rhs_loc =
+      match case.c_rhs with
+      | Simple_rhs e | Boolean_guarded_rhs { bg_rhs = e; _ } -> e.exp_loc
+      | Pattern_guarded_rhs { pg_loc; _ } -> pg_loc
+    in
     let (kind, params, return, _region), body =
-      event_function ~scopes case.c_rhs
+      event_function_rhs ~scopes case.c_rhs
         (function repr ->
            transl_curried_function ~scopes ~arg_sort:param_sort ~arg_layout
-             ~return_sort:case_sort ~return_layout case.c_rhs.exp_loc repr
-             ~region:true ~curry partial warnings param [case])
+             ~return_sort:case_sort ~return_layout rhs_loc repr ~region:true
+             ~curry partial warnings param [case])
     in
     let attr = default_function_attribute in
-    let loc = of_location ~scopes case.c_rhs.exp_loc in
+    let loc = of_location ~scopes rhs_loc in
     let body = maybe_region_layout return body in
     lfunction ~kind ~params ~return ~body ~attr ~loc
               ~mode:alloc_heap ~region:true
diff --git a/ocaml/ocamldoc/odoc_ast.ml b/ocaml/ocamldoc/odoc_ast.ml
index 02018ede594..5d48a341204 100644
--- a/ocaml/ocamldoc/odoc_ast.ml
+++ b/ocaml/ocamldoc/odoc_ast.ml
@@ -301,31 +301,35 @@ module Analyser =
          (* we look if the name of the parameter we just add is "*opt*", which means
             that there is a let param_name = ... in ... just right now *)
           let (p, next_exp) =
-            match parameter with
-              Simple_name { sn_name = "*opt*" } ->
-                (
-                 (
-                  match func_body.exp_desc with
-                    Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
-                                            vb_expr=exp} :: _, func_body2) ->
-                      let name = Name.from_ident id in
-                      let new_param = Simple_name
-                          { sn_name = name ;
-                            sn_text = Odoc_parameter.desc_from_info_opt current_comment_opt name ;
-                            sn_type = Odoc_env.subst_type env exp.exp_type
-                          }
-                      in
-                      (new_param, func_body2)
-                  | _ ->
-                      (parameter, func_body)
-                 )
-                )
-            | _ ->
-                (parameter, func_body)
+            match func_body with
+            | Pattern_guarded_rhs _ -> parameter, None
+            | Simple_rhs func_body
+            | Boolean_guarded_rhs { bg_rhs = func_body; _ } ->
+                match parameter with
+                  Simple_name { sn_name = "*opt*" } ->
+                    (
+                     (
+                      match func_body.exp_desc with
+                        Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
+                                                vb_expr=exp} :: _, func_body2) ->
+                          let name = Name.from_ident id in
+                          let new_param = Simple_name
+                              { sn_name = name ;
+                                sn_text = Odoc_parameter.desc_from_info_opt current_comment_opt name ;
+                                sn_type = Odoc_env.subst_type env exp.exp_type
+                              }
+                          in
+                          (new_param, Some func_body2)
+                      | _ ->
+                          (parameter, Some func_body)
+                      )
+                     )
+                | _ ->
+                    parameter, Some func_body
           in
          (* continue if the body is still a function *)
-          match next_exp.exp_desc with
-            Texp_function { cases = pat_exp_list ; _ } ->
+          match next_exp with
+          | Some { exp_desc = Texp_function { cases = pat_exp_list ; _ } } ->
               p :: (tt_analyse_function_parameters env current_comment_opt pat_exp_list)
           | _ ->
               (* something else ; no more parameter *)
@@ -445,8 +449,8 @@ module Analyser =
                          sn_type = Odoc_env.subst_type env pattern_param.Typedtree.pat_type }
                    in
                    [ new_param ]
-
-               | {c_lhs=pattern_param; c_rhs=body} :: [] ->
+               | {c_rhs=Pattern_guarded_rhs _} :: [] -> []
+               | {c_lhs=pattern_param; c_rhs=Simple_rhs body | Boolean_guarded_rhs {bg_rhs = body}} :: [] ->
                    (* if this is the first call to the function, this is the first parameter and we skip it *)
                    if not first then
                      (
diff --git a/ocaml/testsuite/tests/pattern-guards/jane_test.ml b/ocaml/testsuite/tests/pattern-guards/jane_test.ml
index bc416f59873..c759ccb158d 100644
--- a/ocaml/testsuite/tests/pattern-guards/jane_test.ml
+++ b/ocaml/testsuite/tests/pattern-guards/jane_test.ml
@@ -33,7 +33,5 @@ let pattern_guard_doesnt_return_local f x =
   | _ -> 3
 ;;
 [%%expect{|
->> Fatal error: typechecking for multicase pattern guards unimplemented
-Uncaught exception: Misc.Fatal_error
-
+val pattern_guard_doesnt_return_local : 'a -> 'b option -> int = <fun>
 |}]
diff --git a/ocaml/testsuite/tests/pattern-guards/test.ml b/ocaml/testsuite/tests/pattern-guards/test.ml
index 279a94e7426..863c0db09a5 100644
--- a/ocaml/testsuite/tests/pattern-guards/test.ml
+++ b/ocaml/testsuite/tests/pattern-guards/test.ml
@@ -298,6 +298,19 @@ Line 3, characters 4-32:
 Error: Mixing value and exception patterns under when-guards is not supported.
 |}];;
 
+(* Test rejection of pattern guards on mixed exception/value or-patterns *)
+let reject_guarded_val_exn_orp k =
+  match k () with
+  | Some s | exception Failure s when s match "foo" -> s
+  | _ -> "Not foo"
+;;
+[%%expect{|
+Line 3, characters 4-32:
+3 |   | Some s | exception Failure s when s match "foo" -> s
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Mixing value and exception patterns under when-guards is not supported.
+|}];;
+
 module M : sig
   type 'a t
 
@@ -509,52 +522,36 @@ let collatz = function
 ;;
 
 [%%expect{|
->> Fatal error: typechecking for multicase pattern guards unimplemented
-Uncaught exception: Misc.Fatal_error
-
+val nested_singleway :
+  ('a -> 'b option) ->
+  ('b -> 'c option) -> ('c -> 'd option) -> default:'d -> 'a option -> 'd =
+  <fun>
+val collatz : int -> int option = <fun>
 |}];;
 
 nested_singleway collatz collatz collatz ~default:~-1 None;;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 None;;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = -1
 |}];;
 nested_singleway collatz collatz collatz ~default:~-1 (Some 1);;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 (Some 1);;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = -1
 |}];;
 nested_singleway collatz collatz collatz ~default:~-1 (Some 2);;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 (Some 2);;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = -1
 |}];;
 nested_singleway collatz collatz collatz ~default:~-1 (Some 3);;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 (Some 3);;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = 16
 |}];;
 nested_singleway collatz collatz collatz ~default:~-1 (Some 4);;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 (Some 4);;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = -1
 |}];;
 nested_singleway collatz collatz collatz ~default:~-1 (Some 8);;
 [%%expect{|
-Line 1, characters 0-16:
-1 | nested_singleway collatz collatz collatz ~default:~-1 (Some 8);;
-    ^^^^^^^^^^^^^^^^
-Error: Unbound value nested_singleway
+- : int = 1
 |}];;
 
 let find_multiway ~eq ~flag ~finish ~default = function
@@ -565,9 +562,9 @@ let find_multiway ~eq ~flag ~finish ~default = function
   | _ -> default
 ;;
 [%%expect{|
->> Fatal error: typechecking for multicase pattern guards unimplemented
-Uncaught exception: Misc.Fatal_error
-
+val find_multiway :
+  eq:('a -> 'a -> bool) ->
+  flag:'a -> finish:('a -> 'b) -> default:'b -> 'a list -> 'b = <fun>
 |}];;
 
 let eq n m = (n - m) mod 100 = 0;;
@@ -583,31 +580,19 @@ val default : string = "No match found"
 
 find_multiway ~eq ~flag ~finish ~default [ 10; 20; 110; 100 ];;
 [%%expect{|
-Line 1, characters 0-13:
-1 | find_multiway ~eq ~flag ~finish ~default [ 10; 20; 110; 100 ];;
-    ^^^^^^^^^^^^^
-Error: Unbound value find_multiway
+- : string = "110"
 |}];;
 find_multiway ~eq ~flag ~finish ~default [ 10; 20; 100; 110 ];;
 [%%expect{|
-Line 1, characters 0-13:
-1 | find_multiway ~eq ~flag ~finish ~default [ 10; 20; 100; 110 ];;
-    ^^^^^^^^^^^^^
-Error: Unbound value find_multiway
+- : string = "0"
 |}];;
 find_multiway ~eq ~flag ~finish ~default [ 10; 20; 30; 40 ];;
 [%%expect{|
-Line 1, characters 0-13:
-1 | find_multiway ~eq ~flag ~finish ~default [ 10; 20; 30; 40 ];;
-    ^^^^^^^^^^^^^
-Error: Unbound value find_multiway
+- : string = "No match found"
 |}];;
 find_multiway ~eq ~flag ~finish ~default [ 0; 100 ];;
 [%%expect{|
-Line 1, characters 0-13:
-1 | find_multiway ~eq ~flag ~finish ~default [ 0; 100 ];;
-    ^^^^^^^^^^^^^
-Error: Unbound value find_multiway
+- : string = "0"
 |}];;
 
 let nested_multiway f g h = function
@@ -621,9 +606,9 @@ let nested_multiway f g h = function
   | _ -> "not found"
 ;;
 [%%expect{|
->> Fatal error: typechecking for multicase pattern guards unimplemented
-Uncaught exception: Misc.Fatal_error
-
+val nested_multiway :
+  ('a -> string) ->
+  ('a -> string list) -> ('a -> bool) -> 'a option -> string = <fun>
 |}];;
 
 let f = function
@@ -647,45 +632,27 @@ val h : int -> bool = <fun>
 
 nested_multiway f g h None;;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h None;;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "not found"
 |}];;
 nested_multiway f g h (Some 0);;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h (Some 0);;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "not found"
 |}];;
 nested_multiway f g h (Some 1);;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h (Some 1);;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "foo1"
 |}];;
 nested_multiway f g h (Some 10);;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h (Some 10);;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "bar empty"
 |}];;
 nested_multiway f g h (Some 100);;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h (Some 100);;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "bar singleton one"
 |}];;
 nested_multiway f g h (Some 1000);;
 [%%expect{|
-Line 1, characters 0-15:
-1 | nested_multiway f g h (Some 1000);;
-    ^^^^^^^^^^^^^^^
-Error: Unbound value nested_multiway
+- : string = "not found"
 |}];;
 
 (* Checks that optional arguments with defaults are correclty bound in the
diff --git a/ocaml/typing/cmt2annot.ml b/ocaml/typing/cmt2annot.ml
index ab55f128a4a..00048757067 100644
--- a/ocaml/typing/cmt2annot.ml
+++ b/ocaml/typing/cmt2annot.ml
@@ -43,20 +43,13 @@ let bind_bindings scope bindings =
 
 let bind_cases l =
   List.iter
-    (fun {c_lhs; c_guard; c_rhs} ->
+    (fun {c_lhs; c_rhs} ->
       let loc =
-        let open Location in
-        match c_guard with
-        | None -> c_rhs.exp_loc
-        | Some g ->
-          let gexp =
-            match g with
-            | Predicate pred -> pred
-            | Pattern { pg_scrutinee; pg_pattern; _ } ->
-                bind_variables c_rhs.exp_loc pg_pattern;
-                pg_scrutinee
-              in
-          {c_rhs.exp_loc with loc_start=gexp.exp_loc.loc_start}
+        match c_rhs with
+        | Simple_rhs rhs -> rhs.exp_loc
+        | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+            { bg_rhs.exp_loc with loc_start = bg_guard.exp_loc.loc_start }
+        | Pattern_guarded_rhs { pg_loc; _ } -> pg_loc
       in
       bind_variables loc c_lhs
     )
diff --git a/ocaml/typing/parmatch.ml b/ocaml/typing/parmatch.ml
index 9edc4427914..bace829619b 100644
--- a/ocaml/typing/parmatch.ml
+++ b/ocaml/typing/parmatch.ml
@@ -1841,8 +1841,9 @@ let pressure_variants_in_computation_pattern tdefs patl =
 
 let rec initial_matrix = function
     [] -> []
-  | {c_guard=Some _} :: rem -> initial_matrix rem
-  | {c_guard=None; c_lhs=p} :: rem -> [p] :: initial_matrix rem
+  | { c_rhs = Simple_rhs _; c_lhs = p } :: rem -> [p] :: initial_matrix rem
+  | { c_rhs = Boolean_guarded_rhs _ | Pattern_guarded_rhs _; _ } :: rem ->
+      initial_matrix rem
 
 (*
    Build up a working pattern matrix by keeping
@@ -1850,10 +1851,10 @@ let rec initial_matrix = function
 *)
 let rec initial_only_guarded = function
   | [] -> []
-  | { c_guard = None; _} :: rem ->
+  | { c_rhs = Simple_rhs _; _ } :: rem ->
       initial_only_guarded rem
-  | { c_lhs = pat; _ } :: rem ->
-      [pat] :: initial_only_guarded rem
+  | { c_lhs = pat; c_rhs = Boolean_guarded_rhs _ | Pattern_guarded_rhs _ }
+    :: rem -> [pat] :: initial_only_guarded rem
 
 
 (************************)
@@ -2101,11 +2102,15 @@ let do_check_fragile loc casel pss =
 (********************************)
 
 let check_unused pred casel =
+  let is_refutation_case = function
+    | Simple_rhs { exp_desc = Texp_unreachable; _ } -> true
+    | Simple_rhs _ | Boolean_guarded_rhs _ | Pattern_guarded_rhs _ -> false
+  in
   if Warnings.is_active Warnings.Redundant_case
-  || List.exists (fun c -> c.c_rhs.exp_desc = Texp_unreachable) casel then
+  || List.exists (fun case -> is_refutation_case case.c_rhs) casel then
     let rec do_rec pref = function
       | [] -> ()
-      | {c_lhs=q; c_guard; c_rhs} :: rem ->
+      | {c_lhs=q; c_rhs} :: rem ->
           let qs = [q] in
             begin try
               let pss =
@@ -2116,7 +2121,7 @@ let check_unused pred casel =
                 |> get_mins le_pats in
               (* First look for redundant or partially redundant patterns *)
               let r = every_satisfiables (make_rows pss) (make_row qs) in
-              let refute = (c_rhs.exp_desc = Texp_unreachable) in
+              let refute = is_refutation_case c_rhs in
               (* Do not warn for unused [pat -> .] *)
               if r = Unused && refute then () else
               let r =
@@ -2163,11 +2168,11 @@ let check_unused pred casel =
             with Empty | Not_found -> assert false
             end ;
 
-          if c_guard <> None then
+          if is_guarded_rhs c_rhs then
             do_rec pref rem
           else
-            do_rec ([q]::pref) rem in
-
+            do_rec ([q]::pref) rem
+    in
     do_rec [] casel
 
 (*********************************)
@@ -2442,15 +2447,9 @@ let pattern_stable_vars ns p =
     (List.fold_left (fun m n -> Negative n :: m)
        [Positive {varsets = []; row = [p]}] ns)
 
-(* All identifier paths that appear in an expression that occurs
-   as a clause right hand side or guard.
-*)
+(* All identifier paths that appear in a case rhs's guard. *)
 
-let all_rhs_idents guard =
-  let exp = match guard with
-    | Predicate p -> p
-    | Pattern { pg_scrutinee; _ } -> pg_scrutinee
-  in
+let all_guard_idents c_rhs =
   let ids = ref Ident.Set.empty in
   let open Tast_iterator in
   let expr_iter iter exp =
@@ -2461,7 +2460,14 @@ let all_rhs_idents guard =
     | _ -> Tast_iterator.default_iterator.expr iter exp
   in
   let iterator = {Tast_iterator.default_iterator with expr = expr_iter} in
-  iterator.expr iterator exp;
+  let rec rhs_iter = function
+    | Simple_rhs _ -> ()
+    | Boolean_guarded_rhs { bg_guard; _ } -> iterator.expr iterator bg_guard
+    | Pattern_guarded_rhs { pg_scrutinee; pg_cases; _ } ->
+        iterator.expr iterator pg_scrutinee;
+        List.iter (fun case -> rhs_iter case.c_rhs) pg_cases
+  in
+  rhs_iter c_rhs;
   !ids
 
 let check_ambiguous_bindings =
@@ -2470,10 +2476,13 @@ let check_ambiguous_bindings =
   fun cases ->
     if is_active warn0 then
       let check_case ns case = match case with
-        | { c_lhs = p; c_guard=None ; _} -> [p]::ns
-        | { c_lhs=p; c_guard=Some g; _} ->
+        | { c_lhs = p; c_rhs = Simple_rhs _ } -> [p]::ns
+        | { c_lhs = p
+          ; c_rhs = Boolean_guarded_rhs _ | Pattern_guarded_rhs _ as c_rhs
+          ; _
+          } ->
             let all =
-              Ident.Set.inter (pattern_vars p) (all_rhs_idents g) in
+              Ident.Set.inter (pattern_vars p) (all_guard_idents c_rhs) in
             if not (Ident.Set.is_empty all) then begin
               match pattern_stable_vars ns p with
               | All -> ()
diff --git a/ocaml/typing/printtyped.ml b/ocaml/typing/printtyped.ml
index b881f455993..6ec06a367b2 100644
--- a/ocaml/typing/printtyped.ml
+++ b/ocaml/typing/printtyped.ml
@@ -1032,21 +1032,22 @@ and comprehension_iterator i ppf = function
 
 and case
     : type k . _ -> _ -> k case -> unit
-  = fun i ppf {c_lhs; c_guard; c_rhs} ->
+  = fun i ppf {c_lhs; c_rhs} ->
   line i ppf "<case>\n";
   pattern (i+1) ppf c_lhs;
-  begin match c_guard with
-  | None -> ()
-  | Some g -> line (i+1) ppf "<when>\n"; guard (i + 2) ppf g
-  end;
-  expression (i+1) ppf c_rhs;
-
-and guard i ppf = function
-  | Predicate p -> expression i ppf p
-  | Pattern { pg_scrutinee = e; pg_scrutinee_sort = s; pg_pattern = pat; _ } ->
-      expression i ppf e;
-      line i ppf "%a " Layouts.Sort.format s;
-      pattern i ppf pat
+  case_rhs (i+1) ppf c_rhs;
+
+and case_rhs i ppf = function
+  | Simple_rhs rhs -> expression i ppf rhs
+  | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+      line i ppf "<when>\n";
+      expression (i + 1) ppf bg_guard;
+      expression i ppf bg_rhs
+  | Pattern_guarded_rhs { pg_scrutinee; pg_scrutinee_sort; pg_cases } ->
+      line i ppf "<when-pattern>\n";
+      expression (i + 1) ppf pg_scrutinee;
+      line (i + 1) ppf "%a\n" Layouts.Sort.format pg_scrutinee_sort;
+      list (i + 1) case ppf pg_cases
 
 and value_binding i ppf x =
   line i ppf "<def>\n";
diff --git a/ocaml/typing/rec_check.ml b/ocaml/typing/rec_check.ml
index 93baec30351..7056ad65917 100644
--- a/ocaml/typing/rec_check.ml
+++ b/ocaml/typing/rec_check.ml
@@ -1189,22 +1189,22 @@ and value_bindings : rec_flag -> Typedtree.value_binding list -> bind_judg =
 *)
 and case
     : 'k . 'k Typedtree.case -> mode -> Env.t * mode
-  = fun { Typedtree.c_lhs; c_guard; c_rhs } ->
-      let judg = match c_guard with
+  = fun { Typedtree.c_lhs; c_rhs } ->
+      let judg = match c_rhs with
         (*
            p : mp -| G    G |- e : m
            ----------------------------
            G - p; m[mp] |- (p -> e) : m
         *)
-        | None -> expression c_rhs
+        | Simple_rhs rhs -> expression rhs
         (*
            Ge |- e : m    Gg |- g : m[Dereference]
            G := Ge+Gg     p : mp -| G
            ---------------------------------------
            G - p; m[mp] |- (p when g -> e) : m
         *)
-        | Some (Predicate p) ->
-            join [ expression p << Dereference; expression c_rhs ]
+        | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+            join [ expression bg_guard << Dereference; expression bg_rhs ]
         (*
            G |- (match e1 with p2 -> e2) : m
            p1 : mp -| G
@@ -1214,9 +1214,8 @@ and case
            This judgement uses uses the one in [match_expression] as a
            "subroutine."
         *)
-        | Some (Pattern { pg_scrutinee = e; pg_pattern = pat; _ }) ->
-          let cases = [ { c_lhs = pat; c_guard = None; c_rhs } ] in
-          match_expression e cases
+        | Pattern_guarded_rhs { pg_scrutinee; pg_cases; _ } ->
+          match_expression pg_scrutinee pg_cases
       in
       (fun m ->
         let env = judg m in
diff --git a/ocaml/typing/tast_iterator.ml b/ocaml/typing/tast_iterator.ml
index 6baee71ad68..1b04a0e98c1 100644
--- a/ocaml/typing/tast_iterator.ml
+++ b/ocaml/typing/tast_iterator.ml
@@ -20,6 +20,7 @@ type iterator =
   {
     binding_op: iterator -> binding_op -> unit;
     case: 'k . iterator -> 'k case -> unit;
+    case_rhs: iterator -> case_rhs -> unit;
     class_declaration: iterator -> class_declaration -> unit;
     class_description: iterator -> class_description -> unit;
     class_expr: iterator -> class_expr -> unit;
@@ -32,7 +33,6 @@ type iterator =
     env: iterator -> Env.t -> unit;
     expr: iterator -> expression -> unit;
     extension_constructor: iterator -> extension_constructor -> unit;
-    guard: iterator -> guard -> unit;
     module_binding: iterator -> module_binding -> unit;
     module_coercion: iterator -> module_coercion -> unit;
     module_declaration: iterator -> module_declaration -> unit;
@@ -502,17 +502,20 @@ let class_field sub {cf_desc; _} = match cf_desc with
 
 let value_bindings sub (_, list) = List.iter (sub.value_binding sub) list
 
-let case sub {c_lhs; c_guard; c_rhs} =
+let case sub {c_lhs; c_rhs} =
   sub.pat sub c_lhs;
-  Option.iter (sub.guard sub) c_guard;
-  sub.expr sub c_rhs
-
-let guard sub = function
-  | Predicate p -> sub.expr sub p
-  | Pattern { pg_scrutinee = e; pg_scrutinee_sort = _; pg_pattern = pat;
-              pg_partial = _; pg_env = _; pg_loc = _; } ->
-      sub.expr sub e;
-      sub.pat sub pat
+  sub.case_rhs sub c_rhs
+
+let case_rhs sub = function
+  | Simple_rhs e -> sub.expr sub e
+  | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+      sub.expr sub bg_guard;
+      sub.expr sub bg_rhs
+  | Pattern_guarded_rhs { pg_scrutinee; pg_scrutinee_sort=_; pg_cases;
+                          pg_partial=_; pg_loc=_; pg_env } ->
+      sub.env sub pg_env;
+      sub.expr sub pg_scrutinee;
+      List.iter (sub.case sub) pg_cases
 
 let value_binding sub {vb_pat; vb_expr; _} =
   sub.pat sub vb_pat;
@@ -524,6 +527,7 @@ let default_iterator =
   {
     binding_op;
     case;
+    case_rhs;
     class_declaration;
     class_description;
     class_expr;
@@ -535,7 +539,6 @@ let default_iterator =
     class_type_field;
     env;
     expr;
-    guard;
     extension_constructor;
     module_binding;
     module_coercion;
diff --git a/ocaml/typing/tast_iterator.mli b/ocaml/typing/tast_iterator.mli
index 3a863521602..4b06be442fa 100644
--- a/ocaml/typing/tast_iterator.mli
+++ b/ocaml/typing/tast_iterator.mli
@@ -24,6 +24,7 @@ type iterator =
   {
     binding_op: iterator -> binding_op -> unit;
     case: 'k . iterator -> 'k case -> unit;
+    case_rhs: iterator -> case_rhs -> unit;
     class_declaration: iterator -> class_declaration -> unit;
     class_description: iterator -> class_description -> unit;
     class_expr: iterator -> class_expr -> unit;
@@ -36,7 +37,6 @@ type iterator =
     env: iterator -> Env.t -> unit;
     expr: iterator -> expression -> unit;
     extension_constructor: iterator -> extension_constructor -> unit;
-    guard: iterator -> guard -> unit;
     module_binding: iterator -> module_binding -> unit;
     module_coercion: iterator -> module_coercion -> unit;
     module_declaration: iterator -> module_declaration -> unit;
diff --git a/ocaml/typing/tast_mapper.ml b/ocaml/typing/tast_mapper.ml
index b1adbcbba8c..e887414919e 100644
--- a/ocaml/typing/tast_mapper.ml
+++ b/ocaml/typing/tast_mapper.ml
@@ -23,6 +23,7 @@ type mapper =
   {
     binding_op: mapper -> binding_op -> binding_op;
     case: 'k . mapper -> 'k case -> 'k case;
+    case_rhs: mapper -> case_rhs -> case_rhs;
     class_declaration: mapper -> class_declaration -> class_declaration;
     class_description: mapper -> class_description -> class_description;
     class_expr: mapper -> class_expr -> class_expr;
@@ -37,7 +38,6 @@ type mapper =
     expr: mapper -> expression -> expression;
     extension_constructor: mapper -> extension_constructor ->
       extension_constructor;
-    guard: mapper -> guard -> guard;
     module_binding: mapper -> module_binding -> module_binding;
     module_coercion: mapper -> module_coercion -> module_coercion;
     module_declaration: mapper -> module_declaration -> module_declaration;
@@ -766,24 +766,28 @@ let value_bindings sub (rec_flag, list) =
 
 let case
   : type k . mapper -> k case -> k case
-  = fun sub {c_lhs; c_guard; c_rhs} ->
+  = fun sub {c_lhs; c_rhs} ->
   {
     c_lhs = sub.pat sub c_lhs;
-    c_guard = Option.map (sub.guard sub) c_guard;
-    c_rhs = sub.expr sub c_rhs;
+    c_rhs = sub.case_rhs sub c_rhs;
   }
 
-let guard sub = function
-  | Predicate p -> Predicate (sub.expr sub p)
-  | Pattern { pg_scrutinee; pg_scrutinee_sort; pg_pattern; pg_partial; pg_env;
-              pg_loc; } ->
-      Pattern
+let case_rhs sub = function
+  | Simple_rhs e -> Simple_rhs (sub.expr sub e)
+  | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+      Boolean_guarded_rhs
+        { bg_guard = sub.expr sub bg_guard; bg_rhs = sub.expr sub bg_rhs }
+  | Pattern_guarded_rhs { pg_scrutinee; pg_scrutinee_sort; pg_cases; pg_partial;
+                          pg_loc; pg_env; pg_type } ->
+      Pattern_guarded_rhs
         { pg_scrutinee = sub.expr sub pg_scrutinee
         ; pg_scrutinee_sort
-        ; pg_pattern = sub.pat sub pg_pattern
+        ; pg_cases = List.map (sub.case sub) pg_cases
         ; pg_partial
-        ; pg_env
-        ; pg_loc }
+        ; pg_loc
+        ; pg_env = sub.env sub pg_env
+        ; pg_type
+        }
 
 let value_binding sub x =
   let vb_pat = sub.pat sub x.vb_pat in
@@ -796,6 +800,7 @@ let default =
   {
     binding_op;
     case;
+    case_rhs;
     class_declaration;
     class_description;
     class_expr;
@@ -807,7 +812,6 @@ let default =
     class_type_field;
     env;
     expr;
-    guard;
     extension_constructor;
     module_binding;
     module_coercion;
diff --git a/ocaml/typing/tast_mapper.mli b/ocaml/typing/tast_mapper.mli
index 41857c4f1bd..bc099b5ee24 100644
--- a/ocaml/typing/tast_mapper.mli
+++ b/ocaml/typing/tast_mapper.mli
@@ -22,6 +22,7 @@ type mapper =
   {
     binding_op: mapper -> binding_op -> binding_op;
     case: 'k . mapper -> 'k case -> 'k case;
+    case_rhs: mapper -> case_rhs -> case_rhs;
     class_declaration: mapper -> class_declaration -> class_declaration;
     class_description: mapper -> class_description -> class_description;
     class_expr: mapper -> class_expr -> class_expr;
@@ -36,7 +37,6 @@ type mapper =
     expr: mapper -> expression -> expression;
     extension_constructor: mapper -> extension_constructor ->
       extension_constructor;
-    guard: mapper -> guard -> guard;
     module_binding: mapper -> module_binding -> module_binding;
     module_coercion: mapper -> module_coercion -> module_coercion;
     module_declaration: mapper -> module_declaration -> module_declaration;
diff --git a/ocaml/typing/typeclass.ml b/ocaml/typing/typeclass.ml
index e377b1b49d0..4965b4ca7ac 100644
--- a/ocaml/typing/typeclass.ml
+++ b/ocaml/typing/typeclass.ml
@@ -1225,7 +1225,7 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl =
       let partial =
         let dummy = type_exp val_env (Ast_helper.Exp.unreachable ()) in
         Typecore.check_partial ~warn_if:Partial val_env pat.pat_type pat.pat_loc
-          [{c_lhs = pat; c_guard = None; c_rhs = dummy}]
+          [{c_lhs = pat; c_rhs = Simple_rhs dummy}]
       in
       let val_env' = Env.add_lock Alloc_mode.global val_env' in
       Ctype.raise_nongen_level ();
diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml
index 288b5ca0de2..e1c0bfdc762 100644
--- a/ocaml/typing/typecore.ml
+++ b/ocaml/typing/typecore.ml
@@ -281,7 +281,7 @@ let check_probe_name name loc env =
 let mk_expected ?explanation ty = { ty; explanation; }
 
 let case lhs rhs =
-  {c_lhs = lhs; c_guard = None; c_rhs = rhs}
+  {c_lhs = lhs; c_rhs = Simple_rhs rhs}
 
 type position_in_function = FTail | FNontail
 
@@ -1441,9 +1441,9 @@ let split_cases env cases =
     | None -> lst
     | Some c_lhs -> { case with c_lhs } :: lst
   in
-  List.fold_right (fun ({ c_lhs; c_guard } as case) (vals, exns) ->
+  List.fold_right (fun ({ c_lhs; c_rhs } as case) (vals, exns) ->
     match split_pattern c_lhs with
-    | Some _, Some _ when c_guard <> None ->
+    | Some _, Some _ when is_guarded_rhs c_rhs ->
       raise (Error (c_lhs.pat_loc, env,
                     Mixed_value_and_exception_patterns_under_guard))
     | vp, ep -> add_case vals case vp, add_case exns case ep
@@ -2998,12 +2998,19 @@ let rec final_subexpression exp =
   | Texp_sequence (_, _, e)
   | Texp_try (e, _)
   | Texp_ifthenelse (_, e, _)
-  | Texp_match (_, _, {c_rhs=e} :: _, _)
   | Texp_letmodule (_, _, _, _, e)
   | Texp_letexception (_, e)
   | Texp_open (_, e)
     -> final_subexpression e
+  | Texp_match (_, _, case::_, _) -> final_case case
   | _ -> exp
+and final_case case =
+  match case.c_rhs with
+  | Simple_rhs e | Boolean_guarded_rhs { bg_rhs = e; _ } ->
+      final_subexpression e
+  | Pattern_guarded_rhs { pg_cases = case :: _; _ } -> final_case case
+  | Pattern_guarded_rhs { pg_cases = [] } ->
+      Misc.fatal_error "Typecore.final_case: empty cases in pattern guard"
 
 let is_prim ~name funct =
   match funct.exp_desc with
@@ -3363,19 +3370,19 @@ let rec is_nonexpansive exp =
           | Tpat_exception _ -> true
           | _ -> false } pat
       in
-      is_nonexpansive e &&
-      List.for_all
-        (fun {c_lhs; c_guard; c_rhs} ->
-           let is_guard_nonexpansive = match c_guard with
-             | None -> true
-             | Some (Typedtree.Predicate p) -> is_nonexpansive p
-             | Some (Typedtree.Pattern { pg_scrutinee; pg_pattern; _ }) ->
-                 is_nonexpansive pg_scrutinee
-                 && not (contains_exception_pat pg_pattern)
-           in
-           is_guard_nonexpansive && is_nonexpansive c_rhs
-           && not (contains_exception_pat c_lhs)
-        ) cases
+      let rec is_rhs_nonexpansive = function
+        | Simple_rhs rhs -> is_nonexpansive rhs
+        | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
+            is_nonexpansive bg_guard && is_nonexpansive bg_rhs
+        | Pattern_guarded_rhs { pg_scrutinee; pg_cases } ->
+            is_nonexpansive pg_scrutinee && are_cases_nonexpansive pg_cases
+      and are_cases_nonexpansive cases =
+        List.for_all
+          (fun {c_lhs; c_rhs} ->
+            not (contains_exception_pat c_lhs) && is_rhs_nonexpansive c_rhs)
+          cases
+      in
+      is_nonexpansive e && are_cases_nonexpansive cases
   | Texp_probe {handler} -> is_nonexpansive handler
   | Texp_tuple (el, _) ->
       List.for_all is_nonexpansive el
@@ -3936,10 +3943,9 @@ let check_partial_application ~statement exp =
             | Texp_probe _ | Texp_probe_is_enabled _
             | Texp_function _ ->
                 check_statement ()
-            | Texp_match (_, _, cases, _) ->
-                List.iter (fun {c_rhs; _} -> check c_rhs) cases
+            | Texp_match (_, _, cases, _) -> check_cases cases
             | Texp_try (e, cases) ->
-                check e; List.iter (fun {c_rhs; _} -> check c_rhs) cases
+                check e; check_cases cases
             | Texp_ifthenelse (_, e1, Some e2) ->
                 check e1; check e2
             | Texp_let (_, _, e) | Texp_sequence (_, _, e) | Texp_open (_, e)
@@ -3950,6 +3956,14 @@ let check_partial_application ~statement exp =
                 Location.prerr_warning exp_loc
                   Warnings.Ignored_partial_application
           end
+        and check_cases : 'k. 'k case list -> unit = fun cases ->
+          List.iter
+            (fun { c_rhs; _ } ->
+               match c_rhs with
+                 | Simple_rhs rhs | Boolean_guarded_rhs { bg_rhs = rhs; _ } ->
+                     check rhs
+                 | Pattern_guarded_rhs { pg_cases; _ } -> check_cases pg_cases)
+            cases
         in
         check exp
     | _ ->
@@ -6979,31 +6993,24 @@ and type_cases
             (* allow propagation from preceding branches *)
             correct_levels ty_res
           else ty_res in
-        let guard, exp =
+        let type_rhs rhs =
+          let rhs =
+            type_expect ?in_function ext_env emode rhs
+              (mk_expected ?explanation ty_res')
+          in
+          { rhs with exp_type = instance ty_res' }
+        in
+        let c_rhs =
           match pc_rhs with
-          | Psimple_rhs rhs | Pboolean_guarded_rhs { pbg_rhs = rhs; _ } ->
-              let guard =
-                match pc_rhs with
-                (* This case is unreachable, as [pc_rhs] cannot match the
-                   outer pattern while also matching [Ppattern_guarded_rhs _]
-                 *)
-                | Ppattern_guarded_rhs _ -> assert false
-                | Psimple_rhs _ -> None
-                | Pboolean_guarded_rhs { pbg_guard; _ } ->
-                    let expected_bool =
-                      mk_expected ~explanation:When_guard Predef.type_bool
-                    in
-                    let typed_guard =
-                      type_expect ext_env mode_local pbg_guard expected_bool
-                    in
-                    Some (Predicate typed_guard)
-              in
-              let exp =
-                type_expect ?in_function ext_env emode rhs
-                  (mk_expected ?explanation ty_res')
-              in
-              guard, exp
-          | Ppattern_guarded_rhs { ppg_scrutinee; ppg_cases; ppg_loc = loc } ->
+            | Psimple_rhs rhs -> Simple_rhs (type_rhs rhs)
+            | Pboolean_guarded_rhs { pbg_guard; pbg_rhs } ->
+                let guard =
+                  type_expect ext_env mode_local pbg_guard
+                    (mk_expected ~explanation:When_guard Predef.type_bool)
+                in
+                let rhs = type_rhs pbg_rhs in
+                Boolean_guarded_rhs { bg_guard = guard; bg_rhs = rhs }
+          | Ppattern_guarded_rhs { ppg_scrutinee; ppg_cases; ppg_loc } ->
               let { arg; sort; cases; partial; } =
                 type_match
                   (* Pattern guards containing no value cases will have an
@@ -7011,37 +7018,36 @@ and type_cases
                      case where no cases match, so we can successfully
                      typecheck such guards. Accordingly, [require_value_case]
                      is set to [false] below. *)
-                  ~require_value_case:false ppg_scrutinee ppg_cases ext_env loc
-                  Check_and_warn_if_total (mk_expected ?explanation ty_res')
-                  emode
+                  ~require_value_case:false ppg_scrutinee ppg_cases ext_env
+                  ppg_loc Check_and_warn_if_total
+                  (mk_expected ?explanation ty_res') emode
               in
-              match cases with
-              | [ { c_lhs = pat; c_guard = None; c_rhs = exp } ] ->
-                  let pattern_guard : Typedtree.guard =
-                    Pattern
-                      { pg_scrutinee = arg
-                      ; pg_scrutinee_sort = sort
-                      ; pg_pattern = pat
-                      ; pg_partial = partial
-                      ; pg_loc = loc
-                      ; pg_env = ext_env }
-                  in
-                  Some pattern_guard, exp
-              | _ ->
-                  fatal_error
-                    "typechecking for multicase pattern guards unimplemented"
+              Pattern_guarded_rhs
+                { pg_scrutinee = arg
+                ; pg_scrutinee_sort = sort
+                ; pg_cases = cases
+                ; pg_partial = partial
+                ; pg_loc = ppg_loc
+                ; pg_env = ext_env
+                ; pg_type = instance ty_res'
+                }
         in
         {
          c_lhs = pat;
-         c_guard = guard;
-         c_rhs = {exp with exp_type = instance ty_res'}
+         c_rhs
         }
       )
       half_typed_cases
   in
+  let rec iter_rhs ~f = function
+    | Simple_rhs e | Boolean_guarded_rhs { bg_rhs = e; _ } -> f e
+    | Pattern_guarded_rhs { pg_cases } -> iter_cases ~f pg_cases
+  and iter_cases : 'k. f:(expression -> unit) -> 'k case list -> unit =
+    fun ~f -> List.iter (fun case -> iter_rhs ~f case.c_rhs)
+  in
   if !Clflags.principal || does_contain_gadt then begin
     let ty_res' = instance ty_res in
-    List.iter (fun c -> unify_exp env c.c_rhs ty_res') cases
+    iter_cases ~f:(fun e -> unify_exp env e ty_res') cases
   end;
   let do_init = may_contain_gadts || needs_exhaust_check in
   let ty_arg_check =
diff --git a/ocaml/typing/typedtree.ml b/ocaml/typing/typedtree.ml
index 422592207b5..6f550979bf7 100644
--- a/ocaml/typing/typedtree.ml
+++ b/ocaml/typing/typedtree.ml
@@ -217,24 +217,23 @@ and comprehension_iterator =
       ; sequence : expression }
 
 and 'k case =
-  {
-    c_lhs: 'k general_pattern;
-    c_guard: guard option;
-    c_rhs: expression;
-  }
+{
+  c_lhs: 'k general_pattern;
+  c_rhs: case_rhs;
+}
   
-and guard =
-  | Predicate of expression
-  | Pattern of pattern_guard
-
-and pattern_guard =
-  { pg_scrutinee      : expression
-  ; pg_scrutinee_sort : Layouts.sort
-  ; pg_pattern        : computation general_pattern
-  ; pg_partial        : partial
-  ; pg_loc            : Location.t
-  ; pg_env            : Env.t
-  }
+and case_rhs =
+  | Simple_rhs of expression
+  | Boolean_guarded_rhs of { bg_guard : expression; bg_rhs : expression }
+  | Pattern_guarded_rhs of
+      { pg_scrutinee : expression
+      ; pg_scrutinee_sort : Layouts.sort
+      ; pg_cases : computation case list
+      ; pg_partial : partial
+      ; pg_loc : Location.t
+      ; pg_env : Env.t
+      ; pg_type : Types.type_expr
+      }
 
 and record_label_definition =
   | Kept of Types.type_expr
@@ -1021,3 +1020,7 @@ let split_pattern pat =
         combine_opts (into cpat) exns1 exns2
   in
   split_pattern pat
+
+let is_guarded_rhs = function
+  | Simple_rhs _ -> false
+  | Boolean_guarded_rhs _ | Pattern_guarded_rhs _ -> true
diff --git a/ocaml/typing/typedtree.mli b/ocaml/typing/typedtree.mli
index ba3ec75ab79..d497c200e4e 100644
--- a/ocaml/typing/typedtree.mli
+++ b/ocaml/typing/typedtree.mli
@@ -398,30 +398,40 @@ and comprehension_iterator =
 and 'k case =
     {
      c_lhs: 'k general_pattern;
-     c_guard: guard option;
-     c_rhs: expression;
+     c_rhs: case_rhs;
     }
 
-(* CR-soon rgodse: Rename these constructors to [Guard_predicate] and
-   [Guard_pattern] *)
-and guard =
-  | Predicate of expression
-  | Pattern of pattern_guard
-  (* [Pattern (scrutinee, sort, pattern, partial)] represents a pattern guard.
-     The case will be taken if [scrutinee] evaluates to a value matching
-     [pattern]. Variables bound by the pattern match are available on the RHS of
-     the case. Like the [Texp_match] constructor, [sort] is the sort of the
-     scrutinee, and [partial] denotes whether the case matches the scrutinee
-     partially or totally. *)
-
-and pattern_guard =
-  { pg_scrutinee      : expression
-  ; pg_scrutinee_sort : Layouts.sort
-  ; pg_pattern        : computation general_pattern
-  ; pg_partial        : partial
-  ; pg_loc            : Location.t
-  ; pg_env            : Env.t
-  }
+and case_rhs =
+  | Simple_rhs of expression
+  | Boolean_guarded_rhs of { bg_guard : expression; bg_rhs : expression }
+  | Pattern_guarded_rhs of
+      { pg_scrutinee : expression
+      ; pg_scrutinee_sort : Layouts.sort
+      ; pg_cases : computation case list
+      ; pg_partial : partial
+      ; pg_loc : Location.t
+      ; pg_env : Env.t
+      ; pg_type : Types.type_expr
+      }
+  (* [Pattern_guarded_rhs { pg_scrutinee; pg_scrutinee_sort; pg_cases;
+                            pg_partial; pg_partial; pg_loc; pg_env; pg_type } ]
+     represents a pattern guard case right-hand side.
+
+     [pg_env] contains the bindings available prior to the evaluation of the
+     pattern guard scrutinee, as in a match expression. These bindings are
+     available in all pattern guard cases.
+
+     The cases in [pg_cases] are checked in order: a given case will be taken if
+     [pg_scrutinee] evaluates to a value matching the pattern of that case. Each
+     case's rhs has access to the bindings in [pg_env], together with the
+     bindings in its own pattern.
+
+     Like the [Texp_match] constructor, [pg_scrutinee_sort] is the sort of the
+     scrutinee, and [pg_partial] denotes whether the case matches the scrutinee
+     partially or totally.
+     
+     [pg_loc] contains the source location of the guarded rhs, and [pg_type] is
+     the type returned by all cases of the pattern guard. *)
 
 and record_label_definition =
   | Kept of Types.type_expr
@@ -990,3 +1000,5 @@ val pat_bound_idents_full:
 (** Splits an or pattern into its value (left) and exception (right) parts. *)
 val split_pattern:
   computation general_pattern -> pattern option * pattern option
+
+val is_guarded_rhs: case_rhs -> bool
diff --git a/ocaml/typing/untypeast.ml b/ocaml/typing/untypeast.ml
index 2ef63987127..42245fa30fb 100644
--- a/ocaml/typing/untypeast.ml
+++ b/ocaml/typing/untypeast.ml
@@ -411,23 +411,19 @@ let exp_extra sub (extra, loc, attrs) sexp =
   Exp.mk ~loc ~attrs desc
 
 
-let case : type k . mapper -> k case -> _ = fun sub {c_lhs; c_guard; c_rhs} ->
+let case : type k . mapper -> k case -> _ = fun sub {c_lhs; c_rhs} ->
   {
    pc_lhs = sub.pat sub c_lhs;
    pc_rhs =
-     match c_guard with 
-     | None -> Psimple_rhs (sub.expr sub c_rhs)
-     | Some (Predicate cond) ->
+     match c_rhs with 
+     | Simple_rhs rhs -> Psimple_rhs (sub.expr sub rhs)
+     | Boolean_guarded_rhs { bg_guard; bg_rhs } ->
          Pboolean_guarded_rhs
-           { pbg_guard = sub.expr sub cond; pbg_rhs = sub.expr sub c_rhs }
-     | Some (Pattern { pg_scrutinee; pg_pattern; pg_loc; _ }) ->
+           { pbg_guard = sub.expr sub bg_guard; pbg_rhs = sub.expr sub bg_rhs }
+     | Pattern_guarded_rhs { pg_scrutinee; pg_cases; pg_loc; _ } ->
          Ppattern_guarded_rhs
            { ppg_scrutinee = sub.expr sub pg_scrutinee
-           ; ppg_cases =
-               [ { pc_lhs = sub.pat sub pg_pattern
-                 ; pc_rhs = Psimple_rhs (sub.expr sub c_rhs)
-                 }
-               ]
+           ; ppg_cases = List.map (sub.case sub) pg_cases
            ; ppg_loc = sub.location sub pg_loc
            }
   }
@@ -490,7 +486,7 @@ let expression sub exp =
 
     (* Pexp_function can't have a label, so we split in 3 cases. *)
     (* One case, no guard: It's a fun. *)
-    | Texp_function { arg_label; cases = [{c_lhs=p; c_guard=None; c_rhs=e}];
+    | Texp_function { arg_label; cases = [{c_lhs=p; c_rhs=Simple_rhs e}];
           _ } ->
         Pexp_fun (arg_label, None, sub.pat sub p, sub.expr sub e)
     (* No label: it's a function. *)
@@ -602,7 +598,11 @@ let expression sub exp =
         in
         let let_ = sub.binding_op sub let_ pat in
         let ands = List.map2 (sub.binding_op sub) ands and_pats in
-        let body = sub.expr sub body.c_rhs in
+        let body =
+          match body.c_rhs with 
+          | Simple_rhs rhs -> sub.expr sub rhs
+          | _ -> Misc.fatal_error "Untypeast.expression: guarded letop body"
+        in
         Pexp_letop {let_; ands; body }
     | Texp_unreachable ->
         Pexp_unreachable
@@ -986,8 +986,11 @@ let class_field sub cf =
     | Tcf_method (lab, priv, Tcfk_concrete (o, exp)) ->
         let remove_fun_self = function
           | { exp_desc =
-              Texp_function { arg_label = Nolabel; cases = [case]; _ } }
-            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+              Texp_function
+                { arg_label = Nolabel
+                ; cases = [ { c_lhs; c_rhs = Simple_rhs rhs } ]
+                ; _ } }
+            when is_self_pat c_lhs -> rhs
           | e -> e
         in
         let exp = remove_fun_self exp in
@@ -995,8 +998,11 @@ let class_field sub cf =
     | Tcf_initializer exp ->
         let remove_fun_self = function
           | { exp_desc =
-              Texp_function { arg_label = Nolabel; cases = [case]; _ } }
-            when is_self_pat case.c_lhs && case.c_guard = None -> case.c_rhs
+              Texp_function
+                { arg_label = Nolabel
+                ; cases = [ { c_lhs; c_rhs = Simple_rhs rhs } ]
+                ; _ } }
+            when is_self_pat c_lhs -> rhs
           | e -> e
         in
         let exp = remove_fun_self exp in