diff --git a/ocaml/boot/menhir/parser.ml b/ocaml/boot/menhir/parser.ml index 6c38a98b84e..97ab5bfb26b 100644 --- a/ocaml/boot/menhir/parser.ml +++ b/ocaml/boot/menhir/parser.ml @@ -21583,7 +21583,7 @@ module Tables = struct let _endpos = _endpos__3_ in let _v : (Parsetree.case) = # 3034 "parsing/parser.mly" - ( Exp.case _1 ~guard:None _3 ) + ( Exp.case _1 _3 ) # 21588 "parsing/parser.ml" in { @@ -21636,7 +21636,7 @@ module Tables = struct let _endpos = _endpos__5_ in let _v : (Parsetree.case) = # 3036 "parsing/parser.mly" - ( Exp.case _1 ~guard:(Some _3) _5 ) + ( Exp.case _1 ~guard:_3 _5 ) # 21641 "parsing/parser.ml" in { @@ -21891,7 +21891,7 @@ module Tables = struct let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in # 3050 "parsing/parser.mly" - ( Exp.case _1 ~guard:None (Exp.unreachable ~loc:(make_loc _loc__3_) ()) ) + ( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) ) # 21896 "parsing/parser.ml" in { diff --git a/ocaml/parsing/ast_helper.ml b/ocaml/parsing/ast_helper.ml index 339b3b59fb8..13e981f72cb 100644 --- a/ocaml/parsing/ast_helper.ml +++ b/ocaml/parsing/ast_helper.ml @@ -220,7 +220,7 @@ module Exp = struct let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable - let case lhs ~guard rhs = + let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; diff --git a/ocaml/parsing/ast_helper.mli b/ocaml/parsing/ast_helper.mli index 25811d2dfee..8e778e8c433 100644 --- a/ocaml/parsing/ast_helper.mli +++ b/ocaml/parsing/ast_helper.mli @@ -189,8 +189,8 @@ module Exp: -> binding_op list -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression - - val case: pattern -> guard:expression option -> expression -> case + + val case: pattern -> ?guard:expression -> expression -> case val binding_op: str -> pattern -> expression -> loc -> binding_op end diff --git a/ocaml/parsing/parser.mly b/ocaml/parsing/parser.mly index a05d827ecaf..09ad1d5246c 100644 --- a/ocaml/parsing/parser.mly +++ b/ocaml/parsing/parser.mly @@ -3031,9 +3031,9 @@ local_strict_binding: ; match_case: pattern MINUSGREATER seq_expr - { Exp.case $1 ~guard:None $3 } + { Exp.case $1 $3 } | pattern WHEN seq_expr MINUSGREATER seq_expr - { Exp.case $1 ~guard:(Some $3) $5 } + { Exp.case $1 ~guard:$3 $5 } /* CR-soon rgodse: We should consider whether to also allow seq_expr, as this also parses without conflict. @@ -3047,7 +3047,7 @@ match_case: { pcase_pattern_guarded ~loc:(make_loc ($startpos($2), $endpos)) $1 $3 $6 } | pattern MINUSGREATER DOT - { Exp.case $1 ~guard:None (Exp.unreachable ~loc:(make_loc $loc($3)) ()) } + { Exp.case $1 (Exp.unreachable ~loc:(make_loc $loc($3)) ()) } ; fun_def: MINUSGREATER seq_expr diff --git a/ocaml/typing/typeclass.ml b/ocaml/typing/typeclass.ml index e2c7e1476e6..8e22e3e2781 100644 --- a/ocaml/typing/typeclass.ml +++ b/ocaml/typing/typeclass.ml @@ -1164,14 +1164,12 @@ and class_expr_aux cl_num val_env met_env virt self_scope scl = (Pat.construct ~loc (mknoloc (Longident.(Ldot (Lident "*predef*", "Some")))) (Some ([], Pat.var ~loc (mknoloc "*sth*")))) - ~guard:None (Exp.ident ~loc (mknoloc (Longident.Lident "*sth*"))); Exp.case (Pat.construct ~loc (mknoloc (Longident.(Ldot (Lident "*predef*", "None")))) None) - ~guard:None default; ] in diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml index 8f1317711c0..6a5176b248f 100644 --- a/ocaml/typing/typecore.ml +++ b/ocaml/typing/typecore.ml @@ -4337,8 +4337,7 @@ and type_expect_ (* TODO: allow non-empty attributes? *) type_expect ?in_function env expected_mode {sexp with - pexp_desc = - Pexp_match (sval, [Ast_helper.Exp.case spat ~guard:None sbody])} + pexp_desc = Pexp_match (sval, [Ast_helper.Exp.case spat sbody])} ty_expected_explained | Pexp_let(rec_flag, spat_sexp_list, sbody) -> let existential_context = @@ -4430,14 +4429,12 @@ and type_expect_ (Pat.construct ~loc:default_loc (mknoloc (Longident.(Ldot (Lident "*predef*", "Some")))) (Some ([], Pat.var ~loc:default_loc (mknoloc "*sth*")))) - ~guard:None (Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*"))); Exp.case (Pat.construct ~loc:default_loc (mknoloc (Longident.(Ldot (Lident "*predef*", "None")))) None) - ~guard:None (Exp.apply ~loc:default_loc (Exp.extension (mknoloc "extension.escape", PStr [])) [Nolabel, default]); @@ -4463,7 +4460,7 @@ and type_expect_ type_function ?in_function loc sexp.pexp_attributes env expected_mode ty_expected_explained l ~has_local ~has_poly:false - [Exp.case pat ~guard:None body] + [Exp.case pat body] | Pexp_fun (l, None, spat, sbody) -> let has_local = has_local_attr_pat spat in let has_poly = has_poly_constraint spat in @@ -4475,7 +4472,7 @@ and type_expect_ Unsupported_extension Polymorphic_parameters)); type_function ?in_function loc sexp.pexp_attributes env expected_mode ty_expected_explained l ~has_local - ~has_poly [Ast_helper.Exp.case spat ~guard:None sbody] + ~has_poly [Ast_helper.Exp.case spat sbody] | Pexp_function caselist -> type_function ?in_function loc sexp.pexp_attributes env expected_mode @@ -5638,7 +5635,7 @@ and type_expect_ type_andops env slet.pbop_exp sands ty_andops in let body_env = Env.add_lock Alloc_mode.global env in - let scase = Ast_helper.Exp.case spat_params ~guard:None sbody in + let scase = Ast_helper.Exp.case spat_params sbody in let cases, partial = type_cases Value ~require_value_case:true body_env (simple_pat_mode Value_mode.global)