CHANGELOG.md

@@ -13,6 +13,17 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Assign patterns to variables (e.g. `let x::(t = y::_) = [1, 2, 3, 4]` where `t == [2, 3, 4]`)
 - Add builtin types (`AENS.name, AENS.pointee, Chain.ttl, Chain.base_tx, Chain.ga_meta_tx, Chain.paying_for_tx`) to
   the calldata and result decoder
+- Patterns guards
+  ```
+  switch(x)
+    a::[] | a > 10 => 1
+    _              => 2
+  ```
+  ```
+  function
+    f(a::[]) | a > 10 = 1
+    f(_)              = 2
+  ```
 ### Changed
 - Fixed the ACI renderer, it shouldn't drop the `stateful` modifier
 ### Removed

docs/sophia_features.md

@@ -121,7 +121,7 @@ contract IntHolder =
   type state = int
   entrypoint init(x) = x
   entrypoint get() = state
-  
+
 main contract IntHolderFactory =
   stateful entrypoint new(x : int) : IntHolder =
     let ih = Chain.create(x) : IntHolder
@@ -471,6 +471,8 @@ function
   get_left(Both(x, _)) = Some(x)
 ```
 
+*NOTE: Data types cannot currently be recursive.*
+
 Sophia also supports the assignment of patterns to variables:
 ```sophia
 function f(x) = switch(x)
