Add functions guards

src/aeso_ast_infer_types.erl

@@ -287,6 +287,13 @@ bind_contract({Contract, Ann, Id, Contents}, Env)
           || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, {typed, _, _, RetT}} <- Contents,
              Name =/= "init"
         ] ++
+        [ {field_t, AnnF, Entrypoint,
+           contract_call_type(
+             {fun_t, AnnF, [], [ArgT || {typed, _, _, ArgT} <- Args], RetT})
+          }
+          || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, _Guard, {typed, _, _, RetT}} <- Contents,
+             Name =/= "init"
+        ] ++
         %% Predefined fields
         [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ] ++
         [ {field_t, Sys, {id, Sys, ?CONSTRUCTOR_MOCK_NAME},
@@ -294,6 +301,9 @@ bind_contract({Contract, Ann, Id, Contents}, Env)
              case [ [ArgT || {typed, _, _, ArgT} <- Args]
                     || {letfun, AnnF, {id, _, "init"}, Args, _, _} <- Contents,
                        aeso_syntax:get_ann(entrypoint, AnnF, false)]
+                 ++ [ [ArgT || {typed, _, _, ArgT} <- Args]
+                      || {letfun, AnnF, {id, _, "init"}, Args, _, _, _} <- Contents,
+                         aeso_syntax:get_ann(entrypoint, AnnF, false)]
                  ++ [ Args
                       || {fun_decl, AnnF, {id, _, "init"}, {fun_t, _, _, Args, _}} <- Contents,
                          aeso_syntax:get_ann(entrypoint, AnnF, false)]
@@ -897,6 +907,7 @@ infer_contract(Env0, What, Defs0, Options) ->
     Env  = Env0#env{ what = What },
     Kind = fun({type_def, _, _, _, _})     -> type;
               ({letfun, _, _, _, _, _})    -> function;
+              ({letfun, _, _, _, _, _, _}) -> function;
               ({fun_clauses, _, _, _, _})  -> function;
               ({fun_decl, _, _, _})        -> prototype;
               ({using, _, _, _, _})        -> using;
@@ -919,6 +930,7 @@ infer_contract(Env0, What, Defs0, Options) ->
     Functions = Get(function, Defs),
     %% Check for duplicates in Functions (we turn it into a map below)
     FunBind   = fun({letfun, Ann, {id, _, Fun}, _, _, _})    -> {Fun, {tuple_t, Ann, []}};
+                   ({letfun, Ann, {id, _, Fun}, _, _, _, _}) -> {Fun, {tuple_t, Ann, []}};
                    ({fun_clauses, Ann, {id, _, Fun}, _, _})  -> {Fun, {tuple_t, Ann, []}} end,
     FunName   = fun(Def) -> {Name, _} = FunBind(Def), Name end,
     _         = bind_funs(lists:map(FunBind, Functions), #env{}),
@@ -947,6 +959,7 @@ process_block(_, []) -> [];
 process_block(_, [Decl]) -> [Decl];
 process_block(_Ann, [Decl | Decls]) ->
     IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _})    -> Name == Name1;
+                             ({letfun, _, {id, _, Name1}, _, _, _, _}) -> Name == Name1;
                              (_) -> false end end,
     case Decl of
         {fun_decl, Ann1, Id = {id, _, Name}, Type} ->
@@ -954,6 +967,10 @@ process_block(_Ann, [Decl | Decls]) ->
             [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest],
             [{fun_clauses, Ann1, Id, Type, Clauses}];
         {letfun, Ann1, Id = {id, _, Name}, _, _, _} ->
+            {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]),
+            [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest],
+            [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses}];
+        {letfun, Ann1, Id = {id, _, Name}, _, _, _, _} ->
             {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]),
             [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest],
             [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses}]
@@ -1086,7 +1103,11 @@ check_modifiers_(Env, [{Contract, _, Con, Decls} | Rest])
             [ D || D <- Decls, aeso_syntax:get_ann(entrypoint, D, false) ]} of
         {true, []} -> type_error({contract_has_no_entrypoints, Con});
         _ when IsInterface ->
