fix Ast_helper.Exp.case API

rajgodse · Aug 9, 2023 · eda68d3 · eda68d3
1 parent d1f899a
commit eda68d3
Show file tree

Hide file tree

Showing 6 changed files with 13 additions and 18 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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)