@@ -482,7 +484,28 @@ function g(p : int * option(int)) : int =
   b
 ```
 
-*NOTE: Data types cannot currently be recursive.*
+Guards are boolean expressions that can be used on patterns in both switch
+statements and functions definitions. If a guard expression evaluates to
+`true`, then the corresponding body will be used. Otherwise, the next pattern
+will be checked:
+
+```sophia
+function get_left_if_positive(x : one_or_both(int, 'b)) : option(int) =
+  switch(x)
+    Left(x)    | x > 0 => Some(x)
+    Both(x, _) | x > 0 => Some(x)
+    _                  => None
+```
+
+```sophia
+function
+  get_left_if_positive : one_or_both(int, 'b) => option(int)
+  get_left_if_positive(Left(x))    | x > 0 = Some(x)
+  get_left_if_positive(Both(x, _)) | x > 0 = Some(x)
+  get_left_if_positive(_)                  = None
+```
+
+Guards cannot be stateful even when used inside a stateful function.
 
 ## Lists
 
@@ -851,4 +874,4 @@ Some chain operations (`Oracle.<operation>` and `AENS.<operation>`) have an
 optional delegation signature. This is typically used when a user/accounts
 would like to allow a contract to act on it's behalf. The exact data to be
 signed varies for the different operations, but in all cases you should prepend
-the signature data with the `network_id` (`ae_mainnet` for the æternity mainnet, etc.).
+the signature data with the `network_id` (`ae_mainnet` for the æternity mainnet, etc.).

src/aeso_ast_infer_types.erl

@@ -132,6 +132,7 @@
     , namespace        = []                 :: qname()
     , used_namespaces  = []                 :: used_namespaces()
     , in_pattern       = false              :: boolean()
+    , in_guard         = false              :: boolean()
     , stateful         = false              :: boolean()
     , current_function = none               :: none | aeso_syntax:id()
     , what             = top                :: top | namespace | contract | contract_interface
@@ -284,7 +285,7 @@ bind_contract({Contract, Ann, Id, Contents}, Env)
            contract_call_type(
              {fun_t, AnnF, [], [ArgT || {typed, _, _, ArgT} <- Args], RetT})
           }
-          || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, {typed, _, _, RetT}} <- Contents,
+          || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [{guarded, _, [], {typed, _, _, RetT}}]} <- Contents,
              Name =/= "init"
         ] ++
         %% Predefined fields
@@ -1356,23 +1357,29 @@ infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) ->
 infer_letfun(Env, LetFun = {letfun, Ann, Fun, _, _, _}) ->
     {{Name, Sig}, Clause} = infer_letfun1(Env, LetFun),
     {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, [Clause])}.
-
+infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, GuardedBodies}) ->
-infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Body}) ->
     Env = Env0#env{ stateful = aeso_syntax:get_ann(stateful, Attrib, false),
                     current_function = Fun },
     {NewEnv, {typed, _, {tuple, _, TypedArgs}, {tuple_t, _, ArgTypes}}} = infer_pattern(Env, {tuple, [{origin, system} | NameAttrib], Args}),
     ExpectedType = check_type(Env, arg_type(NameAttrib, What)),
-    NewBody={typed, _, _, ResultType} = check_expr(NewEnv, Body, ExpectedType),
+    InferGuardedBodies = fun({guarded, Ann, Guards, Body}) ->
+        NewGuards = lists:map(fun(Guard) ->
+                                  check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrib, "bool"})
+                              end, Guards),
+        NewBody = check_expr(NewEnv, Body, ExpectedType),
+        {guarded, Ann, NewGuards, NewBody}
+    end,
+    NewGuardedBodies = [{guarded, _, _, {typed, _, _, ResultType}} | _] = lists:map(InferGuardedBodies, GuardedBodies),
     NamedArgs = [],
     TypeSig = {type_sig, Attrib, none, NamedArgs, ArgTypes, ResultType},
     {{Name, TypeSig},
-     {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewBody}}.
+     {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewGuardedBodies}}.
 
 desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) ->
     NeedDesugar =
         case Clauses of
-            [{letfun, _, _, As, _, _}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As);
+            [{letfun, _, _, As, _, [{guarded, _, [], _}]}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As);
-            _                          -> true
+            _                                              -> true
         end,
     case NeedDesugar of
         false -> [Clause] = Clauses, Clause;
@@ -1383,11 +1390,10 @@ desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) ->
             Tuple = fun([X]) -> X;
                        (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}}
                     end,
-            {letfun, Ann, Fun, Args, RetType,
+            {letfun, Ann, Fun, Args, RetType, [{guarded, NoAnn, [], {typed, NoAnn,
-             {typed, NoAnn,
+               {switch, NoAnn, Tuple(Args),
-              {switch, NoAnn, Tuple(Args),
+                 [ {'case', AnnC, Tuple(ArgsC), GuardedBodies}
-                [ {'case', AnnC, Tuple(ArgsC), Body}
+                 || {letfun, AnnC, _, ArgsC, _, GuardedBodies} <- Clauses ]}, RetType}}]}
-                || {letfun, AnnC, _, ArgsC, _, Body} <- Clauses ]}, RetType}}
     end.
 
 print_typesig({Name, TypeSig}) ->
@@ -1425,6 +1431,12 @@ lookup_name(Env, As, Id, Options) ->
             {set_qname(QId, Id), Ty1}
     end.
 
+check_stateful(#env{ in_guard = true }, Id, Type = {type_sig, _, _, _, _, _}) ->
+    case aeso_syntax:get_ann(stateful, Type, false) of
+        false -> ok;
+        true  ->
+            type_error({stateful_not_allowed_in_guards, Id})
+    end;
 check_stateful(#env{ stateful = false, current_function = Fun }, Id, Type = {type_sig, _, _, _, _, _}) ->
     case aeso_syntax:get_ann(stateful, Type, false) of
         false -> ok;
@@ -1449,7 +1461,7 @@ check_state_dependencies(Env, Defs) ->
     SetState  = Top ++ ["put"],
     Init      = Top ++ ["init"],
     UsedNames = fun(X) -> [{Xs, Ann} || {{term, Xs}, Ann} <- aeso_syntax_utils:used(X)] end,
-    Funs      = [ {Top ++ [Name], Fun} || Fun = {letfun, _, {id, _, Name}, _Args, _Type, _Body} <- Defs ],
+    Funs      = [ {Top ++ [Name], Fun} || Fun = {letfun, _, {id, _, Name}, _Args, _Type, _GuardedBodies} <- Defs ],
     Deps      = maps:from_list([{Name, UsedNames(Def)} || {Name, Def} <- Funs]),
     case maps:get(Init, Deps, false) of
         false -> ok;    %% No init, so nothing to check
@@ -1553,12 +1565,12 @@ infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Re
 infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, E}|Rest]}) ->
     NewE = {typed, _, _, PatType} = infer_expr(Env, E),
     BlockType = fresh_uvar(AsLV),
-    {'case', _, NewPattern, NewRest} =
+    {'case', _, NewPattern, [{guarded, _, [], NewRest}]} =
         infer_case( Env
                   , AsLC
                   , Pattern
                   , PatType
-                  , {list_comp, AsLC, Yield, Rest}
+                  , [{guarded, AsLC, [], {list_comp, AsLC, Yield, Rest}}]
                   , BlockType),
     {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = NewRest,
     { typed
@@ -1616,8 +1628,8 @@ infer_expr(Env, {'if', Attrs, Cond, Then, Else}) ->
 infer_expr(Env, {switch, Attrs, Expr, Cases}) ->
     NewExpr = {typed, _, _, ExprType} = infer_expr(Env, Expr),
     SwitchType = fresh_uvar(Attrs),
-    NewCases = [infer_case(Env, As, Pattern, ExprType, Branch, SwitchType)
+    NewCases = [infer_case(Env, As, Pattern, ExprType, GuardedBranches, SwitchType)
-                || {'case', As, Pattern, Branch} <- Cases],
+                || {'case', As, Pattern, GuardedBranches} <- Cases],
     {typed, Attrs, {switch, Attrs, NewExpr, NewCases}, SwitchType};
 infer_expr(Env, {record, Attrs, Fields}) ->
     RecordType = fresh_uvar(Attrs),
@@ -1699,8 +1711,8 @@ infer_expr(Env, {lam, Attrs, Args, Body}) ->
     ArgTypes = [fresh_uvar(As) || {arg, As, _, _} <- Args],
     ArgPatterns = [{typed, As, Pat, check_type(Env, T)} || {arg, As, Pat, T} <- Args],
     ResultType = fresh_uvar(Attrs),
-    {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, NewBody} =
+    {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, [{guarded, _, [], NewBody}]} =
-        infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType),
+        infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, [{guarded, Attrs, [], Body}], ResultType),
     NewArgs = [{arg, As, NewPat, NewT} || {typed, As, NewPat, NewT} <- NewArgPatterns],
     {typed, Attrs, {lam, Attrs, NewArgs, NewBody}, {fun_t, Attrs, [], ArgTypes, ResultType}};
 infer_expr(Env, {letpat, Attrs, Id, Pattern}) ->
@@ -1836,11 +1848,18 @@ infer_pattern(Env, Pattern) ->
     NewPattern = infer_expr(NewEnv, Pattern),
     {NewEnv#env{ in_pattern = Env#env.in_pattern }, NewPattern}.
 
-infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) ->
+infer_case(Env, Attrs, Pattern, ExprType, GuardedBranches, SwitchType) ->
     {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern),
-    NewBranch  = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType),
+    InferGuardedBranches = fun({guarded, Ann, Guards, Branch}) ->
+        NewGuards = lists:map(fun(Guard) ->
+                                  check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrs, "bool"})
+                              end, Guards),
+        NewBranch = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType),
+        {guarded, Ann, NewGuards, NewBranch}
+    end,
+    NewGuardedBranches = lists:map(InferGuardedBranches, GuardedBranches),
     unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}),
-    {'case', Attrs, NewPattern, NewBranch}.
+    {'case', Attrs, NewPattern, NewGuardedBranches}.
 
 %% NewStmts = infer_block(Env, Attrs, Stmts, BlockType)
 infer_block(_Env, Attrs, [], BlockType) ->
@@ -1854,8 +1873,8 @@ infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) ->
     [LetFun|infer_block(NewE, Attrs, Rest, BlockType)];
 infer_block(Env, _, [{letval, Attrs, Pattern, E}|Rest], BlockType) ->
     NewE = {typed, _, _, PatType} = infer_expr(Env, E),
-    {'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} =
+    {'case', _, NewPattern, [{guarded, _, [], {typed, _, {block, _, NewRest}, _}}]} =
-        infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType),
+        infer_case(Env, Attrs, Pattern, PatType, [{guarded, Attrs, [], {block, Attrs, Rest}}], BlockType),
     [{letval, Attrs, NewPattern, NewE}|NewRest];
 infer_block(Env, Attrs, [Using = {using, _, _, _, _} | Rest], BlockType) ->
     infer_block(check_usings(Env, Using), Attrs, Rest, BlockType);
@@ -2424,8 +2443,8 @@ unfold_types(Env, {type_def, Ann, Name, Args, Def}, Options) ->
     {type_def, Ann, Name, Args, unfold_types_in_type(Env, Def, Options)};
 unfold_types(Env, {fun_decl, Ann, Name, Type}, Options) ->
     {fun_decl, Ann, Name, unfold_types(Env, Type, Options)};
-unfold_types(Env, {letfun, Ann, Name, Args, Type, Body}, Options) ->
+unfold_types(Env, {letfun, Ann, Name, Args, Type, [{guarded, AnnG, [], Body}]}, Options) ->
-    {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), unfold_types(Env, Body, Options)};
+    {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), [{guarded, AnnG, [], unfold_types(Env, Body, Options)}]};
 unfold_types(Env, T, Options) when is_tuple(T) ->
     list_to_tuple(unfold_types(Env, tuple_to_list(T), Options));
 unfold_types(Env, [H|T], Options) ->
@@ -2926,6 +2945,10 @@ mk_error({stateful_not_allowed, Id, Fun}) ->
     Msg = io_lib:format("Cannot reference stateful function ~s (at ~s)\nin the definition of non-stateful function ~s.\n",
                         [pp(Id), pp_loc(Id), pp(Fun)]),
     mk_t_err(pos(Id), Msg);
+mk_error({stateful_not_allowed_in_guards, Id}) ->
+    Msg = io_lib:format("Cannot reference stateful function ~s (at ~s) in a pattern guard.\n",
+                        [pp(Id), pp_loc(Id)]),
+    mk_t_err(pos(Id), Msg);
 mk_error({value_arg_not_allowed, Value, Fun}) ->
     Msg = io_lib:format("Cannot pass non-zero value argument ~s (at ~s)\nin the definition of non-stateful function ~s.\n",
                         [pp_expr("", Value), pp_loc(Value), pp(Fun)]),

src/aeso_ast_to_fcode.erl

@@ -385,7 +385,7 @@ decl_to_fcode(Env = #{context := {contract_def, _}}, {fun_decl, _, Id, _}) ->
 decl_to_fcode(Env, {fun_decl, _, _, _})  -> Env;
 decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) ->
     typedef_to_fcode(Env, Name, Args, Def);
-decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, Body}) ->
+decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) ->
     Attrs = get_attributes(Ann),
     FName = lookup_fun(Env, qname(Env, Name)),
     FArgs = args_to_fcode(Env, Args),
@@ -662,8 +662,8 @@ expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {ty
     Arg  = fresh_name(),
     Env1 = bind_var(Env, Arg),
     Bind = {lam, [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType},
-                                                [{'case', As, Pat, {list_comp, As, Yield, Rest}},
+                                                [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]},
-                                                 {'case', As, {id, As, "_"}, {list, As, []}}]})},
+                                                 {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]})},
     {def_u, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]),
     {def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]};
 expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) ->
@@ -683,9 +683,9 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) ->
             expr_to_fcode(Env, Else));
 
 %% Switch
-expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, E, Type}, Alts}) ->
+expr_to_fcode(Env, _, S = {switch, _, Expr = {typed, _, E, Type}, Alts}) ->
     Switch = fun(X) ->
-                {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts)}
+                {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts, S)}
              end,
     case E of
         {id, _, X} -> Switch(X);
@@ -798,6 +798,13 @@ make_if(Cond, Then, Else) ->
     X = fresh_name(),
     {'let', X, Cond, make_if({var, X}, Then, Else)}.
 
+make_if_no_else({var, X}, Then) ->
+    {switch, {split, boolean, X,
+        [{'case', {bool, true},  {nosplit, Then}}]}};
+make_if_no_else(Cond, Then) ->
+    X = fresh_name(),
+    {'let', X, Cond, make_if_no_else({var, X}, Then)}.
+
 -spec make_tuple([fexpr()]) -> fexpr().
 make_tuple([E]) -> E;
 make_tuple(Es) -> {tuple, Es}.
@@ -863,9 +870,9 @@ is_first_order(_)                      -> true.
 
 %% -- Pattern matching --
 
--spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit().
+-spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()], aeso_syntax:expr()) -> fsplit().
-alts_to_fcode(Env, Type, X, Alts) ->
+alts_to_fcode(Env, Type, X, Alts, Switch) ->
-    FAlts = [alt_to_fcode(Env, Alt) || Alt <- Alts],
+    FAlts = remove_guards(Env, Alts, Switch),
     split_tree(Env, [{X, Type}], FAlts).
 
 %% Intermediate format before case trees (fcase() and fsplit()).
@@ -879,6 +886,41 @@ alts_to_fcode(Env, Type, X, Alts) ->
               | {con, arities(), tag(), [fpat()]}
               | {assign, fpat(), fpat()}.
 
+remove_guards(_Env, [], _Switch) ->
+    [];
+remove_guards(Env, [Alt = {'case', _, _, [{guarded, _, [], _Expr}]} | Rest], Switch) ->
+    [alt_to_fcode(Env, Alt) | remove_guards(Env, Rest, Switch)];
+remove_guards(Env, [{'case', AnnC, Pat, [{guarded, AnnG, [Guard | Guards], Body} | GuardedBodies]} | Rest], Switch = {switch, Ann, Expr, _}) ->
+    FPat = pat_to_fcode(Env, Pat),
+    FGuard = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Guard),
+    FBody = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Body),
+    case Guards of
+        [] ->
+            R = case GuardedBodies of
+                    [] -> Rest;
+                    _  -> [{'case', AnnC, Pat, GuardedBodies} | Rest]
+                end,
+            case R of
+                [] ->
+                    [{'case', [FPat], make_if_no_else(FGuard, FBody)} | remove_guards(Env, Rest, Switch)];
+                _ ->
+                    FSwitch = expr_to_fcode(Env, {switch, Ann, Expr, R}),
+                    [{'case', [FPat], make_if(FGuard, FBody, FSwitch)} | remove_guards(Env, Rest, Switch)]
+            end;
+        _ ->
+            R1 = case GuardedBodies of
+                     [] -> [{'case', AnnC, Pat, [{guarded, AnnG, Guards, Body}]} | Rest];
+                     _  -> [{'case', AnnC, Pat, [{guarded, AnnG, Guards, Body} | GuardedBodies]} | Rest]
+                 end,
+            R2 = case GuardedBodies of
+                     [] -> Rest;
+                     _  -> [{'case', AnnC, Pat, GuardedBodies} | Rest]
+                 end,
+            FSwitch1 = expr_to_fcode(Env, {switch, Ann, Expr, R1}),
+            FSwitch2 = expr_to_fcode(Env, {switch, Ann, Expr, R2}),
+            [{'case', [FPat], make_if(FGuard, FSwitch1, FSwitch2)} | remove_guards(Env, Rest, Switch)]
+    end.
+
 %% %% Invariant: the number of variables matches the number of patterns in each falt.
 -spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fsplit().
 split_tree(_Env, _Vars, []) ->
@@ -1005,7 +1047,7 @@ next_split(Pats) ->
     end.
 
 -spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt().
-alt_to_fcode(Env, {'case', _, Pat, Expr}) ->
+alt_to_fcode(Env, {'case', _, Pat, [{guarded, _, [], Expr}]}) ->
     FPat  = pat_to_fcode(Env, Pat),
     FExpr = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Expr),
     {'case', [FPat], FExpr}.
@@ -1083,8 +1125,8 @@ decision_tree_to_fcode({'if', A, Then, Else}) ->
 stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, Expr} | Stmts]) ->
     {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)};
 stmts_to_fcode(Env, [{letval, Ann, Pat, Expr} | Stmts]) ->
-    expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, {block, Ann, Stmts}}]});
+    expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, [{guarded, Ann, [], {block, Ann, Stmts}}]}]});
-stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, Expr} | Stmts]) ->
+stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, [{guarded, _, [], Expr}]} | Stmts]) ->
     LamArgs = [ case Arg of
                     {typed, Ann1, Id, T} -> {arg, Ann1, Id, T};
                     _ -> internal_error({bad_arg, Arg})   %% pattern matching has been desugared

src/aeso_ast_to_icode.erl

@@ -96,7 +96,7 @@ contract_to_icode([Decl = {type_def, _Attrib, Id = {id, _, Name}, Args, Def} | R
                 _                       -> Icode1
              end,
     contract_to_icode(Rest, Icode2);
-contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest], Icode) ->
+contract_to_icode([{letfun, Attrib, Name, Args, _What, [{guarded, _, [], Body={typed,_,_,T}}]}|Rest], Icode) ->
     FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++
                [ payable  || proplists:get_value(payable, Attrib, false) ] ++
                [ private  || is_private(Attrib, Icode) ],
@@ -323,8 +323,8 @@ ast_body({list_comp, _, Yield, []}, Icode) ->
 ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, _, Pat, ArgType}, BindExpr}|Rest]}, Icode) ->
     Arg  = "%lc",
     Body = {switch, As, {typed, As, {id, As, Arg}, ArgType},
-                [{'case', As, Pat, {list_comp, As, Yield, Rest}},
+                [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]},
-                 {'case', As, {id, As, "_"}, {list, As, []}}]},
+                 {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]},
     #funcall
         { function = #var_ref{ name = ["ListInternal", "flat_map"] }
         , args =
@@ -349,14 +349,14 @@ ast_body({switch,_,A,Cases}, Icode) ->
     %% patterns appear in cases.
     #switch{expr=ast_body(A, Icode),
             cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)}
-              || {'case',_,Pat,Body} <- Cases]};
+              || {'case',_,Pat,[{guarded, _, [], Body}]} <- Cases]};
 ast_body({block, As, [{letval, _, Pat, E} | Rest]}, Icode) ->
     E1    = ast_body(E, Icode),
     Pat1  = ast_body(Pat, Icode),
     Rest1 = ast_body({block, As, Rest}, Icode),
     #switch{expr  = E1,
             cases = [{Pat1, Rest1}]};
-ast_body({block, As, [{letfun, Ann, F, Args, _Type, Expr} | Rest]}, Icode) ->
+ast_body({block, As, [{letfun, Ann, F, Args, _Type, [{guarded, _, [], Expr}]} | Rest]}, Icode) ->
     ToArg   = fun({typed, Ann1, Id, T}) -> {arg, Ann1, Id, T} end,    %% Pattern matching has been desugared
     LamArgs = lists:map(ToArg, Args),
     ast_body({block, As, [{letval, Ann, F, {lam, Ann, LamArgs, Expr}} | Rest]}, Icode);

src/aeso_compiler.erl

@@ -475,9 +475,9 @@ error_missing_call_function() ->
 get_call_type([{Contract, _, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) ->
     case [ {lists:last(QFunName), FunType}
           || {letfun, _, {id, _, ?CALL_NAME}, [], _Ret,
-                {typed, _,
+                [{guarded, _, [], {typed, _,
-                    {app, _,
+                     {app, _,
-                        {typed, _, {qid, _, QFunName}, FunType}, _}, _}} <- Defs ] of
+                         {typed, _, {qid, _, QFunName}, FunType}, _}, _}}]} <- Defs ] of
         [Call] -> {ok, Call};
         []     -> error_missing_call_function()
     end;

src/aeso_parse_lib.hrl

@@ -9,12 +9,14 @@
         false -> fail()
     end).
 
--define(RULE(A,                Do), map(fun(_1) ->                       Do end, A                 )).
+-define(RULE(A,                      Do), map(fun(_1) ->                               Do end, A                       )).
--define(RULE(A, B,             Do), map(fun({_1, _2}) ->                 Do end, {A, B}            )).
+-define(RULE(A, B,                   Do), map(fun({_1, _2}) ->                         Do end, {A, B}                  )).
--define(RULE(A, B, C,          Do), map(fun({_1, _2, _3}) ->             Do end, {A, B, C}         )).
+-define(RULE(A, B, C,                Do), map(fun({_1, _2, _3}) ->                     Do end, {A, B, C}               )).
--define(RULE(A, B, C, D,       Do), map(fun({_1, _2, _3, _4}) ->         Do end, {A, B, C, D}      )).
+-define(RULE(A, B, C, D,             Do), map(fun({_1, _2, _3, _4}) ->                 Do end, {A, B, C, D}            )).
--define(RULE(A, B, C, D, E,    Do), map(fun({_1, _2, _3, _4, _5}) ->     Do end, {A, B, C, D, E}   )).
+-define(RULE(A, B, C, D, E,          Do), map(fun({_1, _2, _3, _4, _5}) ->             Do end, {A, B, C, D, E}         )).
--define(RULE(A, B, C, D, E, F, Do), map(fun({_1, _2, _3, _4, _5, _6}) -> Do end, {A, B, C, D, E, F})).
+-define(RULE(A, B, C, D, E, F,       Do), map(fun({_1, _2, _3, _4, _5, _6}) ->         Do end, {A, B, C, D, E, F}      )).
+-define(RULE(A, B, C, D, E, F, G,    Do), map(fun({_1, _2, _3, _4, _5, _6, _7}) ->     Do end, {A, B, C, D, E, F, G}   )).
+-define(RULE(A, B, C, D, E, F, G, H, Do), map(fun({_1, _2, _3, _4, _5, _6, _7, _8}) -> Do end, {A, B, C, D, E, F, G, H})).
 
 -import(aeso_parse_lib,
         [tok/1, tok/2, between/3, many/1, many1/1, sep/2, sep1/2,

src/aeso_parser.erl

@@ -211,10 +211,16 @@ letdef() -> choice(valdef(), fundef()).
 valdef() ->
     ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}).
 
+guarded_fundefs() ->
+    choice(
+    [ ?RULE(keyword('='), body(), [{guarded, _1, [], _2}])
+    , maybe_block(?RULE(keyword('|'), comma_sep(expr()), tok('='), body(), {guarded, _1, _2, _4}))
+    ]).
+
 fundef() ->
     choice(
-    [ ?RULE(id(), args(),                   tok('='), body(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _4})
+    [ ?RULE(id(), args(),                   guarded_fundefs(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _3})
-    , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6})
+    , ?RULE(id(), args(), tok(':'), type(), guarded_fundefs(), {letfun, get_ann(_1), _1, _2, _4, _5})
     ]).
 
 args() -> paren_list(pattern()).
@@ -283,7 +289,13 @@ stmt() ->
     ])).
 
 branch() ->
-    ?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, _3}).
+    ?RULE(pattern(), guarded_branches(), {'case', get_ann(lists:nth(1, _2)), _1, _2}).
+
+guarded_branches() ->
+    choice(
+    [ ?RULE(keyword('=>'), body(), [{guarded, _1, [], _2}])
+    , maybe_block(?RULE(tok('|'), comma_sep(expr()), keyword('=>'), body(), {guarded, _3, _2, _4}))
+    ]).
 
 pattern() ->
     ?LET_P(E, expr(), parse_pattern(E)).

src/aeso_pretty.erl

@@ -212,8 +212,10 @@ name({typed, _, Name, _}) -> name(Name).
 -spec letdecl(string(), aeso_syntax:letbind()) -> doc().
 letdecl(Let, {letval, _, P, E}) ->
     block_expr(0, hsep([text(Let), expr(P), text("=")]), E);
-letdecl(Let, {letfun, _, F, Args, T, E}) ->
+letdecl(Let, {letfun, _, F, Args, T, [GuardedBody]}) ->
-    block_expr(0, hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T), text("=")]), E).
+    beside(hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T)]), guarded_body(GuardedBody, "="));
+letdecl(Let, {letfun, _, F, Args, T, GuardedBodies}) ->
+    block(hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T)]), above(lists:map(fun(GB) -> guarded_body(GB, "=") end, GuardedBodies))).
 
 -spec args([aeso_syntax:arg()]) -> doc().
 args(Args) ->
@@ -482,8 +484,18 @@ elim1(Proj={proj, _, _})      -> beside(text("."), elim(Proj));
 elim1(Get={map_get, _, _})    -> elim(Get);
 elim1(Get={map_get, _, _, _}) -> elim(Get).
 
-alt({'case', _, Pat, Body}) ->
+alt({'case', _, Pat, [GuardedBody]}) ->
-    block_expr(0, hsep(expr(Pat), text("=>")), Body).
+    beside(expr(Pat), guarded_body(GuardedBody, "=>"));
+alt({'case', _, Pat, GuardedBodies}) ->
+    block(expr(Pat), above(lists:map(fun(GB) -> guarded_body(GB, "=>") end, GuardedBodies))).
+
+guarded_body({guarded, _, Guards, Body}, Then) ->
+    block_expr(0, hsep(guards(Guards), text(Then)), Body).
+
+guards([]) ->
+    text("");
+guards(Guards) ->
+    hsep([text(" |"), par(punctuate(text(","), lists:map(fun expr/1, Guards)), 0)]).
 
 block_expr(_, Header, {block, _, Ss}) ->
     block(Header, statements(Ss));

src/aeso_syntax.erl

@@ -56,8 +56,11 @@
 
 -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}.
 
+-type guard() :: expr().
+-type guarded_expr() :: {guarded, ann(), [guard()], expr()}.
+
 -type letval()  :: {letval, ann(), pat(), expr()}.
--type letfun()  :: {letfun, ann(), id(), [pat()], type(), expr()}.
+-type letfun()  :: {letfun, ann(), id(), [pat()], type(), [guarded_expr(),...]}.
 -type letpat()  :: {letpat, ann(), id(), pat()}.
 -type fundecl() :: {fun_decl, ann(), id(), type()}.
 
@@ -145,7 +148,7 @@
 -type stmt() :: letbind()
               | expr().
 
--type alt() :: {'case', ann(), pat(), expr()}.
+-type alt() :: {'case', ann(), pat(), [guarded_expr(),...]}.
 
 -type lvalue() :: nonempty_list(elim()).
 

src/aeso_syntax_utils.erl

@@ -41,15 +41,15 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
     Top = Fun(K, X),
     Rec = case X of
             %% lists (bound things in head scope over tail)
-            [A | As]                 -> Scoped(Same(A), Same(As));
+            [A | As]                      -> Scoped(Same(A), Same(As));
             %% decl()
-            {contract, _, _, Ds}     -> Decl(Ds);
+            {contract, _, _, Ds}          -> Decl(Ds);
-            {namespace, _, _, Ds}    -> Decl(Ds);
+            {namespace, _, _, Ds}         -> Decl(Ds);
-            {type_def, _, I, _, D}   -> Plus(BindType(I), Decl(D));
+            {type_def, _, I, _, D}        -> Plus(BindType(I), Decl(D));
-            {fun_decl, _, _, T}      -> Type(T);
+            {fun_decl, _, _, T}           -> Type(T);
-            {letval, _, P, E}        -> Scoped(BindExpr(P), Expr(E));
+            {letval, _, P, E}             -> Scoped(BindExpr(P), Expr(E));
-            {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]);
+            {letfun, _, F, Xs, T, GEs} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ GEs)]);
-            {fun_clauses, _, _, T, Cs} -> Sum([Type(T) | [Decl(C) || C <- Cs]]);
+            {fun_clauses, _, _, T, Cs}    -> Sum([Type(T) | [Decl(C) || C <- Cs]]);
             %% typedef()
             {alias_t, T}    -> Type(T);
             {record_t, Fs}  -> Type(Fs);
@@ -89,13 +89,14 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
             {map_get, _, A, B, C}  -> Expr([A, B, C]);
             {block, _, Ss}         -> Expr(Ss);
             {letpat, _, X, P}      -> Plus(BindExpr(X), Expr(P));
+            {guarded, _, Gs, E}    -> Expr([E | Gs]);
             %% field()
             {field, _, LV, E}    -> Expr([LV, E]);
             {field, _, LV, _, E} -> Expr([LV, E]);
             %% arg()
             {arg, _, Y, T} -> Plus(BindExpr(Y), Type(T));
             %% alt()
-            {'case', _, P, E} -> Scoped(BindExpr(P), Expr(E));
+            {'case', _, P, GEs} -> Scoped(BindExpr(P), Expr(GEs));
             %% elim()
             {proj, _, _}    -> Zero;
             {map_get, _, E} -> Expr(E);

test/aeso_calldata_tests.erl

@@ -59,7 +59,7 @@ calldata_aci_test_() ->
         end} || {ContractName, Fun, Args} <- compilable_contracts()].
 
 parse_args(Fun, Args) ->
-    [{contract_main, _, _, [{letfun, _, _, _, _, {app, _, _, AST}}]}] =
+    [{contract_main, _, _, [{letfun, _, _, _, _, [{guarded, _, [], {app, _, _, AST}}]}]}] =
         aeso_parser:string("main contract Temp = function foo() = " ++ Fun ++ "(" ++ string:join(Args, ", ") ++ ")"),
     strip_ann(AST).
 

test/aeso_compiler_tests.erl

@@ -202,6 +202,7 @@ compilable_contracts() ->
      "child_contract_init_bug",
      "using_namespace",
      "assign_patterns",
+     "patterns_guards",
      "test" % Custom general-purpose test file. Keep it last on the list.
     ].
 
@@ -808,6 +809,14 @@ failing_contracts() ->
                   [<<?Pos(8,23)
                      "Unbound variable g at line 8, column 23">>
                   ])
+    , ?TYPE_ERROR(stateful_pattern_guard,
+                  [<<?Pos(8,12)
+                     "Cannot reference stateful function g (at line 8, column 12) in a pattern guard.">>
+                  ])
+    , ?TYPE_ERROR(non_boolean_pattern_guard,
+                  [<<?Pos(4,24)
+                     "Cannot unify string\n         and bool\nwhen checking the type of the expression at line 4, column 24\n  \"y\" : string\nagainst the expected type\n  bool">>
+                  ])
     ].
 
 -define(Path(File), "code_errors/" ??File).

test/aeso_parser_tests.erl

@@ -17,7 +17,7 @@ simple_contracts_test_() ->
             ?assertMatch(
                 [{contract_main, _, {con, _, "Identity"},
                     [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"},
-                        {id, _, "x"}}]}], parse_string(Text)),
+                        [{guarded, _, [], {id, _, "x"}}]}]}], parse_string(Text)),
             ok
        end},
       {"Operator precedence test.",

test/contracts/non_boolean_pattern_guard.aes

@@ -0,0 +1,4 @@
+contract C =
+  type state = int
+
+  entrypoint init(x) | "y" = 1

test/contracts/patterns_guards.aes

@@ -0,0 +1,19 @@
+include "List.aes"
+
+contract C =
+  type state = int
+
+  entrypoint init() = f([1, 2, 3, 4])
+
+  function
+    f(x::[])
+      | x > 1, x < 10 = 1
+      | x < 1 = 9
+    f(x::y::[]) = 2
+    f(x::y::z) = switch(z)
+      [] => 4
+      a::[]
+        | a > 10, a < 20 => 5
+        | a > 5 => 8
+      b | List.length(b) > 5 => 6
+      c => 7

test/contracts/stateful_pattern_guard.aes

@@ -0,0 +1,10 @@
+contract C =
+  type state = int
+
+  entrypoint init() = f(4)
+
+  function
+    f(x) | x > 0 = 1
+    f(x) | g(x) = 2
+
+  stateful function g(x) = x < 0