-            case [ {AnnF, Id} || {letfun, AnnF, Id, _, _, _} <- Decls ] of
+            GetAnnId = fun({letfun, AnnF, Id, _, _, _})    -> {true, {AnnF, Id}};
+                          ({letfun, AnnF, Id, _, _, _, _}) -> {true, {AnnF, Id}};
+                          (_) -> false
+                       end,
+            case lists:filtermap(GetAnnId, Decls) of
                 [{AnnF, Id} | _] -> type_error({definition_in_contract_interface, AnnF, Id});
                 [] -> ok
             end;
@@ -1324,6 +1345,7 @@ typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) ->
 infer_letrec(Env, Defs) ->
     create_constraints(),
     Funs = lists:map(fun({letfun, _, {id, Ann, Name}, _, _, _})    -> {Name, fresh_uvar(Ann)};
+                        ({letfun, _, {id, Ann, Name}, _, _, _, _}) -> {Name, fresh_uvar(Ann)};
                         ({fun_clauses, _, {id, Ann, Name}, _, _})  -> {Name, fresh_uvar(Ann)}
                      end, Defs),
     ExtendEnv = bind_funs(Funs, Env),
@@ -1354,6 +1376,9 @@ infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) ->
           end || ClauseSig <- Sigs ],
     {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, Clauses1)};
 infer_letfun(Env, LetFun = {letfun, Ann, Fun, _, _, _}) ->
+    {{Name, Sig}, Clause} = infer_letfun1(Env, LetFun),
+    {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, [Clause])};
+infer_letfun(Env, LetFun = {letfun, Ann, Fun, _, _, _, _}) ->
     {{Name, Sig}, Clause} = infer_letfun1(Env, LetFun),
     {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, [Clause])}.
 
@@ -1366,12 +1391,24 @@ infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, B
     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, NewBody}};
+infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Guard, 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}),
+    NewGuard = check_expr(NewEnv, Guard, {id, Attrib, "bool"}),
+    ExpectedType = check_type(Env, arg_type(NameAttrib, What)),
+    NewBody={typed, _, _, ResultType} = check_expr(NewEnv, Body, ExpectedType),
+    NamedArgs = [],
+    TypeSig = {type_sig, Attrib, none, NamedArgs, ArgTypes, ResultType},
+    {{Name, TypeSig},
+     {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewGuard, NewBody}}.
 
 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, _, _, _}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As);
             _                             -> true
         end,
     case NeedDesugar of
@@ -1383,11 +1420,14 @@ desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) ->
             Tuple = fun([X]) -> X;
                        (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}}
                     end,
+            ToCase = fun({letfun, AnnC, _, ArgsC, _, Body})        -> {true, {'case', AnnC, Tuple(ArgsC), Body}};
+                        ({letfun, AnnC, _, ArgsC, _, Guard, Body}) -> {true, {'case', AnnC, Tuple(ArgsC), Guard, Body}};
+                        (_) -> false
+                     end,
             {letfun, Ann, Fun, Args, RetType,
              {typed, NoAnn,
-              {switch, NoAnn, Tuple(Args),
+              {switch, NoAnn, Tuple(Args), lists:filtermap(ToCase, Clauses)},
-                [ {'case', AnnC, Tuple(ArgsC), Body}
+              RetType}}
-                || {letfun, AnnC, _, ArgsC, _, Body} <- Clauses ]}, RetType}}
     end.
 
 print_typesig({Name, TypeSig}) ->
@@ -1449,7 +1489,11 @@ 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 ],
+    GetFun    = fun(F = {letfun, _, {id, _, Name}, _, _, _})    -> {true, {Top ++ [Name], F}};
+                   (F = {letfun, _, {id, _, Name}, _, _, _, _}) -> {true, {Top ++ [Name], F}};
+                   (_) -> false
+                end,
+    Funs      = lists:filtermap(GetFun, 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
@@ -1577,6 +1621,17 @@ infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _}|Rest]})
     , {list_comp, AsLC, TypedYield, [LetFun|TypedRest]}
     , ResType
     };
+infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _, _}|Rest]}) ->
+    {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def),
+    FunT = typesig_to_fun_t(TypeSig),
+    NewE = bind_var({id, AsLF, Name}, FunT, Env),
+    {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} =
+        infer_expr(NewE, {list_comp, AsLC, Yield, Rest}),
+    { typed
+    , AsLC
+    , {list_comp, AsLC, TypedYield, [LetFun|TypedRest]}
+    , ResType
+    };
 infer_expr(Env, {typed, As, Body, Type}) ->
     Type1 = check_type(Env, Type),
     {typed, _, NewBody, NewType} = check_expr(Env, Body, Type1),
@@ -1718,6 +1773,9 @@ infer_expr(Env, Let = {letval, Attrs, _, _}) ->
     type_error({missing_body_for_let, Attrs}),
     infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]});
 infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) ->
+    type_error({missing_body_for_let, Attrs}),
+    infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]});
+infer_expr(Env, Let = {letfun, Attrs, _, _, _, _, _}) ->
     type_error({missing_body_for_let, Attrs}),
     infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}).
 
@@ -1869,6 +1927,11 @@ infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) ->
     FunT = typesig_to_fun_t(TypeSig),
     NewE = bind_var({id, Ann, Name}, FunT, Env),
     [LetFun|infer_block(NewE, Attrs, Rest, BlockType)];
+infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _, _}|Rest], BlockType) ->
+    {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def),
+    FunT = typesig_to_fun_t(TypeSig),
+    NewE = bind_var({id, Ann, Name}, FunT, Env),
+    [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}, _}} =
@@ -2443,6 +2506,8 @@ 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) ->
     {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), unfold_types(Env, Body, Options)};
+unfold_types(Env, {letfun, Ann, Name, Args, Type, Guard, Body}, Options) ->
+    {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), unfold_types(Env, Guard, Options), 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) ->

src/aeso_ast_to_fcode.erl

@@ -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}.
@@ -885,10 +892,15 @@ remove_guards(Env, [Alt = {'case', _, _, _} | Rest], Switch) ->
     [alt_to_fcode(Env, Alt) | remove_guards(Env, Rest, Switch)];
 remove_guards(Env, [{'case', _, Pat, Guard, Body} | Rest], {switch, Ann, Expr, _}) ->
     FPat  = pat_to_fcode(Env, Pat),
-    FSwitch = expr_to_fcode(Env, {switch, Ann, Expr, Rest}),
     FGuard = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Guard),
     FBody = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Body),
-    [{'case', [FPat], make_if(FGuard, FBody, FSwitch)}].
+    case Rest of
+        [] ->
+            [{'case', [FPat], make_if_no_else(FGuard, FBody)}];
+        _ ->
+            FSwitch = expr_to_fcode(Env, {switch, Ann, Expr, Rest}),
+            [{'case', [FPat], make_if(FGuard, FBody, FSwitch)}]
+    end.
 
 %% %% Invariant: the number of variables matches the number of patterns in each falt.
 -spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fsplit().

src/aeso_parse_lib.hrl

@@ -14,7 +14,9 @@
 -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, 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,12 +211,20 @@ letdef() -> choice(valdef(), fundef()).
 valdef() ->
     ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}).
 
-fundef() ->
+fundef() -> choice(unguarded_fundef(), guarded_fundef()).
+
+unguarded_fundef() ->
     choice(
     [ ?RULE(id(), args(),                   tok('='), body(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _4})
     , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6})
     ]).
 
+guarded_fundef() ->
+    choice(
+    [ ?RULE(id(), args(),                   tok('|'), expr(), tok('='), body(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _4, _6})
+    , ?RULE(id(), args(), tok(':'), type(), tok('|'), expr(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6, _8})
+    ]).
+
 args() -> paren_list(pattern()).
 lam_args() -> paren_list(arg()).
 

src/aeso_syntax.erl

@@ -57,7 +57,8 @@
 -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}.
 
 -type letval()  :: {letval, ann(), pat(), expr()}.
--type letfun()  :: {letfun, ann(), id(), [pat()], type(), expr()}.
+-type letfun()  :: {letfun, ann(), id(), [pat()], type(), expr()}
+                 | {letfun, ann(), id(), [pat()], type(), expr(), expr()}.
 -type letpat()  :: {letpat, ann(), id(), pat()}.
 -type fundecl() :: {fun_decl, ann(), id(), type()}.