Proposal 869: pattern-matching syntax

core/desugarMatching.ml

@@ -6,10 +6,10 @@ open SourceCode
 
   This transformation convert function like that:
 
-  fun foo(a1, ..., an) match {
-    | case (p1_1, ..., p1_n) -> b_1
-    | ...
-    | case (pm_1, pm_n) -> b_m
+  fun foo(a1, ..., an) switch {
+    case (p1_1, ..., p1_n) -> b_1
+    ...
+    case (pm_1, pm_n) -> b_m
   }
 
   to function with switch body like that:
@@ -43,12 +43,12 @@ let pattern_matching_sugar_guard pos =
   if not (Settings.get pattern_matching_sugar)
   then raise (pattern_matching_sugar_disabled pos)
 
-let nullary_guard tuple pos =
+let nullary_guard pss pos =
   let nullary_error pos =
     Errors.desugaring_error ~pos:pos ~stage:Errors.DesugarMatching ~message:"Can't match over nullary function"
   in
-  match tuple with
-    | [] -> raise (nullary_error pos)
+  match pss with
+    | [[]] -> raise (nullary_error pos)
     | _ -> ()
 
 let desugar_matching =
@@ -57,12 +57,12 @@ object ((self : 'self_type))
     method! binding = fun b ->
       let pos = WithPos.pos b in
       match WithPos.node b with
-      |  Fun ({ fun_definition = (tvs, MatchFunlit (patterns, cases)); _ } as fn) ->
+      |  Fun ({ fun_definition = (tvs, SwitchFunlit (patterns, cases)); _ } as fn) ->
           pattern_matching_sugar_guard pos;
+          nullary_guard patterns pos;
           (* bind the arguments with unique var name *)
           let name_list = List.map (fun pats -> List.map (fun pat -> (pat, Utility.gensym())) pats) patterns in
           let switch_tuple = List.map (fun (_, name) -> with_pos (Var name)) (List.flatten name_list) in
-          nullary_guard switch_tuple pos;
           (* assemble exhaustive handler *)
           let exhaustive_patterns = with_pos (Pattern.Any) in
           let exhaustive_position = Format.sprintf "non-exhaustive pattern matching at %s" (SourceCode.Position.show pos) in

core/lens_sugar_conv.ml

@@ -113,6 +113,6 @@ let lens_sugar_phrase_of_sugar p =
       | _ ->
           Format.asprintf "Unsupported binder: %a" S.pp_phrase p
           |> Error.internal_error_res )
-  | S.FunLit (_, _, Sugartypes.MatchFunlit (_, _), _) -> assert false
+  | S.FunLit (_, _, Sugartypes.SwitchFunlit (_, _), _) -> assert false
   | _ -> lens_sugar_phrase_of_body "" p )
   |> Result.ok_exn

core/parser.mly

@@ -426,8 +426,8 @@ fun_declarations:
 fun_declaration:
 | tlfunbinding                                                 { fun_binding ~ppos:$loc($1) None $1 }
 | signatures tlfunbinding                                      { fun_binding ~ppos:$loc($2) (fst $1) ~unsafe_sig:(snd $1) $2 }
-| match_tlfunbinding                                           { match_fun_binding ~ppos:$loc($1) None $1 }
-| signatures match_tlfunbinding                                { match_fun_binding ~ppos:$loc($2) (fst $1) ~unsafe_sig:(snd $1) $2 }
+| switch_tlfunbinding                                          { switch_fun_binding ~ppos:$loc($1) None $1 }
+| signatures switch_tlfunbinding                               { switch_fun_binding ~ppos:$loc($2) (fst $1) ~unsafe_sig:(snd $1) $2 }
 
 linearity:
 | FUN                                                          { dl_unl }
@@ -445,10 +445,10 @@ tlfunbinding:
 | OP OPERATOR pattern perhaps_location block                   { ((dl_unl, false), $2, [[$3]], $4, $5)          }
 | OP pattern OPERATOR perhaps_location block                   { ((dl_unl, false), $3, [[$2]], $4, $5)          }
 
-match_tlfunbinding:
-| fun_kind VARIABLE arg_lists perhaps_location match_body      { ($1, $2, $3, $4, $5)   }
+switch_tlfunbinding:
+| fun_kind VARIABLE arg_lists perhaps_location switch_body     { ($1, $2, $3, $4, $5)   }
 
-match_body:
+switch_body:
 | SWITCH LBRACE case+ RBRACE                                   { $3 }
 
 tlvarbinding:
@@ -555,7 +555,7 @@ primary_expression:
 | LBRACKET exp DOTDOT exp RBRACKET                             { with_pos $loc (RangeLit($2, $4))   }
 | xml                                                          { $1 }
 | linearity arg_lists block                                    { fun_lit ~ppos:$loc $1 $2 $3 }
-| linearity arg_lists match_body                               { match_fun_lit ~ppos:$loc $1 $2 $3 }
+| linearity arg_lists switch_body                              { switch_fun_lit ~ppos:$loc $1 $2 $3 }
 | LEFTTRIANGLE cp_expression RIGHTTRIANGLE                     { with_pos $loc (CP $2) }
 | DOLLAR primary_expression                                    { with_pos $loc (Generalise $2) }
 
@@ -838,8 +838,8 @@ binding:
 | exp SEMICOLON                                                { with_pos $loc (Exp $1) }
 | signatures fun_kind VARIABLE arg_lists block                 { fun_binding ~ppos:$loc (fst $1) ~unsafe_sig:(snd $1) ($2, $3, $4, loc_unknown, $5) }
 | fun_kind VARIABLE arg_lists block                            { fun_binding ~ppos:$loc None ($1, $2, $3, loc_unknown, $4) }
-| signatures fun_kind VARIABLE arg_lists match_body            { match_fun_binding ~ppos:$loc (fst $1) ~unsafe_sig:(snd $1) ($2, $3, $4, loc_unknown, $5) }
-| fun_kind VARIABLE arg_lists match_body                       { match_fun_binding ~ppos:$loc None ($1, $2, $3, loc_unknown, $4) }
+| signatures fun_kind VARIABLE arg_lists switch_body           { switch_fun_binding ~ppos:$loc (fst $1) ~unsafe_sig:(snd $1) ($2, $3, $4, loc_unknown, $5) }
+| fun_kind VARIABLE arg_lists switch_body                      { switch_fun_binding ~ppos:$loc None ($1, $2, $3, loc_unknown, $4) }
 | typedecl SEMICOLON | links_module
 | links_open SEMICOLON                                         { $1 }
 

core/sugarConstructors.ml

@@ -136,8 +136,8 @@ module SugarConstructors (Position : Pos)
   let fun_lit ?(ppos=dp) ?args ?(location=loc_unknown) linearity pats blk =
     with_pos ppos (FunLit (args, linearity, NormalFunlit (pats, blk), location))
 
-  let match_fun_lit ?(ppos=dp) ?args ?(location=loc_unknown) linearity pats match_body =
-    with_pos ppos (FunLit (args, linearity, MatchFunlit (pats, match_body), location))
+  let switch_fun_lit ?(ppos=dp) ?args ?(location=loc_unknown) linearity pats switch_funlit_body =
+    with_pos ppos (FunLit (args, linearity, SwitchFunlit (pats, switch_funlit_body), location))
 
   (* Create a Spawn. *)
   let spawn ?(ppos=dp) ?row spawn_kind location blk =
@@ -175,11 +175,11 @@ module SugarConstructors (Position : Pos)
                          fun_frozen = false;
                          fun_unsafe_signature = false })
 
-  let match_fun_binding ?(ppos=dp) sig_opt ?(unsafe_sig=false) ((linearity, frozen), bndr, args, location, blk) =
+  let switch_fun_binding ?(ppos=dp) sig_opt ?(unsafe_sig=false) ((linearity, frozen), bndr, args, location, blk) =
     let fun_signature = datatype_opt_of_sig_opt sig_opt bndr in
       with_pos ppos (Fun { fun_binder = binder bndr;
                            fun_linearity = linearity;
-                           fun_definition = ([], MatchFunlit (args, blk));
+                           fun_definition = ([], SwitchFunlit (args, blk));
                            fun_location = location;
                            fun_signature;
                            fun_frozen = frozen;

core/sugarConstructorsIntf.ml

@@ -93,10 +93,10 @@ module type SugarConstructorsSig = sig
      -> ?location:Location.t -> DeclaredLinearity.t
      -> Pattern.with_pos list list -> phrase
      -> phrase
-  val match_fun_lit
+  val switch_fun_lit
       : ?ppos:t -> ?args:((Types.datatype * Types.row) list)
      -> ?location:Location.t -> DeclaredLinearity.t
-     -> Pattern.with_pos list list -> match_body
+     -> Pattern.with_pos list list -> switch_funlit_body
      -> phrase
   val spawn
       : ?ppos:t
@@ -119,9 +119,9 @@ module type SugarConstructorsSig = sig
      -> ?location:Location.t -> ?annotation:datatype'
      -> Binder.with_pos -> funlit
      -> binding
-  val match_fun_binding
+  val switch_fun_binding
       : ?ppos:t -> signature -> ?unsafe_sig:bool
-     -> ((DeclaredLinearity.t * bool) * Name.t * Pattern.with_pos list list * Location.t * match_body)
+     -> ((DeclaredLinearity.t * bool) * Name.t * Pattern.with_pos list list * Location.t * switch_funlit_body)
      -> binding
   val val_binding'
       : ?ppos:t -> signature -> (name_or_pat * phrase * Location.t)

core/sugarTraversals.ml

@@ -564,9 +564,9 @@ class map =
           | NormalFunlit (_x, _x_i1) ->
             let _x = o#list (fun o -> o#list (fun o -> o#pattern)) _x in
             let _x_i1 = o#phrase _x_i1 in NormalFunlit (_x, _x_i1)
-          | MatchFunlit (pat, body) ->
+          | SwitchFunlit (pat, body) ->
             let pat = o#list (fun o -> o#list (fun o -> o#pattern)) pat in
-            let body = o#list (fun o (p, c) -> let p = o#pattern p in let c = o#phrase c in (p, c)) body in MatchFunlit (pat, body)
+            let body = o#list (fun o (p, c) -> let p = o#pattern p in let c = o#phrase c in (p, c)) body in SwitchFunlit (pat, body)
 
     method handle_params : handler_parameterisation -> handler_parameterisation =
       fun { shp_bindings; shp_types }->
@@ -1297,7 +1297,7 @@ class fold =
           | NormalFunlit (_x, _x_i1) ->
             let o = o#list (fun o -> o#list (fun o -> o#pattern)) _x in
             let o = o#phrase _x_i1 in o
-          | MatchFunlit (pat, body) ->
+          | SwitchFunlit (pat, body) ->
             let o = o#list (fun o -> o#list (fun o -> o#pattern)) pat in
             let o = o#list (fun o (p, c) -> let o = o#pattern p in let o = o#phrase c in o) body in o
 
@@ -2131,9 +2131,9 @@ class fold_map =
           | NormalFunlit (_x, _x_i1) ->
             let (o, _x) = o#list (fun o -> o#list (fun o -> o#pattern)) _x in
             let (o, _x_i1) = o#phrase _x_i1 in (o, NormalFunlit (_x, _x_i1))
-          | MatchFunlit (pat, body) ->
+          | SwitchFunlit (pat, body) ->
             let (o, pat) = o#list (fun o -> o#list (fun o -> o#pattern)) pat in
-            let (o, body) = o#list (fun o (p, c) -> let (o, p) = o#pattern p in let (o, c) = o#phrase c in (o, (p, c))) body in (o, MatchFunlit (pat, body))
+            let (o, body) = o#list (fun o (p, c) -> let (o, p) = o#pattern p in let (o, c) = o#phrase c in (o, (p, c))) body in (o, SwitchFunlit (pat, body))
 
     method handle_params : handler_parameterisation -> ('self_type * handler_parameterisation) =
       fun { shp_bindings; shp_types } ->

core/sugartypes.ml

@@ -369,9 +369,9 @@ and regex =
   | Splice    of phrase
   | Replace   of regex * replace_rhs
 and clause = Pattern.with_pos * phrase
-and funlit = NormalFunlit of normal_funlit | MatchFunlit of match_funlit
-and match_funlit = Pattern.with_pos list list * match_body
-and match_body = (Pattern.with_pos * phrase) list
+and funlit = NormalFunlit of normal_funlit | SwitchFunlit of switch_funlit
+and switch_funlit = Pattern.with_pos list list * switch_funlit_body
+and switch_funlit_body = (Pattern.with_pos * phrase) list
 and normal_funlit = Pattern.with_pos list list * phrase
 and handler =
   { sh_expr         : phrase
@@ -772,12 +772,12 @@ struct
   and funlit (fn : funlit) : StringSet.t =
     match fn with
     | NormalFunlit n_fn -> normal_funlit n_fn
-    | MatchFunlit m_fn -> match_funlit m_fn
+    | SwitchFunlit m_fn -> switch_funlit m_fn
   and normal_funlit (args, body : normal_funlit) : StringSet.t =
     diff (phrase body) (union_map (union_map pattern) args)
-  and match_funlit (args, body : match_funlit) : StringSet.t =
-    diff (match_body body) (union_map (union_map pattern) args)
-  and match_body (body : (Pattern.with_pos * phrase) list) : StringSet.t =
+  and switch_funlit (args, body : switch_funlit) : StringSet.t =
+    diff (switch_funlit_body body) (union_map (union_map pattern) args)
+  and switch_funlit_body (body : (Pattern.with_pos * phrase) list) : StringSet.t =
     union_map (fun (pat, phr) -> union (pattern pat) (phrase phr)) body
   and block (binds, expr : binding list * phrase) : StringSet.t =
     ListLabels.fold_right binds ~init:(phrase expr)

core/transformSugar.ml

@@ -738,13 +738,13 @@ class transform (env : Types.typing_environment) =
             let (o, e, t) = o#phrase e in
             let o = o#restore_envs envs in
             (o, NormalFunlit (pss, e), t)
-          | MatchFunlit (pss, body) ->
+          | SwitchFunlit (pss, body) ->
             let envs = o#backup_envs in
             let (o, pss) = listu o (fun o -> listu o (fun o -> o#pattern)) pss in
             let o = o#with_effects inner_eff in
             let (o, body) = listu o (fun o (p, c) -> let (o, p) = o#pattern p in let (o, c, _) = o#phrase c in (o, (p, c))) body in
             let o = o#restore_envs envs in
-            (o, MatchFunlit (pss, body), Types.unit_type)
+            (o, SwitchFunlit (pss, body), Types.unit_type)
 
     method constant : Constant.t -> ('self_type * Constant.t * Types.datatype) =
       function