Merge pull request #212 from aeternity/GH-211-prepare_release_4_2_0

Prepare release 4.2.0

CHANGELOG.md

@@ -9,51 +9,52 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Changed
 ### Removed
 
+## [4.2.0] - 2020-01-15
+### Added
+- Allow separate entrypoint/function type signature and definition, and pattern
+  matching in left-hand sides:
+  ```
+    function
+      length : list('a) => int
+      length([])      = 0
+      length(x :: xs) = 1 + length(xs)
+  ```
+- Allow pattern matching in list comprehension generators (filtering out match
+  failures):
+  ```
+    function somes(xs : list(option('a))) : list('a) =
+      [ x | Some(x) <- xs ]
+  ```
+- Allow pattern matching in let-bindings (aborting on match failures):
+  ```
+    function test(m : map(int, int)) =
+        let Some(x) = Map.lookup(m, 0)
+        x
+  ```
+### Changed
+- FATE code generator improvements.
+- Bug fix: Handle qualified constructors in patterns.
+- Bug fix: Allow switching also on negative numbers.
+### Removed
+
+## [4.1.0] - 2019-11-26
+### Added
+- Support encoding and decoding bit fields in call arguments and results.
+### Changed
+- Various improvements to FATE code generator.
+### Removed
+
 ## [4.0.0] - 2019-10-11
 ### Added
 - `Address.to_contract` - casts an address to a (any) contract type.
 - Pragma to check compiler version, e.g. `@compiler >= 4.0`.
-### Changed
-- Nice type error if contract function is called as from a namespace.
-- Fail on function definitions in contracts other than the main contract.
-- Bug fix in variable optimization - don't discard writes to the store/state.
-### Removed
-
-## [4.0.0-rc5] - 2019-09-27
-### Added
-### Changed
-- Bug fixes in error reporting.
-- Bug fix in variable liveness analysis for FATE.
-### Removed
-
-## [4.0.0-rc4] - 2019-09-13
-### Added
 - Handle numeric escapes, i.e. `"\x19Ethereum Signed Message:\n"`, and similar strings.
-### Changed
-### Removed
-
-## [4.0.0-rc3] - 2019-09-12
-### Added
 - `Bytes.concat` and `Bytes.split` are added to be able to
   (de-)construct byte arrays.
 - `[a..b]` language construct, returning the list of numbers between
   `a` and `b` (inclusive). Returns the empty list if `a` > `b`.
 - [Standard libraries] (https://github.com/aeternity/protocol/blob/master/contracts/sophia_stdlib.md)
 - Checks that `init` is not called from other functions.
-### Changed
-- Error messages are changed into a uniform format, and more helpful
-  messages have been added.
-- `Crypto.<hash_fun>` and `String.<hash_fun>` for byte arrays now only
-  hash the actual byte array - not the internal ABI format.
-- More strict checks for polymorphic oracles and higher order oracles
-  and entrypoints.
-- `AENS.claim` is updated with a `NameFee` field - to be able to do
-  name auctions within contracts.
-- Fixed a bug in `Bytes.to_str` for AEVM.
-### Removed
-
-## [4.0.0-rc1] - 2019-08-22
-### Added
 - FATE backend - the compiler is able to produce VM code for both `AEVM` and `FATE`. Many
   of the APIs now take `{backend, aevm | fate}` to decide wich backend to produce artifacts
   for.
@@ -70,6 +71,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
   that shall be able to receive funds should be marked as payable. `Address.is_payable(a)`
   can be used to check if an (contract) address is payable or not.
 ### Changed
+- Nice type error if contract function is called as from a namespace.
+- Fail on function definitions in contracts other than the main contract.
+- Bug fix in variable optimization - don't discard writes to the store/state.
+- Bug fixes in error reporting.
+- Bug fix in variable liveness analysis for FATE.
+- Error messages are changed into a uniform format, and more helpful
+  messages have been added.
+- `Crypto.<hash_fun>` and `String.<hash_fun>` for byte arrays now only
+  hash the actual byte array - not the internal ABI format.
+- More strict checks for polymorphic oracles and higher order oracles
+  and entrypoints.
+- `AENS.claim` is updated with a `NameFee` field - to be able to do
+  name auctions within contracts.
+- Fixed a bug in `Bytes.to_str` for AEVM.
 - New syntax for tuple types. Now 0-tuple type is encoded as `unit` instead of `()` and
   regular tuples are encoded by interspersing inner types with `*`, for instance `int * string`.
   Parens are not necessary. Note it only affects the types, values remain as their were before,
@@ -177,12 +192,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Simplify calldata creation - instead of passing a compiled contract, simply
   pass a (stubbed) contract string.
 
-[Unreleased]: https://github.com/aeternity/aesophia/compare/v4.0.0...HEAD
+[Unreleased]: https://github.com/aeternity/aesophia/compare/v4.2.0...HEAD
+[4.2.0]: https://github.com/aeternity/aesophia/compare/v4.2.0...v4.1.0
+[4.1.0]: https://github.com/aeternity/aesophia/compare/v4.1.0...v4.0.0
 [4.0.0]: https://github.com/aeternity/aesophia/compare/v4.0.0...v3.2.0
-[4.0.0-rc5]: https://github.com/aeternity/aesophia/compare/v4.0.0-rc4...v4.0.0-rc5
-[4.0.0-rc4]: https://github.com/aeternity/aesophia/compare/v4.0.0-rc3...v4.0.0-rc4
-[4.0.0-rc3]: https://github.com/aeternity/aesophia/compare/v4.0.0-rc1...v4.0.0-rc3
-[4.0.0-rc1]: https://github.com/aeternity/aesophia/compare/v3.2.0...v4.0.0-rc1
 [3.2.0]: https://github.com/aeternity/aesophia/compare/v3.1.0...v3.2.0
 [3.1.0]: https://github.com/aeternity/aesophia/compare/v3.0.0...v3.1.0
 [3.0.0]: https://github.com/aeternity/aesophia/compare/v2.1.0...v3.0.0

rebar.config

@@ -15,7 +15,7 @@
             {base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
            ]}.
 
-{relx, [{release, {aesophia, "4.0.0"},
+{relx, [{release, {aesophia, "4.2.0"},
          [aesophia, aebytecode, getopt]},
 
         {dev_mode, true},

src/aeso_aci.erl

@@ -129,7 +129,7 @@ encode_anon_args(Types) ->
 
 encode_args(Args) -> [ encode_arg(A) || A <- Args ].
 
-encode_arg({arg, _, Id, T}) ->
+encode_arg({typed, _, Id, T}) ->
     #{name => encode_type(Id),
       type => encode_type(T)}.
 

src/aeso_ast_infer_types.erl

@@ -621,12 +621,14 @@ infer_contract_top(Env, Kind, Defs0, _Options) ->
 %% infer_contract takes a proplist mapping global names to types, and
 %% a list of definitions.
 -spec infer_contract(env(), main_contract | contract | namespace, [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}.
-infer_contract(Env0, What, Defs) ->
+infer_contract(Env0, What, Defs0) ->
+    Defs = process_blocks(Defs0),
     Env  = Env0#env{ what = What },
-    Kind = fun({type_def, _, _, _, _})  -> type;
+    Kind = fun({type_def, _, _, _, _})    -> type;
-              ({letfun, _, _, _, _, _}) -> function;
+              ({letfun, _, _, _, _, _})   -> function;
-              ({fun_decl, _, _, _})     -> prototype;
+              ({fun_clauses, _, _, _, _}) -> function;
-              (_)                       -> unexpected
+              ({fun_decl, _, _, _})       -> prototype;
+              (_)                         -> unexpected
            end,
     Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end,
     {Env1, TypeDefs} = check_typedefs(Env, Get(type)),
@@ -642,9 +644,11 @@ infer_contract(Env0, What, Defs) ->
     Env3      = bind_funs(ProtoSigs, Env2),
     Functions = Get(function),
     %% Check for duplicates in Functions (we turn it into a map below)
-    _         = bind_funs([{Fun, {tuple_t, Ann, []}} || {letfun, Ann, {id, _, Fun}, _, _, _} <- Functions],
+    FunBind   = fun({letfun, Ann, {id, _, Fun}, _, _, _})   -> {Fun, {tuple_t, Ann, []}};
-                          #env{}),
+                   ({fun_clauses, Ann, {id, _, Fun}, _, _}) -> {Fun, {tuple_t, Ann, []}} end,
-    FunMap    = maps:from_list([ {Fun, Def} || Def = {letfun, _, {id, _, Fun}, _, _, _} <- Functions ]),
+    FunName   = fun(Def) -> {Name, _} = FunBind(Def), Name end,
+    _         = bind_funs(lists:map(FunBind, Functions), #env{}),
+    FunMap    = maps:from_list([ {FunName(Def), Def} || Def <- Functions ]),
     check_reserved_entrypoints(FunMap),
     DepGraph  = maps:map(fun(_, Def) -> aeso_syntax_utils:used_ids(Def) end, FunMap),
     SCCs      = aeso_utils:scc(DepGraph),
@@ -655,6 +659,30 @@ infer_contract(Env0, What, Defs) ->
     destroy_and_report_type_errors(Env4),
     {Env4, TypeDefs ++ Decls ++ Defs1}.
 
+%% Restructure blocks into multi-clause fundefs (`fun_clauses`).
+-spec process_blocks([aeso_syntax:decl()]) -> [aeso_syntax:decl()].
+process_blocks(Decls) ->
+    lists:flatmap(
+      fun({block, Ann, Ds}) -> process_block(Ann, Ds);
+         (Decl)             -> [Decl] end, Decls).
+
+-spec process_block(aeso_syntax:ann(), [aeso_syntax:decl()]) -> [aeso_syntax:decl()].
+process_block(_, []) -> [];
+process_block(_, [Decl]) -> [Decl];
+process_block(Ann, [Decl | Decls]) ->
+    IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _}) -> Name == Name1;
+                             (_) -> false end end,
+    case Decl of
+        {fun_decl, Ann1, Id = {id, _, Name}, Type} ->
+            {Clauses, Rest} = lists:splitwith(IsThis(Name), Decls),
+            [{fun_clauses, Ann1, Id, Type, Clauses} |
+             process_block(Ann, Rest)];
+        {letfun, Ann1, Id = {id, _, Name}, _, _, _} ->
+            {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]),
+            [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses} |
+             process_block(Ann, Rest)]
+    end.
+
 -spec check_typedefs(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}.
 check_typedefs(Env = #env{ namespace = Ns }, Defs) ->
     create_type_errors(),
@@ -787,9 +815,9 @@ check_type(Env, T) ->
 check_type(Env, T = {tvar, _, _}, Arity) ->
     [ type_error({higher_kinded_typevar, T}) || Arity /= 0 ],
     check_tvar(Env, T);
-check_type(_Env, X = {id, _, "_"}, Arity) ->
+check_type(_Env, X = {id, Ann, "_"}, Arity) ->
     ensure_base_type(X, Arity),
-    X;
+    fresh_uvar(Ann);
 check_type(Env, X = {Tag, _, _}, Arity) when Tag == con; Tag == qcon; Tag == id; Tag == qid ->
     case lookup_type(Env, X) of
         {Q, {_, Def}} ->
@@ -960,8 +988,9 @@ typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) ->
 
 infer_letrec(Env, Defs) ->
     create_constraints(),
-    Funs = [{Name, fresh_uvar(A)}
+    Funs = lists:map(fun({letfun, _, {id, Ann, Name}, _, _, _})   -> {Name, fresh_uvar(Ann)};
-                 || {letfun, _, {id, A, Name}, _, _, _} <- Defs],
+                        ({fun_clauses, _, {id, Ann, Name}, _, _}) -> {Name, fresh_uvar(Ann)}
+                     end, Defs),
     ExtendEnv = bind_funs(Funs, Env),
     Inferred =
         [ begin
@@ -980,26 +1009,51 @@ infer_letrec(Env, Defs) ->
     [print_typesig(S) || S <- TypeSigs],
     {TypeSigs, NewDefs}.
 
-infer_letfun(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Body}) ->
+infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) ->
+    Type1 = check_type(Env, Type),
+    {NameSigs, Clauses1} = lists:unzip([ infer_letfun1(Env, Clause) || Clause <- Clauses ]),
+    {_, Sigs = [Sig | _]} = lists:unzip(NameSigs),
+    _ = [ begin
+            ClauseT = typesig_to_fun_t(ClauseSig),
+            unify(Env, ClauseT, Type1, {check_typesig, Name, ClauseT, Type1})
+          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_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 },
-    check_unique_arg_names(Fun, Args),
+    {NewEnv, {typed, _, {tuple, _, TypedArgs}, {tuple_t, _, ArgTypes}}} = infer_pattern(Env, {tuple, [{origin, system} | NameAttrib], Args}),
-    ArgTypes  = [{ArgName, check_type(Env, arg_type(ArgAnn, T))} || {arg, ArgAnn, ArgName, T} <- Args],
     ExpectedType = check_type(Env, arg_type(NameAttrib, What)),
-    NewBody={typed, _, _, ResultType} = check_expr(bind_vars(ArgTypes, Env), Body, ExpectedType),
+    NewBody={typed, _, _, ResultType} = check_expr(NewEnv, Body, ExpectedType),
-    NewArgs = [{arg, A1, {id, A2, ArgName}, T}
-               || {{_, T}, {arg, A1, {id, A2, ArgName}, _}} <- lists:zip(ArgTypes, Args)],
     NamedArgs = [],
-    TypeSig = {type_sig, Attrib, none, NamedArgs, [T || {arg, _, _, T} <- NewArgs], ResultType},
+    TypeSig = {type_sig, Attrib, none, NamedArgs, ArgTypes, ResultType},
     {{Name, TypeSig},
-     {letfun, Attrib, {id, NameAttrib, Name}, NewArgs, ResultType, NewBody}}.
+     {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewBody}}.
 
-check_unique_arg_names(Fun, Args) ->
+desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) ->
-    Name = fun({arg, _, {id, _, X}, _}) -> X end,
+    NeedDesugar =
-    Names = lists:map(Name, Args),
+        case Clauses of
-    Dups = lists:usort(Names -- lists:usort(Names)),
+            [{letfun, _, _, As, _, _}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As);
-    [ type_error({repeated_arg, Fun, Arg}) || Arg <- Dups ],
+            _                          -> true
-    ok.
+        end,
+    case NeedDesugar of
+        false -> [Clause] = Clauses, Clause;
+        true  ->
+            NoAnn = [{origin, system}],
+            Args = [ {typed, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type}
+                     || {I, Type} <- indexed(1, ArgTypes) ],
+            Tuple = fun([X]) -> X;
+                       (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}}
+                    end,
+            {letfun, Ann, Fun, Args, RetType,
+             {typed, NoAnn,
+              {switch, NoAnn, Tuple(Args),
+                [ {'case', AnnC, Tuple(ArgsC), Body}
+                || {letfun, AnnC, _, ArgsC, _, Body} <- Clauses ]}, RetType}}
+    end.
 
 print_typesig({Name, TypeSig}) ->
     ?PRINT_TYPES("Inferred ~s : ~s\n", [Name, pp(TypeSig)]).
@@ -1092,9 +1146,9 @@ get_call_chains(Graph, Visited, Queue, Stop, Acc) ->
     end.
 
 check_expr(Env, Expr, Type) ->
-    E = {typed, _, _, Type1} = infer_expr(Env, Expr),
+    {typed, Ann, Expr1, Type1} = infer_expr(Env, Expr),
     unify(Env, Type1, Type, {check_expr, Expr, Type1, Type}),
-    E.
+    {typed, Ann, Expr1, Type}.  %% Keep the user-given type
 
 infer_expr(_Env, Body={bool, As, _}) ->
     {typed, As, Body, {id, As, "bool"}};
@@ -1138,21 +1192,20 @@ infer_expr(Env, {list, As, Elems}) ->
     NewElems = [check_expr(Env, X, ElemType) || X <- Elems],
     {typed, As, {list, As, NewElems}, {app_t, As, {id, As, "list"}, [ElemType]}};
 infer_expr(Env, {list_comp, As, Yield, []}) ->
-    {typed, _, TypedYield, Type} = infer_expr(Env, Yield),
+    {typed, _, _, Type} = TypedYield = infer_expr(Env, Yield),
     {typed, As, {list_comp, As, TypedYield, []}, {app_t, As, {id, As, "list"}, [Type]}};
-infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Arg, BExpr}|Rest]}) ->
+infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Pat, BExpr}|Rest]}) ->
-    BindVarType = fresh_uvar(As),
     TypedBind = {typed, As2, _, TypeBExpr} = infer_expr(Env, BExpr),
+    {NewE, TypedPat = {typed, _, _, PatType}} = infer_pattern(Env, Pat),
     unify( Env
          , TypeBExpr
-         , {app_t, As, {id, As, "list"}, [BindVarType]}
+         , {app_t, As, {id, As, "list"}, [PatType]}
-         , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [BindVarType]}}),
+         , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [PatType]}}),
-    NewE = bind_var(Arg, BindVarType, Env),
     {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} =
         infer_expr(NewE, {list_comp, As, Yield, Rest}),
     { typed
     , As
-    , {list_comp, As, TypedYield, [{comprehension_bind, {typed, Arg, BindVarType}, TypedBind}|TypedRest]}
+    , {list_comp, As, TypedYield, [{comprehension_bind, TypedPat, TypedBind}|TypedRest]}
     , ResType};
 infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Rest]}) ->
     NewCond = check_expr(Env, Cond, {id, AttrsIF, "bool"}),
@@ -1162,8 +1215,8 @@ infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Re
     , AttrsL
     , {list_comp, AttrsL, TypedYield, [{comprehension_if, AttrsIF, NewCond}|TypedRest]}
     , ResType};
-infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest]}) ->
+infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, E}|Rest]}) ->
-    NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, AsLV, E, arg_type(AsLV, Type)}),
+    NewE = {typed, _, _, PatType} = infer_expr(Env, E),
     BlockType = fresh_uvar(AsLV),
     {'case', _, NewPattern, NewRest} =
         infer_case( Env
@@ -1175,7 +1228,7 @@ infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest]
     {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = NewRest,
     { typed
     , AsLC
-    , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, Type, NewE}|TypedRest]}
+    , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, NewE}|TypedRest]}
     , ResType
     };
 infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _}|Rest]}) ->
@@ -1290,6 +1343,16 @@ infer_expr(Env, {block, Attrs, Stmts}) ->
     BlockType = fresh_uvar(Attrs),
     NewStmts = infer_block(Env, Attrs, Stmts, BlockType),
     {typed, Attrs, {block, Attrs, NewStmts}, BlockType};
+infer_expr(_Env, {record_or_map_error, Attrs, Fields}) ->
+    type_error({mixed_record_and_map, {record, Attrs, Fields}}),
+    Type = fresh_uvar(Attrs),
+    {typed, Attrs, {record, Attrs, []}, Type};
+infer_expr(Env, {record_or_map_error, Attrs, Expr, []}) ->
+    type_error({empty_record_or_map_update, {record, Attrs, Expr, []}}),
+    infer_expr(Env, Expr);
+infer_expr(Env, {record_or_map_error, Attrs, Expr, Fields}) ->
+    type_error({mixed_record_and_map, {record, Attrs, Expr, Fields}}),
+    infer_expr(Env, Expr);
 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],
@@ -1298,7 +1361,7 @@ infer_expr(Env, {lam, Attrs, Args, Body}) ->
         infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, 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, Let = {letval, Attrs, _, _, _}) ->
+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, _, _, _, _}) ->
@@ -1361,15 +1424,19 @@ infer_op(Env, As, Op, Args, InferOp) ->
     unify(Env, ArgTypes, OperandTypes, {infer_app, Op, Args, Inferred, ArgTypes}),
     {typed, As, {app, As, Op, TypedArgs}, ResultType}.
 
-infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) ->
+infer_pattern(Env, Pattern) ->
     Vars = free_vars(Pattern),
     Names = [N || {id, _, N} <- Vars, N /= "_"],
     case Names -- lists:usort(Names) of
         [] -> ok;
         Nonlinear -> type_error({non_linear_pattern, Pattern, lists:usort(Nonlinear)})
     end,
-    NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env#env{ in_pattern = true }),
+    NewEnv = bind_vars([{Var, fresh_uvar(Ann1)} || Var = {id, Ann1, _} <- Vars], Env#env{ in_pattern = true }),
-    NewPattern = {typed, _, _, PatType} = infer_expr(NewEnv, Pattern),
+    NewPattern = infer_expr(NewEnv, Pattern),
+    {NewEnv#env{ in_pattern = Env#env.in_pattern }, NewPattern}.
+
+infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) ->
+    {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern),
     NewBranch  = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType),
     unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}),
     {'case', Attrs, NewPattern, NewBranch}.
@@ -1384,11 +1451,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, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) ->
+infer_block(Env, _, [{letval, Attrs, Pattern, E}|Rest], BlockType) ->
-    NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, Attrs, E, arg_type(aeso_syntax:get_ann(Pattern), Type)}),
+    NewE = {typed, _, _, PatType} = infer_expr(Env, E),
     {'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} =
         infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType),
-    [{letval, Attrs, NewPattern, Type, NewE}|NewRest];
+    [{letval, Attrs, NewPattern, NewE}|NewRest];
 infer_block(Env, Attrs, [E|Rest], BlockType) ->
     [infer_expr(Env, E)|infer_block(Env, Attrs, Rest, BlockType)].
 
@@ -1430,18 +1497,13 @@ infer_prefix({IntOp,As}) when IntOp =:= '-' ->
 abort_expr(Ann, Str) ->
     {app, Ann, {id, Ann, "abort"}, [{string, Ann, Str}]}.
 
-free_vars({int, _, _}) ->
+free_vars({int, _, _})    -> [];
-    [];
+free_vars({char, _, _})   -> [];
-free_vars({char, _, _}) ->
+free_vars({string, _, _}) -> [];
-    [];
+free_vars({bool, _, _})   -> [];
-free_vars({string, _, _}) ->
+free_vars(Id={id, _, _})  -> [Id];
-    [];
+free_vars({con, _, _})    -> [];
-free_vars({bool, _, _}) ->
+free_vars({qcon, _, _})   -> [];
-    [];
-free_vars(Id={id, _, _}) ->
-    [Id];
-free_vars({con, _, _}) ->
-    [];
 free_vars({tuple, _, Cpts}) ->
     free_vars(Cpts);
 free_vars({list, _, Elems}) ->
@@ -1450,6 +1512,8 @@ free_vars({app, _, {'::', _}, Args}) ->
     free_vars(Args);
 free_vars({app, _, {con, _, _}, Args}) ->
     free_vars(Args);
+free_vars({app, _, {qcon, _, _}, Args}) ->
+    free_vars(Args);
 free_vars({record, _, Fields}) ->
     free_vars([E || {field, _, _, E} <- Fields]);
 free_vars({typed, _, A, _}) ->
@@ -2456,6 +2520,14 @@ mk_error({compiler_version_mismatch, Ann, Version, Op, Bound}) ->
                         "because it does not satisfy the constraint"
                         " ~s ~s ~s\n", [PrintV(Version), Op, PrintV(Bound)]),
     mk_t_err(pos(Ann), Msg);
+mk_error({empty_record_or_map_update, Expr}) ->
+    Msg = io_lib:format("Empty record/map update\n~s",
+                        [pp_expr("  ", Expr)]),
+    mk_t_err(pos(Expr), Msg);
+mk_error({mixed_record_and_map, Expr}) ->
+    Msg = io_lib:format("Mixed record fields and map keys in\n~s",
+                        [pp_expr("  ", Expr)]),
+    mk_t_err(pos(Expr), Msg);
 mk_error(Err) ->
     Msg = io_lib:format("Unknown error: ~p\n", [Err]),
     mk_t_err(pos(0, 0), Msg).
@@ -2733,3 +2805,7 @@ updates_key(Name, Updates) ->
     Updates1 = [ Upd  || {Upd, false, _} <- Xs ],
     More     = [ Rest || {_, true, Rest} <- Xs ],
     {More, Updates1}.
+
+indexed(I, Xs) ->
+    lists:zip(lists:seq(I, I + length(Xs) - 1), Xs).
+

src/aeso_ast_to_fcode.erl

@@ -24,6 +24,8 @@
 -type var_name() :: string().
 -type sophia_name() :: [string()].
 
+-type state_reg() :: pos_integer().
+
 -type builtin() :: atom().
 
 -type op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' |
@@ -61,6 +63,8 @@
                | {funcall, fexpr(), [fexpr()]}  %% Call to unknown function
                | {closure, fun_name(), fexpr()}
                | {switch, fsplit()}
+               | {set_state, state_reg(), fexpr()}
+               | {get_state, state_reg()}
                %% The following (unapplied top-level functions/builtins and
                %% lambdas) are generated by the fcode compiler, but translated
                %% to closures by the lambda lifter.
@@ -109,6 +113,7 @@
 
 -type fcode() :: #{ contract_name := string(),
                     state_type    := ftype(),
+                    state_layout  := state_layout(),
                     event_type    := ftype() | none,
                     functions     := #{ fun_name() => fun_def() },
                     payable       := boolean() }.
@@ -130,15 +135,18 @@
                  | {namespace, string()}
                  | {abstract_contract, string()}.
 
--type env() :: #{ type_env   := type_env(),
+-type state_layout() :: {tuple, [state_layout()]} | {reg, state_reg()}.
-                  fun_env    := fun_env(),
+
-                  con_env    := con_env(),
+-type env() :: #{ type_env     := type_env(),
-                  event_type => aeso_syntax:typedef(),
+                  fun_env      := fun_env(),
-                  builtins   := builtins(),
+                  con_env      := con_env(),
-                  options    := [option()],
+                  event_type   => aeso_syntax:typedef(),
-                  context    => context(),
+                  builtins     := builtins(),
-                  vars       => [var_name()],
+                  options      := [option()],
-                  functions  := #{ fun_name() => fun_def() } }.
+                  state_layout => state_layout(),
+                  context      => context(),
+                  vars         => [var_name()],
+                  functions    := #{ fun_name() => fun_def() } }.
 
 -define(HASH_BYTES, 32).
 
@@ -149,12 +157,14 @@
 -spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> fcode().
 ast_to_fcode(Code, Options) ->
     Verbose = lists:member(pp_fcode, Options),
+    init_fresh_names(),
     FCode1 = to_fcode(init_env(Options), Code),
     [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose],
-    FCode2 = lambda_lift(FCode1),
+    FCode2 = optimize_fcode(FCode1),
-    [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ],
+    [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ],
-    FCode3 = optimize_fcode(FCode2),
+    FCode3 = lambda_lift(FCode2),
-    [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ],
+    [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ],
+    clear_fresh_names(),
     FCode3.
 
 %% -- Environment ------------------------------------------------------------
@@ -206,6 +216,8 @@ builtins() ->
                      || {NS, Funs} <- Scopes,
                         {Fun, Arity} <- Funs ]).
 
+state_layout(Env) -> maps:get(state_layout, Env, {reg, 1}).
+
 -define(type(T),       fun([])     -> T end).
 -define(type(X, T),    fun([X])    -> T end).
 -define(type(X, Y, T), fun([X, Y]) -> T end).
@@ -221,7 +233,7 @@ init_type_env() ->
        ["hash"]         => ?type(hash),
        ["signature"]    => ?type(signature),
        ["oracle"]       => ?type(Q, R, {oracle, Q, R}),
-       ["oracle_query"] => ?type(_, _, oracle_query),    %% TODO: not in Fate
+       ["oracle_query"] => ?type(_, _, oracle_query),
        ["list"]         => ?type(T, {list, T}),
        ["map"]          => ?type(K, V, {map, K, V}),
        ["option"]       => ?type(T, {variant, [[], [T]]}),
@@ -229,7 +241,13 @@ init_type_env() ->
      }.
 
 is_no_code(Env) ->
-    proplists:get_value(no_code, maps:get(options, Env, []), false).
+    get_option(no_code, Env).
+
+get_option(Opt, Env) ->
+    get_option(Opt, Env, false).
+
+get_option(Opt, Env, Default) ->
+    proplists:get_value(Opt, maps:get(options, Env, []), Default).
 
 %% -- Compilation ------------------------------------------------------------
 
@@ -242,11 +260,13 @@ to_fcode(Env, [{contract, Attrs, MainCon = {con, _, Main}, Decls}]) ->
                                           [Main, "Chain", "event"] => {chain_event, 1}} },
     #{ functions := Funs } = Env1 =
         decls_to_fcode(MainEnv, Decls),
-    StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}),
+    StateType   = lookup_type(Env1, [Main, "state"], [], {tuple, []}),
-    EventType = lookup_type(Env1, [Main, "event"], [], none),
+    EventType   = lookup_type(Env1, [Main, "event"], [], none),
-    Payable   = proplists:get_value(payable, Attrs, false),
+    StateLayout = state_layout(Env1),
+    Payable     = proplists:get_value(payable, Attrs, false),
     #{ contract_name => Main,
        state_type    => StateType,
+       state_layout  => StateLayout,
        event_type    => EventType,
        payable       => Payable,
        functions     => add_init_function(Env1, MainCon, StateType,
@@ -266,9 +286,7 @@ decls_to_fcode(Env, Decls) ->
     %% environment.
     Env1 = add_fun_env(Env, Decls),
     lists:foldl(fun(D, E) ->
-                    init_fresh_names(),
                     R = decl_to_fcode(E, D),
-                    clear_fresh_names(),
                     R
                 end, Env1, Decls).
 
@@ -304,14 +322,15 @@ typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) ->
     FDef = fun(Args) when length(Args) == length(Xs) ->
                 Sub = maps:from_list(lists:zip([X || {tvar, _, X} <- Xs], Args)),
                 case Def of
-                    {record_t, Fields} -> {todo, Xs, Args, record_t, Fields};
+                    {record_t, Fields} ->
+                        {tuple, [type_to_fcode(Env, Sub, T) || {field_t, _, _, T} <- Fields]};
                     {variant_t, Cons}  ->
                         FCons = [ begin
                                       {constr_t, _, _, Ts} = Con,
                                       [type_to_fcode(Env, Sub, T) || T <- Ts]
                                   end || Con <- Cons ],
                         {variant, FCons};
-                    {alias_t, Type}    -> {todo, Xs, Args, alias_t, Type}
+                    {alias_t, Type}    -> type_to_fcode(Env, Sub, Type)
                 end;
               (Args) -> internal_error({type_arity_mismatch, Name, length(Args), length(Xs)})
            end,
@@ -333,7 +352,34 @@ typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) ->
              "event" -> Env1#{ event_type => Def };
              _       -> Env1
            end,
-    bind_type(Env2, Q, FDef).
+    Env3 = compute_state_layout(Env2, Name, FDef),
+    bind_type(Env3, Q, FDef).
+
+compute_state_layout(Env = #{ context := {main_contract, _} }, "state", Type) ->
+    NoLayout = get_option(no_flatten_state, Env),
+    Layout =
+        case Type([]) of
+            _ when NoLayout -> {reg, 1};
+            T ->
+                {_, L} = compute_state_layout(1, T),
+                L
+        end,
+    Env#{ state_layout => Layout };
+compute_state_layout(Env, _, _) -> Env.
+
+compute_state_layout(R, {tuple, [T]}) ->
+    compute_state_layout(R, T);
+compute_state_layout(R, {tuple, Ts}) ->
+    {R1, Ls} = compute_state_layout(R, Ts),
+    {R1, {tuple, Ls}};
+compute_state_layout(R, []) ->
+    {R, []};
+compute_state_layout(R, [H | T]) ->
+    {R1, H1} = compute_state_layout(R, H),
+    {R2, T1} = compute_state_layout(R1, T),
+    {R2, [H1 | T1]};
+compute_state_layout(R, _) ->
+    {R + 1, {reg, R}}.
 
 check_state_and_event_types(#{ context := {main_contract, _} }, Id, [_ | _]) ->
     case Id of
@@ -369,9 +415,12 @@ type_to_fcode(Env, Sub, {fun_t, _, Named, Args, Res}) ->
 type_to_fcode(_Env, _Sub, Type) ->
     error({todo, Type}).
 
--spec args_to_fcode(env(), [aeso_syntax:arg()]) -> [{var_name(), ftype()}].
+-spec args_to_fcode(env(), [aeso_syntax:pat()]) -> [{var_name(), ftype()}].
 args_to_fcode(Env, Args) ->
-    [ {Name, type_to_fcode(Env, Type)} || {arg, _, {id, _, Name}, Type} <- Args ].
+    [ case Arg of
+          {id, _, Name} -> {Name, type_to_fcode(Env, Type)};
+          _ -> internal_error({bad_arg, Arg})   %% Pattern matching has been moved to the rhs at this point
+      end || {typed, _, Arg, Type} <- Args ].
 
 -define(make_let(X, Expr, Body),
         make_let(Expr, fun(X) -> Body end)).
@@ -386,6 +435,13 @@ make_let(Expr, Body) ->
             {'let', X, Expr, Body({var, X})}
     end.
 
+let_bind(X, {var, Y}, Body) -> rename([{X, Y}], Body);
+let_bind(X, Expr, Body)     -> {'let', X, Expr, Body}.
+
+let_bind(Binds, Body) ->
+    lists:foldr(fun({X, E}, Rest) -> let_bind(X, E, Rest) end,
+                Body, Binds).
+
 -spec expr_to_fcode(env(), aeso_syntax:expr()) -> fexpr().
 expr_to_fcode(Env, {typed, _, Expr, Type}) ->
     expr_to_fcode(Env, Type, Expr);
@@ -446,7 +502,7 @@ expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Args}) when C
 
 %% Tuples
 expr_to_fcode(Env, _Type, {tuple, _, Es}) ->
-    {tuple, [expr_to_fcode(Env, E) || E <- Es]};
+    make_tuple([expr_to_fcode(Env, E) || E <- Es]);
 
 %% Records
 expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) ->
@@ -458,18 +514,28 @@ expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}})
             FArgs = [type_to_fcode(Env, Arg) || Arg <- Args],
             {remote_u, FArgs, type_to_fcode(Env, Ret), expr_to_fcode(Env, Rec),
                        {entrypoint, list_to_binary(X)}};
+        {record_t, [_]} -> expr_to_fcode(Env, Rec); %% Singleton record
         {record_t, _} ->
             {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)}
     end;
 
+expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, [_] = Fields}) ->
+    {set, E} = field_value(FieldT, Fields),
+    expr_to_fcode(Env, E);
 expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) ->
     FVal = fun(F) ->
              %% All fields are present and no updates
              {set, E} = field_value(F, Fields),
              expr_to_fcode(Env, E)
            end,
-    {tuple, lists:map(FVal, FieldTypes)};
+    make_tuple(lists:map(FVal, FieldTypes));
 
+expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, Rec, Fields}) ->
+    case field_value(FieldT, Fields) of
+        false       -> expr_to_fcode(Env, Rec);
+        {set, E}    -> expr_to_fcode(Env, E);
+        {upd, Z, E} -> {'let', Z, expr_to_fcode(Env, Rec), expr_to_fcode(bind_var(Env, Z), E)}
+    end;
 expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) ->
     X    = fresh_name(),
     Proj = fun(I) -> {proj, {var, X}, I - 1} end,
@@ -501,9 +567,12 @@ expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) ->
 
 expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) ->
     {op, '::', [expr_to_fcode(Env, Yield), nil]};
-expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, {typed, {id, _, Arg}, _}, BindExpr}|Rest]}) ->
+expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) ->
+    Arg  = fresh_name(),
     Env1 = bind_var(Env, Arg),
-    Bind = {lam, [Arg], expr_to_fcode(Env1, {list_comp, As, Yield, Rest})},
+    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, {id, 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]}) ->
@@ -511,7 +580,7 @@ expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Res
             expr_to_fcode(Env, Type, {list_comp, As, Yield, Rest}),
             nil
            );
-expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}) ->
+expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}) ->
     expr_to_fcode(Env, Type, {block, As, [LV, {list_comp, As, Yield, Rest}]});
 expr_to_fcode(Env, Type, {list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}) ->
     expr_to_fcode(Env, Type, {block, As, [LF, {list_comp, As, Yield, Rest}]});
@@ -556,8 +625,8 @@ expr_to_fcode(Env, _Type, {app, _, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _,
     Args1 = get_named_args(NamedArgsT, Args),
     FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
     case expr_to_fcode(Env, Fun) of
-        {builtin_u, B, _Ar, TypeArgs}     -> builtin_to_fcode(B, FArgs ++ TypeArgs);
+        {builtin_u, B, _Ar, TypeArgs}     -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs);
-        {builtin_u, B, _Ar}               -> builtin_to_fcode(B, FArgs);
+        {builtin_u, B, _Ar}               -> builtin_to_fcode(state_layout(Env), B, FArgs);
         {def_u, F, _Ar}                   -> {def, F, FArgs};
         {remote_u, ArgsT, RetT, Ct, RFun} -> {remote, ArgsT, RetT, Ct, RFun, FArgs};
         FFun ->
@@ -621,6 +690,13 @@ make_if(Cond, Then, Else) ->
     X = fresh_name(),
     {'let', X, Cond, make_if({var, X}, Then, Else)}.
 
+-spec make_tuple([fexpr()]) -> fexpr().
+make_tuple([E]) -> E;
+make_tuple(Es) -> {tuple, Es}.
+
+-spec strip_singleton_tuples(ftype()) -> ftype().
+strip_singleton_tuples({tuple, [T]}) -> strip_singleton_tuples(T);
+strip_singleton_tuples(T) -> T.
 
 get_oracle_type(oracle_register,     {fun_t, _, _, _, OType})       -> OType;
 get_oracle_type(oracle_query,        {fun_t, _, _, [OType | _], _}) -> OType;
@@ -649,7 +725,7 @@ validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]})
 
 ensure_first_order_entrypoint(Ann, Id = {id, _, Name}, Args, Ret, FArgs, FRet) ->
     [ ensure_first_order(FT, {invalid_entrypoint, higher_order, Ann1, Id, {argument, X, T}})
-      || {{arg, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ],
+      || {{typed, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ],
     [ ensure_first_order(FRet, {invalid_entrypoint, higher_order, Ann, Id, {result, Ret}})
       || Name /= "init" ],  %% init can return higher-order values, since they're written to the store
                             %% rather than being returned.
@@ -708,10 +784,13 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) ->
             {nosplit, rename(Ren, Body)};
         I when is_integer(I) ->
             {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars),
+            Type1 = strip_singleton_tuples(Type),
             SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]),
-            Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)}
+            MakeCase = fun({var, Z}, Split) -> {'case', {var, "_"}, rename_split([{Z, X}], Split)};
+                          (SPat, Split)     -> {'case', SPat, Split} end,
+            Cases = [ MakeCase(SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type1) ++ Vars1, FAlts))
                       || {SPat, FAlts} <- SAlts ],
-            {split, Type, X, Cases}
+            {split, Type1, X, Cases}
     end.
 
 -spec merge_alts(integer(), var_name(), [{fsplit_pat(), falt()}]) -> [{fsplit_pat(), [falt()]}].
@@ -834,7 +913,7 @@ pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C
     #con_tag{tag = I, arities = As} = lookup_con(Env, Con),
     {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]};
 pat_to_fcode(Env, _Type, {tuple, _, Pats}) ->
-    {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]};
+    make_tuple([ pat_to_fcode(Env, Pat) || Pat <- Pats ]);
 pat_to_fcode(_Env, _Type, {bool, _, B})   -> {bool, B};
 pat_to_fcode(_Env, _Type, {int, _, N})    -> {int, N};
 pat_to_fcode(_Env, _Type, {char, _, N})   -> {int, N};
@@ -852,8 +931,8 @@ pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) ->
                         {set, Pat} -> Pat
                         %% {upd, _, _} is impossible in patterns
                     end end,
-    {tuple, [pat_to_fcode(Env, FieldPat(Field))
+    make_tuple([pat_to_fcode(Env, FieldPat(Field))
-             || Field <- Fields]};
+                || Field <- Fields]);
 
 pat_to_fcode(_Env, Type, Pat) ->
     error({todo, Pat, ':', Type}).
@@ -887,10 +966,16 @@ decision_tree_to_fcode({'if', A, Then, Else}) ->
 %% -- Statements --
 
 -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
-stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) ->
+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}}]});
 stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, Expr} | Stmts]) ->
-    {'let', X, expr_to_fcode(Env, {lam, Ann, Args, Expr}),
+    LamArgs = [ case Arg of
+                    {typed, Ann1, Id, T} -> {arg, Ann1, Id, T};
+                    _ -> internal_error({bad_arg, Arg})   %% pattern matching has been desugared
+                end || Arg <- Args ],
+    {'let', X, expr_to_fcode(Env, {lam, Ann, LamArgs, Expr}),
                stmts_to_fcode(bind_var(Env, X), Stmts)};
 stmts_to_fcode(Env, [Expr]) ->
     expr_to_fcode(Env, Expr);
@@ -909,23 +994,40 @@ op_builtins() ->
      crypto_ecverify_secp256k1, crypto_ecrecover_secp256k1
     ].
 
-builtin_to_fcode(require, [Cond, Msg]) ->
+set_state({reg, R}, Val) ->
+    {set_state, R, Val};
+set_state({tuple, Ls}, Val) ->
+    ?make_let(X, Val,
+    lists:foldr(fun({I, L}, Code) ->
+                    {'let', "_", set_state(L, {proj, X, I - 1}), Code}
+                end, {tuple, []}, indexed(Ls))).
+
+get_state({reg, R}) ->
+    {get_state, R};
+get_state({tuple, Ls}) ->
+    {tuple, [get_state(L) || L <- Ls]}.
+
+builtin_to_fcode(Layout, set_state, [Val]) ->
+    set_state(Layout, Val);
+builtin_to_fcode(Layout, get_state, []) ->
+    get_state(Layout);
+builtin_to_fcode(_Layout, require, [Cond, Msg]) ->
     make_if(Cond, {tuple, []}, {builtin, abort, [Msg]});
-builtin_to_fcode(chain_event, [Event]) ->
+builtin_to_fcode(_Layout, chain_event, [Event]) ->
     {def, event, [Event]};
-builtin_to_fcode(map_delete, [Key, Map]) ->
+builtin_to_fcode(_Layout, map_delete, [Key, Map]) ->
     {op, map_delete, [Map, Key]};
-builtin_to_fcode(map_member, [Key, Map]) ->
+builtin_to_fcode(_Layout, map_member, [Key, Map]) ->
     {op, map_member, [Map, Key]};
-builtin_to_fcode(map_lookup, [Key0, Map0]) ->
+builtin_to_fcode(_Layout, map_lookup, [Key0, Map0]) ->
     ?make_let(Key, Key0,
     ?make_let(Map, Map0,
      make_if({op, map_member, [Map, Key]},
              {con, [0, 1], 1, [{op, map_get, [Map, Key]}]},
              {con, [0, 1], 0, []})));
-builtin_to_fcode(map_lookup_default, [Key, Map, Def]) ->
+builtin_to_fcode(_Layout, map_lookup_default, [Key, Map, Def]) ->
     {op, map_get_d, [Map, Key, Def]};
-builtin_to_fcode(Builtin, Args) ->
+builtin_to_fcode(_Layout, Builtin, Args) ->
     case lists:member(Builtin, op_builtins()) of
         true  -> {op, Builtin, Args};
         false -> {builtin, Builtin, Args}
@@ -940,8 +1042,9 @@ add_init_function(Env, Main, StateType, Funs0) ->
             Funs     = add_default_init_function(Env, Main, StateType, Funs0),
             InitName = {entrypoint, <<"init">>},
             InitFun  = #{ body := InitBody} = maps:get(InitName, Funs),
-            Funs#{ InitName => InitFun#{ return => {tuple, []},
+            Funs1 = Funs#{ InitName => InitFun#{ return => {tuple, []},
-                                         body   => {builtin, set_state, [InitBody]} } }
+                                                 body   => builtin_to_fcode(state_layout(Env), set_state, [InitBody]) } },
+            Funs1
     end.
 
 add_default_init_function(_Env, Main, StateType, Funs) ->
@@ -992,12 +1095,10 @@ event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {vari
 %% the top-level and replace it with a closure.
 
 -spec lambda_lift(fcode()) -> fcode().
-lambda_lift(FCode = #{ functions := Funs }) ->
+lambda_lift(FCode = #{ functions := Funs, state_layout := StateLayout }) ->
-    init_fresh_names(),
     init_lambda_funs(),
-    Funs1   = maps:map(fun lambda_lift_fun/2, Funs),
+    Funs1   = maps:map(fun(_, Body) -> lambda_lift_fun(StateLayout, Body) end, Funs),
     NewFuns = get_lambda_funs(),
-    clear_fresh_names(),
     FCode#{ functions := maps:merge(Funs1, NewFuns) }.
 
 -define(lambda_key, '%lambdalifted').
@@ -1010,8 +1111,8 @@ add_lambda_fun(Def) ->
     put(?lambda_key, Funs#{ Name => Def }),
     Name.
 
-lambda_lift_fun(_, Def = #{ body := Body }) ->
+lambda_lift_fun(Layout, Def = #{ body := Body }) ->
-    Def#{ body := lambda_lift_expr(Body) }.
+    Def#{ body := lambda_lift_expr(Layout, Body) }.
 
 lifted_fun([Z], Xs, Body) ->
     #{ attrs  => [private],
@@ -1032,10 +1133,10 @@ make_closure(FVs, Xs, Body) ->
     Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end,
     {closure, Fun, Tup([{var, Y} || Y <- FVs])}.
 
-lambda_lift_expr({lam, Xs, Body}) ->
+lambda_lift_expr(Layout, {lam, Xs, Body}) ->
     FVs   = free_vars({lam, Xs, Body}),
-    make_closure(FVs, Xs, lambda_lift_expr(Body));
+    make_closure(FVs, Xs, lambda_lift_expr(Layout, Body));
-lambda_lift_expr(UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u ->
+lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u ->
     [Tag, F, Ar | _] = tuple_to_list(UExpr),
     ExtraArgs = case UExpr of
                     {builtin_u, _, _, TypeArgs} -> TypeArgs;
@@ -1044,40 +1145,42 @@ lambda_lift_expr(UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == bu
     Xs   = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ],
     Args = [{var, X} || X <- Xs] ++ ExtraArgs,
     Body = case Tag of
-               builtin_u -> builtin_to_fcode(F, Args);
+               builtin_u -> builtin_to_fcode(Layout, F, Args);
                def_u     -> {def, F, Args}
            end,
     make_closure([], Xs, Body);
-lambda_lift_expr({remote_u, ArgsT, RetT, Ct, F}) ->
+lambda_lift_expr(Layout, {remote_u, ArgsT, RetT, Ct, F}) ->
     FVs  = free_vars(Ct),
-    Ct1  = lambda_lift_expr(Ct),
+    Ct1  = lambda_lift_expr(Layout, Ct),
     GasAndValueArgs = 2,
     Xs   = [ lists:concat(["arg", I]) || I <- lists:seq(1, length(ArgsT) + GasAndValueArgs) ],
     Args = [{var, X} || X <- Xs],
     make_closure(FVs, Xs, {remote, ArgsT, RetT, Ct1, F, Args});
-lambda_lift_expr(Expr) ->
+lambda_lift_expr(Layout, Expr) ->
     case Expr of
         {lit, _}               -> Expr;
         nil                    -> Expr;
         {var, _}               -> Expr;
         {closure, _, _}        -> Expr;
-        {def, D, As}           -> {def, D, lambda_lift_exprs(As)};
+        {def, D, As}           -> {def, D, lambda_lift_exprs(Layout, As)};
-        {builtin, B, As}       -> {builtin, B, lambda_lift_exprs(As)};
+        {builtin, B, As}       -> {builtin, B, lambda_lift_exprs(Layout, As)};
-        {remote, ArgsT, RetT, Ct, F, As} -> {remote, ArgsT, RetT, lambda_lift_expr(Ct), F, lambda_lift_exprs(As)};
+        {remote, ArgsT, RetT, Ct, F, As} -> {remote, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)};
-        {con, Ar, C, As}       -> {con, Ar, C, lambda_lift_exprs(As)};
+        {con, Ar, C, As}       -> {con, Ar, C, lambda_lift_exprs(Layout, As)};
-        {tuple, As}            -> {tuple, lambda_lift_exprs(As)};
+        {tuple, As}            -> {tuple, lambda_lift_exprs(Layout, As)};
-        {proj, A, I}           -> {proj, lambda_lift_expr(A), I};
+        {proj, A, I}           -> {proj, lambda_lift_expr(Layout, A), I};
-        {set_proj, A, I, B}    -> {set_proj, lambda_lift_expr(A), I, lambda_lift_expr(B)};
+        {set_proj, A, I, B}    -> {set_proj, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)};
-        {op, Op, As}           -> {op, Op, lambda_lift_exprs(As)};
+        {op, Op, As}           -> {op, Op, lambda_lift_exprs(Layout, As)};
-        {'let', X, A, B}       -> {'let', X, lambda_lift_expr(A), lambda_lift_expr(B)};
+        {'let', X, A, B}       -> {'let', X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)};
-        {funcall, A, Bs}       -> {funcall, lambda_lift_expr(A), lambda_lift_exprs(Bs)};
+        {funcall, A, Bs}       -> {funcall, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)};
-        {switch, S}            -> {switch, lambda_lift_expr(S)};
+        {set_state, R, A}      -> {set_state, R, lambda_lift_expr(Layout, A)};
-        {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Alts)};
+        {get_state, _}         -> Expr;
-        {nosplit, A}           -> {nosplit, lambda_lift_expr(A)};
+        {switch, S}            -> {switch, lambda_lift_expr(Layout, S)};
-        {'case', P, S}         -> {'case', P, lambda_lift_expr(S)}
+        {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)};
+        {nosplit, A}           -> {nosplit, lambda_lift_expr(Layout, A)};
+        {'case', P, S}         -> {'case', P, lambda_lift_expr(Layout, S)}
     end.
 
-lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As].
+lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As].
 
 %% -- Optimisations ----------------------------------------------------------
 
@@ -1095,7 +1198,12 @@ optimize_fcode(Code = #{ functions := Funs }) ->
 -spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def().
 optimize_fun(Fcode, Fun, Def = #{ body := Body }) ->
     %% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]),
-    Def#{ body := inliner(Fcode, Fun, Body) }.
+    Def#{ body := drop_unused_lets(
+                  simplifier(
+                  let_floating(
+                  bind_subexpressions(
+                  inline_local_functions(
+                  inliner(Fcode, Fun, Body)))))) }.
 
 %% --- Inlining ---
 
@@ -1111,6 +1219,276 @@ should_inline(_Fcode, _Fun1) -> false == list_to_atom("true").  %% Dialyzer
 
 inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO
 
+%% --- Bind subexpressions ---
+
+-define(make_lets(Xs, Es, Body), make_lets(Es, fun(Xs) -> Body end)).
+
+bind_subexpressions(Expr) ->
+    bottom_up(fun bind_subexpressions/2, Expr).
+
+bind_subexpressions(_, {tuple, Es}) ->
+    ?make_lets(Xs, Es, {tuple, Xs});
+bind_subexpressions(_, {set_proj, A, I, B}) ->
+    ?make_lets([X, Y], [A, B], {set_proj, X, I, Y});
+bind_subexpressions(_, E) -> E.
+
+make_lets(Es, Body) -> make_lets(Es, [], Body).
+
+make_lets([], Xs, Body)       -> Body(lists:reverse(Xs));
+make_lets([{var, _} = E | Es], Xs, Body) ->
+    make_lets(Es, [E | Xs], Body);
+make_lets([{lit, _} = E | Es], Xs, Body) ->
+    make_lets(Es, [E | Xs], Body);
+make_lets([E | Es], Xs, Body) ->
+    ?make_let(X, E, make_lets(Es, [X | Xs], Body)).
+
+%% --- Inline local functions ---
+
+inline_local_functions(Expr) ->
+    bottom_up(fun inline_local_functions/2, Expr).
+
+inline_local_functions(Env, {funcall, {proj, {var, Y}, 0}, [{proj, {var, Y}, 1} | Args]} = Expr) ->
+    %% TODO: Don't always inline local funs?
+    case maps:get(Y, Env, free) of
+        {lam, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body);
+        _               -> Expr
+    end;
+inline_local_functions(_, Expr) -> Expr.
+
+%% --- Let-floating ---
+
+let_floating(Expr) -> bottom_up(fun let_float/2, Expr).
+
+let_float(_, {'let', X, E, Body}) ->
+    pull_out_let({'let', X, {here, E}, Body});
+let_float(_, {proj, E, I}) ->
+    pull_out_let({proj, {here, E}, I});
+let_float(_, {set_proj, E, I, V}) ->
+    pull_out_let({set_proj, {here, E}, I, {here, V}});
+let_float(_, {op, Op, Es}) ->
+    {Lets, Es1} = pull_out_let([{here, E} || E <- Es]),
+    let_bind(Lets, {op, Op, Es1});
+let_float(_, E) -> E.
+
+pull_out_let(Expr) when is_tuple(Expr) ->
+    {Lets, Es} = pull_out_let(tuple_to_list(Expr)),
+    Inner = list_to_tuple(Es),
+    let_bind(Lets, Inner);
+pull_out_let(Es) when is_list(Es) ->
+    case lists:splitwith(fun({here, _}) -> false; (_) -> true end, Es) of
+        {Es0, [{here, E} | Es1]} ->
+            case let_view(E) of
+                {[], _}    ->
+                    {Lets, Es2} = pull_out_let(Es1),
+                    {Lets, Es0 ++ [E] ++ Es2};
+                {Lets, E1} ->
+                    {Lets1, Es2} = pull_out_let(Es1),
+                    {Lets ++ Lets1, Es0 ++ [E1] ++ Es2}
+            end;
+        {_, []} -> {[], Es}
+    end.
+
+%% Also renames the variables to fresh names
+let_view(E) -> let_view(E, [], []).
+
+let_view({'let', X, E, Rest}, Ren, Lets) ->
+    Z = fresh_name(),
+    let_view(Rest, [{X, Z} | Ren], [{Z, rename(Ren, E)} | Lets]);
+let_view(E, Ren, Lets) ->
+    {lists:reverse(Lets), rename(Ren, E)}.
+
+%% --- Simplification ---
+
+-spec simplifier(fexpr()) -> fexpr().
+simplifier(Expr) ->
+    bottom_up(fun simplify/2, Expr).
+
+-spec simplify(#{var_name() => fexpr()}, fexpr()) -> fexpr().
+
+%% (e₀, .., en).i ->
+%% let _ = e₀ in .. let x = ei in .. let _ = en in x
+simplify(_Env, {proj, {tuple, Es}, I}) ->
+    It  = lists:nth(I + 1, Es),
+    X   = fresh_name(),
+    Dup = safe_to_duplicate(It),
+    Val = if Dup -> It; true -> {var, X} end,
+    lists:foldr(
+      fun({J, E}, Rest) when I == J ->
+            case Dup of
+                true  -> Rest;
+                false -> {'let', X, E, Rest}
+            end;
+         ({_, E}, Rest) ->
+            case read_only(E) of
+                true  -> Rest;
+                false -> {'let', "_", E, Rest}
+            end
+        end, Val, indexed(Es));
+
+%% let x = e in .. x.i ..
+simplify(Env, {proj, {var, X}, I} = Expr) ->
+    case simpl_proj(Env, I, {var, X}) of
+        false -> Expr;
+        E     -> E
+    end;
+
+simplify(Env, {switch, Split}) ->
+    case simpl_switch(Env, [], Split) of
+        nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]};
+        stuck   -> {switch, Split};
+        Expr    -> Expr
+    end;
+
+simplify(_, E) ->
+    E.
+
+simpl_proj(Env, I, Expr) ->
+    IfSafe = fun(E) -> case safe_to_duplicate(E) of
+                         true -> E;
+                         false -> false
+                       end end,
+    case Expr of
+        false                 -> false;
+        {var, X}              -> simpl_proj(Env, I, maps:get(X, Env, false));
+        {tuple, Es}           -> IfSafe(lists:nth(I + 1, Es));
+        {set_proj, _, I, Val} -> IfSafe(Val);
+        {set_proj, E, _, _}   -> simpl_proj(Env, I, E);
+        {proj, E, J}          -> simpl_proj(Env, I, simpl_proj(Env, J, E));
+        _                     -> false
+    end.
+
+get_catchalls(Alts) ->
+    [ C || C = {'case', {var, _}, _} <- Alts ].
+
+%% The scode compiler can't handle multiple catch-alls, so we need to nest them
+%% inside each other. Instead of
+%%    _ => switch(x) ..
+%%    _ => e
+%% we do
+%%    _ => switch(x)
+%%           ..
+%%           _ => e
+add_catchalls(Alts, []) -> Alts;
+add_catchalls(Alts, Catchalls) ->
+    case lists:splitwith(fun({'case', {var, _}, _}) -> false; (_) -> true end,
+                         Alts) of
+        {Alts1, [C]} -> Alts1 ++ [nest_catchalls([C | Catchalls])];
+        {_, []}      -> Alts  ++ [nest_catchalls(Catchalls)]
+        %% NOTE: relies on catchalls always being at the end
+    end.
+
+nest_catchalls([C = {'case', {var, _}, {nosplit, _}} | _]) -> C;
+nest_catchalls([{'case', P = {var, _}, {split, Type, X, Alts}} | Catchalls]) ->
+    {'case', P, {split, Type, X, add_catchalls(Alts, Catchalls)}}.
+
+simpl_switch(_Env, _, {nosplit, E}) -> E;
+simpl_switch(Env, Catchalls, {split, Type, X, Alts}) ->
+    Alts1 = add_catchalls(Alts, Catchalls),
+    Stuck = {switch, {split, Type, X, Alts1}},
+    case constructor_form(Env, {var, X}) of
+        false -> Stuck;
+        E     ->
+            case simpl_case(Env, E, Alts1) of
+                stuck -> Stuck;
+                Res   -> Res
+            end
+    end.
+
+simpl_case(_, _, []) -> nomatch;
+simpl_case(Env, E, [{'case', Pat, Body} | Alts]) ->
+    case match_pat(Pat, E) of
+        false -> simpl_case(Env, E, Alts);
+        Binds ->
+            Env1 = maps:merge(Env, maps:from_list(Binds)),
+            case simpl_switch(Env1, get_catchalls(Alts), Body) of
+                nomatch -> simpl_case(Env, E, Alts);
+                stuck   -> stuck;
+                Body1   -> let_bind(Binds, Body1)
+            end
+    end.
+
+-spec match_pat(fsplit_pat(), fexpr()) -> false | [{var_name(), fexpr()}].
+match_pat({tuple, Xs}, {tuple, Es})         -> lists:zip(Xs, Es);
+match_pat({con, _, C, Xs}, {con, _, C, Es}) -> lists:zip(Xs, Es);
+match_pat(L, {lit, L})                      -> [];
+match_pat(nil, nil)                         -> [];
+match_pat({'::', X, Y}, {op, '::', [A, B]}) -> [{X, A}, {Y, B}];
+match_pat({var, X}, E)                      -> [{X, E}];
+match_pat(_, _)                             -> false.
+
+constructor_form(Env, Expr) ->
+    case Expr of
+        {var, X} ->
+            case maps:get(X, Env, free) of
+                free -> false;
+                E    -> constructor_form(Env, E)    %% TODO: shadowing?
+            end;
+        {set_proj, E, I, V} ->
+            case constructor_form(Env, E) of
+                {tuple, Es} -> {tuple, setnth(I + 1, V, Es)};
+                _           -> false
+            end;
+        {proj, E, I} ->
+            case constructor_form(Env, E) of
+                {tuple, Es} -> constructor_form(Env, lists:nth(I + 1, Es));
+                _           -> false
+            end;
+        {con, _, _, _} -> Expr;
+        {tuple, _}     -> Expr;
+        {lit, _}       -> Expr;
+        nil            -> Expr;
+        {op, '::', _}  -> Expr;
+        _              -> false
+    end.
+
+%% --- Drop unused lets ---
+
+drop_unused_lets(Expr) -> bottom_up(fun drop_unused_lets/2, Expr).
+
+drop_unused_lets(_, {'let', X, E, Body} = Expr) ->
+    case {read_only(E), not lists:member(X, free_vars(Body))} of
+        {true, true}  -> Body;
+        {false, true} -> {'let', "_", E, Body};
+        _             -> Expr
+    end;
+drop_unused_lets(_, Expr) -> Expr.
+
+%% -- Static analysis --------------------------------------------------------
+
+safe_to_duplicate({lit, _})    -> true;
+safe_to_duplicate({var, _})    -> true;
+safe_to_duplicate(nil)         -> true;
+safe_to_duplicate({tuple, []}) -> true;
+safe_to_duplicate(_)           -> false.
+
+-spec read_only(fexpr() | fsplit() | fcase() | [fexpr()] | [fcase()]) -> boolean().
+read_only({lit, _})                -> true;
+read_only({var, _})                -> true;
+read_only(nil)                     -> true;
+read_only({con, _, _, Es})         -> read_only(Es);
+read_only({tuple, Es})             -> read_only(Es);
+read_only({proj, E, _})            -> read_only(E);
+read_only({set_proj, A, _, B})     -> read_only([A, B]);
+read_only({op, _, Es})             -> read_only(Es);
+read_only({get_state, _})          -> true;
+read_only({set_state, _, _})       -> false;
+read_only({def_u, _, _})           -> true;
+read_only({remote_u, _, _, _, _})  -> true;
+read_only({builtin_u, _, _})       -> true;
+read_only({builtin_u, _, _, _})    -> true;
+read_only({lam, _, _})             -> true;
+read_only({def, _, _})             -> false; %% TODO: purity analysis
+read_only({remote, _, _, _, _, _}) -> false;
+read_only({builtin, _, _})         -> false; %% TODO: some builtins are
+read_only({switch, Split})         -> read_only(Split);
+read_only({split, _, _, Cases})    -> read_only(Cases);
+read_only({nosplit, E})            -> read_only(E);
+read_only({'case', _, Split})      -> read_only(Split);
+read_only({'let', _, A, B})        -> read_only([A, B]);
+read_only({funcall, _, _})         -> false;
+read_only({closure, _, _})         -> internal_error(no_closures_here);
+read_only(Es) when is_list(Es)     -> lists:all(fun read_only/1, Es).
+
 %% --- Deadcode elimination ---
 
 -spec eliminate_dead_code(fcode()) -> fcode().
@@ -1232,10 +1610,10 @@ resolve_var(#{ vars := Vars } = Env, [X]) ->
     end;
 resolve_var(Env, Q) -> resolve_fun(Env, Q).
 
-resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) ->
+resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Q) ->
     case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of
         {not_found, not_found} -> internal_error({unbound_variable, Q});
-        {_, {B, none}}         -> {builtin, B, []};
+        {_, {B, none}}         -> builtin_to_fcode(state_layout(Env), B, []);
         {_, {B, Ar}}           -> {builtin_u, B, Ar};
         {{Fun, Ar}, _}         -> {def_u, Fun, Ar}
     end.
@@ -1270,14 +1648,14 @@ pat_vars({con, _, _, Ps})     -> pat_vars(Ps);
 pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)].
 
 -spec fsplit_pat_vars(fsplit_pat()) -> [var_name()].
-fsplit_pat_vars({var, X})            -> [X || X /= "_"];
+fsplit_pat_vars({var, X})        -> [X || X /= "_"];
-fsplit_pat_vars({bool, _})           -> [];
+fsplit_pat_vars({bool, _})       -> [];
-fsplit_pat_vars({int, _})            -> [];
+fsplit_pat_vars({int, _})        -> [];
-fsplit_pat_vars({string, _})         -> [];
+fsplit_pat_vars({string, _})     -> [];
-fsplit_pat_vars(nil)                 -> [];
+fsplit_pat_vars(nil)             -> [];
-fsplit_pat_vars({'::', P, Q})        -> [P, Q];
+fsplit_pat_vars({'::', P, Q})    -> [P, Q];
-fsplit_pat_vars({tuple, Ps})         -> Ps;
+fsplit_pat_vars({tuple, Ps})     -> Ps;
-fsplit_pat_vars({con, _, _, Ps})     -> Ps.
+fsplit_pat_vars({con, _, _, Ps}) -> Ps.
 
 free_vars(Xs) when is_list(Xs) ->
     lists:umerge([ free_vars(X) || X <- Xs ]);
@@ -1300,6 +1678,8 @@ free_vars(Expr) ->
         {op, _, As}          -> free_vars(As);
         {'let', X, A, B}     -> free_vars([A, {lam, [X], B}]);
         {funcall, A, Bs}     -> free_vars([A | Bs]);
+        {set_state, _, A}    -> free_vars(A);
+        {get_state, _}       -> [];
         {lam, Xs, B}         -> free_vars(B) -- lists:sort(Xs);
         {closure, _, A}      -> free_vars(A);
         {switch, A}          -> free_vars(A);
@@ -1329,6 +1709,8 @@ used_defs(Expr) ->
         {op, _, As}          -> used_defs(As);
         {'let', _, A, B}     -> used_defs([A, B]);
         {funcall, A, Bs}     -> used_defs([A | Bs]);
+        {set_state, _, A}    -> used_defs(A);
+        {get_state, _}       -> [];
         {lam, _, B}          -> used_defs(B);
         {closure, F, A}      -> lists:umerge([F], used_defs(A));
         {switch, A}          -> used_defs(A);
@@ -1337,6 +1719,50 @@ used_defs(Expr) ->
         {'case', _, A}       -> used_defs(A)
     end.
 
+bottom_up(F, Expr) -> bottom_up(F, #{}, Expr).
+
+bottom_up(F, Env, Expr) ->
+    F(Env, case Expr of
+        {lit, _}                         -> Expr;
+        nil                              -> Expr;
+        {var, _}                         -> Expr;
+        {def, D, Es}                     -> {def, D, [bottom_up(F, Env, E) || E <- Es]};
+        {def_u, _, _}                    -> Expr;
+        {builtin, B, Es}                 -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]};
+        {builtin_u, _, _}                -> Expr;
+        {builtin_u, _, _, _}             -> Expr;
+        {remote, ArgsT, RetT, Ct, Fun, Es} -> {remote,   ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]};
+        {remote_u, ArgsT, RetT, Ct, Fun}   -> {remote_u, ArgsT, RetT, bottom_up(F, Env, Ct), Fun};
+        {con, Ar, I, Es}                 -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]};
+        {tuple, Es}                      -> {tuple, [bottom_up(F, Env, E) || E <- Es]};
+        {proj, E, I}                     -> {proj, bottom_up(F, Env, E), I};
+        {set_proj, R, I, E}              -> {set_proj, bottom_up(F, Env, R), I, bottom_up(F, Env, E)};
+        {op, Op, Es}                     -> {op, Op, [bottom_up(F, Env, E) || E <- Es]};
+        {funcall, Fun, Es}               -> {funcall, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]};
+        {set_state, R, E}                -> {set_state, R, bottom_up(F, Env, E)};
+        {get_state, _}                   -> Expr;
+        {closure, F, CEnv}               -> {closure, F, bottom_up(F, Env, CEnv)};
+        {switch, Split}                  -> {switch, bottom_up(F, Env, Split)};
+        {lam, Xs, B}                     -> {lam, Xs, bottom_up(F, Env, B)};
+        {'let', X, E, Body}              ->
+            E1 = bottom_up(F, Env, E),
+            %% Always freshen user variables to avoid shadowing issues.
+            ShouldFreshen = fun(Y = "%" ++ _) -> maps:is_key(Y, Env);
+                               (_)            -> true end,
+            case ShouldFreshen(X) of
+                true ->
+                    Z = fresh_name(),
+                    Env1 = Env#{ Z => E1 },
+                    {'let', Z, E1, bottom_up(F, Env1, rename([{X, Z}], Body))};
+                false ->
+                    Env1 = Env#{ X => E1 },
+                    {'let', X, E1, bottom_up(F, Env1, Body)}
+            end;
+        {split, Type, X, Cases}          -> {split, Type, X, [bottom_up(F, Env, Case) || Case <- Cases]};
+        {nosplit, E}                     -> {nosplit, bottom_up(F, Env, E)};
+        {'case', Pat, Split}             -> {'case', Pat, bottom_up(F, Env, Split)}
+    end).
+
 get_named_args(NamedArgsT, Args) ->
     IsNamed = fun({named_arg, _, _, _}) -> true;
                  (_) -> false end,
@@ -1371,6 +1797,8 @@ rename(Ren, Expr) ->
         {set_proj, R, I, E}   -> {set_proj, rename(Ren, R), I, rename(Ren, E)};
         {op, Op, Es}          -> {op, Op, [rename(Ren, E) || E <- Es]};
         {funcall, Fun, Es}    -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]};
+        {set_state, R, E}     -> {set_state, R, rename(Ren, E)};
+        {get_state, _}        -> Expr;
         {closure, F, Env}     -> {closure, F, rename(Ren, Env)};
         {switch, Split}       -> {switch, rename_split(Ren, Split)};
         {lam, Xs, B} ->
@@ -1477,6 +1905,10 @@ get_attributes(Ann) ->
 indexed(Xs) ->
     lists:zip(lists:seq(1, length(Xs)), Xs).
 
+setnth(I, X, Xs) ->
+    {Ys, [_ | Zs]} = lists:split(I - 1, Xs),
+    Ys ++ [X] ++ Zs.
+
 -dialyzer({nowarn_function, [fcode_error/1, internal_error/1]}).
 
 fcode_error(Error) ->
@@ -1579,9 +2011,18 @@ pp_fexpr({op, Op, [A] = Args}) ->
     end;
 pp_fexpr({op, Op, As}) ->
     pp_beside(pp_text(Op), pp_fexpr({tuple, As}));
-pp_fexpr({'let', X, A, B}) ->
+pp_fexpr({'let', _, _, _} = Expr) ->
-    pp_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]),
+    Lets = fun Lets({'let', Y, C, D}) ->
-            pp_fexpr(B)]);
+                        {Ls, E} = Lets(D),
+                        {[{Y, C} | Ls], E};
+               Lets(E) -> {[], E} end,
+    {Ls, Body} = Lets(Expr),
+    pp_parens(
+      pp_par(
+        [ pp_beside([ pp_text("let "),
+                      pp_above([ pp_par([pp_text(X), pp_text("="), prettypr:nest(2, pp_fexpr(A))]) || {X, A} <- Ls ]),
+                      pp_text(" in ") ]),
+          pp_fexpr(Body) ]));
 pp_fexpr({builtin_u, B, N}) ->
     pp_beside([pp_text(B), pp_text("/"), pp_text(N)]);
 pp_fexpr({builtin_u, B, N, TypeArgs}) ->
@@ -1594,6 +2035,10 @@ pp_fexpr({remote, ArgsT, RetT, Ct, Fun, As}) ->
     pp_call(pp_parens(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text(" : "), pp_ftype({function, ArgsT, RetT})])), As);
 pp_fexpr({funcall, Fun, As}) ->
     pp_call(pp_fexpr(Fun), As);
+pp_fexpr({set_state, R, A}) ->
+    pp_call(pp_text("set_state"), [{lit, {int, R}}, A]);
+pp_fexpr({get_state, R}) ->
+    pp_call(pp_text("get_state"), [{lit, {int, R}}]);
 pp_fexpr({switch, Split}) -> pp_split(Split).
 
 pp_call(Fun, Args) ->
@@ -1609,7 +2054,7 @@ pp_ftype({tvar, X}) -> pp_text(X);
 pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]);
 pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]);
 pp_ftype({tuple, Ts}) ->
-    pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts])));
+    pp_parens(pp_par(pp_punctuate(pp_text(" *"), [pp_ftype(T) || T <- Ts])));
 pp_ftype({list, T}) ->
     pp_call_t("list", [T]);
 pp_ftype({function, Args, Res}) ->

src/aeso_ast_to_icode.erl

@@ -131,7 +131,7 @@ contract_to_icode([Decl | Code], Icode) ->
 ast_id({id, _, Id}) -> Id;
 ast_id({qid, _, Id}) -> Id.
 
-ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) ->
+ast_args([{typed, _, Name, Type}|Rest], Acc, Icode) ->
     ast_args(Rest, [{ast_id(Name), ast_typerep1(Type, Icode)}| Acc], Icode);
 ast_args([], Acc, _Icode) -> lists:reverse(Acc).
 
@@ -318,19 +318,23 @@ ast_body({app, As, Fun, Args}, Icode) ->
     end;
 ast_body({list_comp, _, Yield, []}, Icode) ->
     #list{elems = [ast_body(Yield, Icode)]};
-ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, 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, {id, As, "_"}, {list, As, []}}]},
     #funcall
         { function = #var_ref{ name = ["ListInternal", "flat_map"] }
         , args =
-              [ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}]
+              [ #lambda{ args=[#arg{name = Arg, type = ast_type(ArgType, Icode)}]
-                       , body = ast_body({list_comp, As, Yield, Rest}, Icode)
+                       , body = ast_body(Body, Icode)
                        }
               , ast_body(BindExpr, Icode)
               ]
         };
 ast_body({list_comp, As, Yield, [{comprehension_if, AsIF, Cond}|Rest]}, Icode) ->
     ast_body({'if', AsIF, Cond, {list_comp, As, Yield, Rest}, {list, As, []}}, Icode);
-ast_body({list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}, Icode) ->
+ast_body({list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}, Icode) ->
     ast_body({block, As, [LV, {list_comp, As, Yield, Rest}]}, Icode);
 ast_body({list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}, Icode) ->
     ast_body({block, As, [LF, {list_comp, As, Yield, Rest}]}, Icode);
@@ -344,14 +348,16 @@ ast_body({switch,_,A,Cases}, Icode) ->
     #switch{expr=ast_body(A, Icode),
             cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)}
               || {'case',_,Pat,Body} <- Cases]};
-ast_body({block, As, [{letval, _, Pat, _, E} | Rest]}, Icode) ->
+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, [{letval, Ann, F, unused, {lam, Ann, Args, 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);
 ast_body({block,_,[]}, _Icode) ->
     #tuple{cpts=[]};
 ast_body({block,_,[E]}, Icode) ->
@@ -800,10 +806,10 @@ check_entrypoint_type(Ann, Name, Args, Ret) ->
                     true  -> ok
                 end end,
     [ CheckFirstOrder(T, {invalid_entrypoint, higher_order, Ann1, Name, {argument, X, T}})
-      || {arg, Ann1, X, T} <- Args ],
+      || {typed, Ann1, X, T} <- Args ],
     CheckFirstOrder(Ret, {invalid_entrypoint, higher_order, Ann, Name, {result, Ret}}),
     [ CheckMonomorphic(T, {invalid_entrypoint, polymorphic, Ann1, Name, {argument, X, T}})
-      || {arg, Ann1, X, T} <- Args ],
+      || {typed, Ann1, X, T} <- Args ],
     CheckMonomorphic(Ret, {invalid_entrypoint, polymorphic, Ann, Name, {result, Ret}}).
 
 check_oracle_type(Ann, Type = ?oracle_t(QType, RType)) ->

src/aeso_compiler.erl

@@ -23,6 +23,7 @@
         , decode_calldata/4
         , parse/2
         , add_include_path/2
+        , validate_byte_code/3
         ]).
 
 -include_lib("aebytecode/include/aeb_opcodes.hrl").
@@ -388,8 +389,8 @@ decode_calldata(ContractString, FunName, Calldata, Options0) ->
         #{ typed_ast := TypedAst, type_env  := TypeEnv} = Code,
 
         {ok, Args, _} = get_decode_type(FunName, TypedAst),
-        DropArg       = fun({arg, _, _, T}) -> T; (T) -> T end,
+        GetType       = fun({typed, _, _, T}) -> T; (T) -> T end,
-        ArgTypes      = lists:map(DropArg, Args),
+        ArgTypes      = lists:map(GetType, Args),
         Type0         = {tuple_t, [], ArgTypes},
         %% user defined data types such as variants needed to match against
         Type          = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
@@ -507,6 +508,14 @@ icode_to_term(T = {map, KT, VT}, M) ->
             #{};
         _ -> throw({todo, M})
     end;
+icode_to_term(word, {unop, 'bnot', A}) ->
+    bnot icode_to_term(word, A);
+icode_to_term(word, {binop, 'bor', A, B}) ->
+    icode_to_term(word, A) bor icode_to_term(word, B);
+icode_to_term(word, {binop, 'bsl', A, B}) ->
+    icode_to_term(word, B) bsl icode_to_term(word, A);
+icode_to_term(word, {binop, 'band', A, B}) ->
+    icode_to_term(word, A) band icode_to_term(word, B);
 icode_to_term(typerep, _) ->
     throw({todo, typerep});
 icode_to_term(T, V) ->
@@ -558,6 +567,87 @@ pp(Code, Options, Option, PPFun) ->
             ok
     end.
 
+%% -- Byte code validation ---------------------------------------------------
+
+-define(protect(Tag, Code), fun() -> try Code catch _:Err1 -> throw({Tag, Err1}) end end()).
+
+-spec validate_byte_code(map(), string(), options()) -> ok | {error, [aeso_errors:error()]}.
+validate_byte_code(#{ byte_code := ByteCode, payable := Payable }, Source, Options) ->
+    Fail = fun(Err) -> {error, [aeso_errors:new(data_error, Err)]} end,
+    case proplists:get_value(backend, Options, aevm) of
+        B when B /= fate -> Fail(io_lib:format("Unsupported backend: ~s\n", [B]));
+        fate ->
+            try
+                FCode1 = ?protect(deserialize, aeb_fate_code:strip_init_function(aeb_fate_code:deserialize(ByteCode))),
+                {FCode2, SrcPayable} =
+                    ?protect(compile,
+                             begin
+                               {ok, #{ byte_code := SrcByteCode, payable := SrcPayable }} =
+                                    from_string1(fate, Source, Options),
+                               FCode = aeb_fate_code:deserialize(SrcByteCode),
+                               {aeb_fate_code:strip_init_function(FCode), SrcPayable}
+                             end),
+                case compare_fate_code(FCode1, FCode2) of
+                    ok when SrcPayable /= Payable ->
+                        Not = fun(true) -> ""; (false) -> " not" end,
+                        Fail(io_lib:format("Byte code contract is~s payable, but source code contract is~s.\n",
+                                           [Not(Payable), Not(SrcPayable)]));
+                    ok           -> ok;
+                    {error, Why} -> Fail(io_lib:format("Byte code does not match source code.\n~s", [Why]))
+                end
+            catch
+                throw:{deserialize, _}         -> Fail("Invalid byte code");
+                throw:{compile, {error, Errs}} -> {error, Errs}
+            end
+    end.
+
+compare_fate_code(FCode1, FCode2) ->
+    Funs1 = aeb_fate_code:functions(FCode1),
+    Funs2 = aeb_fate_code:functions(FCode2),
+    Syms1 = aeb_fate_code:symbols(FCode1),
+    Syms2 = aeb_fate_code:symbols(FCode2),
+    FunHashes1 = maps:keys(Funs1),
+    FunHashes2 = maps:keys(Funs2),
+    case FunHashes1 == FunHashes2 of
+        false ->
+            InByteCode   = [ binary_to_list(maps:get(H, Syms1)) || H <- FunHashes1 -- FunHashes2 ],
+            InSourceCode = [ binary_to_list(maps:get(H, Syms2)) || H <- FunHashes2 -- FunHashes1 ],
+            Msg = [ io_lib:format("- Functions in the byte code but not in the source code:\n"
+                                  "    ~s\n", [string:join(InByteCode, ", ")]) || InByteCode /= [] ] ++
+                  [ io_lib:format("- Functions in the source code but not in the byte code:\n"
+                                  "    ~s\n", [string:join(InSourceCode, ", ")]) || InSourceCode /= [] ],
+            {error, Msg};
+        true ->
+            case lists:append([ compare_fate_fun(maps:get(H, Syms1), Fun1, Fun2)
+                                || {{H, Fun1}, {_, Fun2}} <- lists:zip(maps:to_list(Funs1),
+                                                                       maps:to_list(Funs2)) ]) of
+                [] -> ok;
+                Errs -> {error, Errs}
+            end
+    end.
+
+compare_fate_fun(_Name, Fun, Fun) -> [];
+compare_fate_fun(Name, {Attr, Type, _}, {Attr, Type, _}) ->
+    [io_lib:format("- The implementation of the function ~s is different.\n", [Name])];
+compare_fate_fun(Name, {Attr1, Type, _}, {Attr2, Type, _}) ->
+    [io_lib:format("- The attributes of the function ~s differ:\n"
+                   "    Byte code:   ~s\n"
+                   "    Source code: ~s\n",
+                   [Name, string:join([ atom_to_list(A) || A <- Attr1 ], ", "),
+                          string:join([ atom_to_list(A) || A <- Attr2 ], ", ")])];
+compare_fate_fun(Name, {_, Type1, _}, {_, Type2, _}) ->
+    [io_lib:format("- The type of the function ~s differs:\n"
+                   "    Byte code:   ~s\n"
+                   "    Source code: ~s\n",
+                   [Name, pp_fate_sig(Type1), pp_fate_sig(Type2)])].
+
+pp_fate_sig({[Arg], Res}) ->
+    io_lib:format("~s => ~s", [pp_fate_type(Arg), pp_fate_type(Res)]);
+pp_fate_sig({Args, Res}) ->
+    io_lib:format("(~s) => ~s", [string:join([pp_fate_type(Arg) || Arg <- Args], ", "), pp_fate_type(Res)]).
+
+pp_fate_type(T) -> io_lib:format("~w", [T]).
+
 %% -------------------------------------------------------------------
 
 sophia_type_to_typerep(String) ->

src/aeso_parser.erl

@@ -50,7 +50,8 @@ parse_and_scan(P, S, Opts) ->
     set_current_file(proplists:get_value(src_file, Opts, no_file)),
     case aeso_scan:scan(S) of
         {ok, Tokens} -> aeso_parse_lib:parse(P, Tokens);
-        Error        -> Error
+        {error, {{Input, Pos}, _}} ->
+            {error, {Pos, scan_error, Input}}
     end.
 
 -dialyzer({nowarn_function, parse_error/1}).
@@ -60,8 +61,8 @@ parse_error(Err) ->
 mk_p_err(Pos, Msg) ->
     aeso_errors:new(parse_error, mk_pos(Pos), lists:flatten(Msg)).
 
-mk_error({Pos, ScanE}) when ScanE == scan_error; ScanE == scan_error_no_state ->
+mk_error({Pos, scan_error, Input}) ->
-    mk_p_err(Pos, "Scan error\n");
+    mk_p_err(Pos, io_lib:format("Lexical error on input: ~s\n", [Input]));
 mk_error({Pos, parse_error, Err}) ->
     Msg = io_lib:format("~s\n", [Err]),
     mk_p_err(Pos, Msg);
@@ -100,11 +101,19 @@ decl() ->
     , ?RULE(keyword(datatype), id(), type_vars(), tok('='), typedef(variant), {type_def, _1, _2, _3, _5})
 
       %% Function declarations
-    , ?RULE(modifiers(), fun_or_entry(), id(), tok(':'), type(), add_modifiers(_1, _2, {fun_decl, get_ann(_2), _3, _5}))
+    , ?RULE(modifiers(), fun_or_entry(), maybe_block(fundef_or_decl()), fun_block(_1, _2, _3))
-    , ?RULE(modifiers(), fun_or_entry(), fundef(),               add_modifiers(_1, _2, set_pos(get_pos(get_ann(_2)), _3)))
+    , ?RULE(keyword('let'), valdef(),set_pos(get_pos(_1), _2))
-    , ?RULE(keyword('let'),    valdef(),                         set_pos(get_pos(_1), _2))
     ])).
 
+fun_block(Mods, Kind, [Decl]) ->
+    add_modifiers(Mods, Kind, set_pos(get_pos(Kind), Decl));
+fun_block(Mods, Kind, Decls) ->
+    {block, get_ann(Kind), [ add_modifiers(Mods, Kind, Decl) || Decl <- Decls ]}.
+
+fundef_or_decl() ->
+    choice([?RULE(id(), tok(':'), type(), {fun_decl, get_ann(_1), _1, _3}),
+            fundef()]).
+
 pragma() ->
     Op = choice([token(T) || T <- ['<', '=<', '==', '>=', '>']]),
     ?RULE(tok('@'), id("compiler"), Op, version(), {pragma, get_ann(_1), {compiler, element(1, _3), _4}}).
@@ -116,7 +125,7 @@ mk_version({int, _, Maj}, Rest) ->
     [Maj | [N || {_, {int, _, N}} <- Rest]].
 
 fun_or_entry() ->
-    choice([?RULE(keyword(function), {function, _1}),
+    choice([?RULE(keyword(function),   {function,   _1}),
             ?RULE(keyword(entrypoint), {entrypoint, _1})]).
 
 modifiers() ->
@@ -163,20 +172,19 @@ letdecl() ->
 letdef() -> choice(valdef(), fundef()).
 
 valdef() ->
-    choice(
+    ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}).
-        ?RULE(id(),                   tok('='), body(), {letval, [], _1, type_wildcard(), _3}),
-        ?RULE(id(), tok(':'), type(), tok('='), body(), {letval, [], _1, _3, _5})).
 
 fundef() ->
     choice(
-    [ ?RULE(id(), args(),                   tok('='), body(), {letfun, [], _1, _2, type_wildcard(), _4})
+    [ ?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, [], _1, _2, _4, _6})
+    , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6})
     ]).
 
-args() -> paren_list(arg()).
+args() -> paren_list(pattern()).
+lam_args() -> paren_list(arg()).
 
 arg() -> choice(
-    ?RULE(id(),                   {arg, get_ann(_1), _1, type_wildcard()}),
+    ?RULE(id(),                   {arg, get_ann(_1), _1, type_wildcard(get_ann(_1))}),
     ?RULE(id(), tok(':'), type(), {arg, get_ann(_1), _1, _3})).
 
 %% -- Types ------------------------------------------------------------------
@@ -237,7 +245,7 @@ branch() ->
     ?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, _3}).
 
 pattern() ->
-    ?LET_P(E, expr500(), parse_pattern(E)).
+    ?LET_P(E, expr(), parse_pattern(E)).
 
 %% -- Expressions ------------------------------------------------------------
 
@@ -247,7 +255,7 @@ expr100() ->
     Expr100 = ?LAZY_P(expr100()),
     Expr200 = ?LAZY_P(expr200()),
     choice(
-    [ ?RULE(args(), keyword('=>'), body(), {lam, _2, _1, _3})   %% TODO: better location
+    [ ?RULE(lam_args(), keyword('=>'), body(), {lam, _2, _1, _3})   %% TODO: better location
     , {'if', keyword('if'), parens(Expr100), Expr200, right(tok(else), Expr100)}
     , ?RULE(Expr200, optional(right(tok(':'), type())),
             case _2 of
@@ -296,7 +304,7 @@ comprehension_if() ->
     ?RULE(keyword('if'), parens(expr()), {comprehension_if, _1, _2}).
 
 comprehension_bind() ->
-    ?RULE(id(), tok('<-'), expr(), {comprehension_bind, _1, _3}).
+    ?RULE(pattern(), tok('<-'), expr(), {comprehension_bind, _1, _3}).
 
 arg_expr() ->
     ?LAZY_P(
@@ -348,7 +356,9 @@ record(Fs) ->
                         bad_expr_err("Cannot use '@' in map construction", infix({lvalue, FAnn, LV}, {'@', Ann}, Id));
                     ({field, FAnn, LV, _}) ->
                         bad_expr_err("Cannot use nested fields or keys in map construction", {lvalue, FAnn, LV}) end,
-            {map, Ann, lists:map(KV, Fs)}
+            {map, Ann, lists:map(KV, Fs)};
+        record_or_map_error ->
+            {record_or_map_error, get_ann(hd(Fs)), Fs}
     end.
 
 record_or_map(Fields) ->
@@ -360,9 +370,7 @@ record_or_map(Fields) ->
     case lists:usort(lists:map(Kind, Fields)) of
         [proj]    -> record;
         [map_get] -> map;
-        _         ->
+        _         -> record_or_map_error %% Defer error until type checking
-            [{field, Ann, _, _} | _] = Fields,
-            bad_expr_err("Mixed record fields and map keys in", {record, Ann, Fields})
     end.
 
 field_assignment() ->
@@ -493,8 +501,8 @@ infix(L, Op, R) -> set_ann(format, infix,  {app, get_ann(L), Op, [L, R]}).
 prefixes(Ops, E) -> lists:foldr(fun prefix/2, E, Ops).
 prefix(Op, E)    -> set_ann(format, prefix, {app, get_ann(Op), Op, [E]}).
 
-type_wildcard() ->
+type_wildcard(Ann) ->
-    {id, [{origin, system}], "_"}.
+    {id, [{origin, system} | Ann], "_"}.
 
 block_e(Stmts) ->
     group_ifs(Stmts, []).
@@ -544,7 +552,9 @@ list_comp_e(Ann, Expr, Binds) -> {list_comp, Ann, Expr, Binds}.
 -spec parse_pattern(aeso_syntax:expr()) -> aeso_parse_lib:parser(aeso_syntax:pat()).
 parse_pattern({app, Ann, Con = {'::', _}, Es}) ->
     {app, Ann, Con, lists:map(fun parse_pattern/1, Es)};
-parse_pattern({app, Ann, Con = {con, _, _}, Es}) ->
+parse_pattern({app, Ann, {'-', _}, [{int, _, N}]}) ->
+    {int, Ann, -N};
+parse_pattern({app, Ann, Con = {Tag, _, _}, Es}) when Tag == con; Tag == qcon ->
     {app, Ann, Con, lists:map(fun parse_pattern/1, Es)};
 parse_pattern({tuple, Ann, Es}) ->
     {tuple, Ann, lists:map(fun parse_pattern/1, Es)};
@@ -552,7 +562,10 @@ parse_pattern({list, Ann, Es}) ->
     {list, Ann, lists:map(fun parse_pattern/1, Es)};
 parse_pattern({record, Ann, Fs}) ->
     {record, Ann, lists:map(fun parse_field_pattern/1, Fs)};
+parse_pattern({typed, Ann, E, Type}) ->
+    {typed, Ann, parse_pattern(E), Type};
 parse_pattern(E = {con, _, _})    -> E;
+parse_pattern(E = {qcon, _, _})   -> E;
 parse_pattern(E = {id, _, _})     -> E;
 parse_pattern(E = {int, _, _})    -> E;
 parse_pattern(E = {bool, _, _})   -> E;
@@ -618,11 +631,28 @@ read_file(File, Opts) ->
             case maps:get(binary_to_list(File), Files, not_found) of
                 not_found -> {error, not_found};
                 Src       -> {ok, Src}
+            end;
+        escript ->
+            try
+                Escript        = escript:script_name(),
+                {ok, Sections} = escript:extract(Escript, []),
+                Archive        = proplists:get_value(archive, Sections),
+                FileName       = binary_to_list(filename:join([aesophia, priv, stdlib, File])),
+                case zip:extract(Archive, [{file_list, [FileName]}, memory]) of
+                    {ok, [{_, Src}]} -> {ok, Src};
+                    _                -> {error, not_found}
+                end
+            catch _:_ ->
+                {error, not_found}
             end
     end.
 
 stdlib_options() ->
-    [{include, {file_system, [aeso_stdlib:stdlib_include_path()]}}].
+    StdLibDir = aeso_stdlib:stdlib_include_path(),
+    case filelib:is_dir(StdLibDir) of
+        true  -> [{include, {file_system, [StdLibDir]}}];
+        false -> [{include, escript}]
+    end.
 
 get_include_code(File, Ann, Opts) ->
     case {read_file(File, Opts), read_file(File, stdlib_options())} of

src/aeso_pretty.erl

@@ -169,7 +169,11 @@ decl(D = {letfun, Attrs, _, _, _, _}) ->
               false -> "function"
           end,
     hsep(lists:map(Mod, Attrs) ++ [letdecl(Fun, D)]);
-decl(D = {letval, _, _, _, _}) -> letdecl("let", D).
+decl({fun_clauses, Ann, Name, Type, Clauses}) ->
+    above([ decl(D) || D <- [{fun_decl, Ann, Name, Type} | Clauses] ]);
+decl(D = {letval, _, _, _}) -> letdecl("let", D);
+decl({block, _, Ds}) ->
+    above([ decl(D) || D <- Ds ]).
 
 -spec pragma(aeso_syntax:pragma()) -> doc().
 pragma({compiler, Op, Ver}) ->
@@ -193,10 +197,10 @@ name({tvar, _, Name})  -> text(Name);
 name({typed, _, Name, _}) -> name(Name).
 
 -spec letdecl(string(), aeso_syntax:letbind()) -> doc().
-letdecl(Let, {letval, _, F, T, E}) ->
+letdecl(Let, {letval, _, P, E}) ->
-    block_expr(0, hsep([text(Let), typed(name(F), T), text("=")]), E);
+    block_expr(0, hsep([text(Let), expr(P), text("=")]), E);
 letdecl(Let, {letfun, _, F, Args, T, E}) ->
-    block_expr(0, hsep([text(Let), typed(beside(name(F), args(Args)), T), text("=")]), E).
+    block_expr(0, hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T), text("=")]), E).
 
 -spec args([aeso_syntax:arg()]) -> doc().
 args(Args) ->
@@ -305,6 +309,8 @@ expr_p(_, {tuple, _, Es}) ->
     tuple(lists:map(fun expr/1, Es));
 expr_p(_, {list, _, Es}) ->
     list(lists:map(fun expr/1, Es));
+expr_p(_, {list_comp, _, E, Binds}) ->
+    list([follow(expr(E), hsep(text("|"), par(punctuate(text(","), lists:map(fun lc_bind/1, Binds)), 0)), 0)]);
 expr_p(_, {record, _, Fs}) ->
     record(lists:map(fun field/1, Fs));
 expr_p(_, {map, Ann, KVs}) ->
@@ -387,6 +393,13 @@ stmt_p({else, Else}) ->
         _ -> block_expr(200, text("else"), Else)
     end.
 
+lc_bind({comprehension_bind, P, E}) ->
+    follow(hsep(expr(P), text("<-")), expr(E));
+lc_bind({comprehension_if, _, E}) ->
+    beside([text("if("), expr(E), text(")")]);
+lc_bind(Let) ->
+    letdecl("let", Let).
+
 -spec bin_prec(aeso_syntax:bin_op()) -> {integer(), integer(), integer()}.
 bin_prec('..')   -> {  0,   0,   0};  %% Always printed inside '[ ]'
 bin_prec('=')    -> {  0,   0,   0};  %% Always printed inside '[ ]'
@@ -450,7 +463,7 @@ elim1(Get={map_get, _, _})    -> elim(Get);
 elim1(Get={map_get, _, _, _}) -> elim(Get).
 
 alt({'case', _, Pat, Body}) ->
-    block_expr(0, hsep(expr_p(500, Pat), text("=>")), Body).
+    block_expr(0, hsep(expr(Pat), text("=>")), Body).
 
 block_expr(_, Header, {block, _, Ss}) ->
     block(Header, statements(Ss));
@@ -460,7 +473,7 @@ block_expr(P, Header, E) ->
 statements(Stmts) ->
     above([ statement(S) || S <- Stmts ]).
 
-statement(S = {letval, _, _, _, _})    -> letdecl("let", S);
+statement(S = {letval, _, _, _})       -> letdecl("let", S);
 statement(S = {letfun, _, _, _, _, _}) -> letdecl("let", S);
 statement(E) -> expr(E).
 

src/aeso_syntax.erl

@@ -40,6 +40,8 @@
               | {type_decl, ann(), id(), [tvar()]}
               | {type_def, ann(), id(), [tvar()], typedef()}
               | {fun_decl, ann(), id(), type()}
+              | {fun_clauses, ann(), id(), type(), [letbind()]}
+              | {block, ann(), [decl()]}
               | letbind().
 
 -type compiler_version() :: [non_neg_integer()].
@@ -47,8 +49,8 @@
 -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}.
 
 -type letbind()
-    :: {letval, ann(), id(), type(), expr()}
+    :: {letval, ann(), pat(), expr()}
-     | {letfun, ann(), id(), [arg()], type(), expr()}.
+     | {letfun, ann(), id(), [pat()], type(), expr()}.
 
 -type arg() :: {arg, ann(), id(), type()}.
 
@@ -100,9 +102,8 @@
      | {list, ann(), [expr()]}
      | {list_comp, ann(), expr(), [comprehension_exp()]}
      | {typed, ann(), expr(), type()}
-     | {record, ann(), [field(expr())]}
+     | {record_or_map(), ann(), [field(expr())]}
-     | {record, ann(), expr(), [field(expr())]} %% record update
+     | {record_or_map(), ann(), expr(), [field(expr())]} %% record/map update
-     | {map, ann(), expr(), [field(expr())]}    %% map update
      | {map, ann(), [{expr(), expr()}]}
      | {map_get, ann(), expr(), expr()}
      | {map_get, ann(), expr(), expr(), expr()}
@@ -111,7 +112,9 @@
      | id() | qid() | con() | qcon()
      | constant().
 
--type comprehension_exp() :: [ {comprehension_bind, id(), expr()}
+-type record_or_map() :: record | map | record_or_map_error.
+
+-type comprehension_exp() :: [ {comprehension_bind, pat(), expr()}
                              | {comprehension_if, ann(), expr()}
                              | letbind() ].
 
@@ -139,6 +142,7 @@
 -type pat() :: {app, ann(), con() | op(), [pat()]}
              | {tuple, ann(), [pat()]}
              | {list, ann(), [pat()]}
+             | {typed, ann(), pat(), type()}
              | {record, ann(), [field(pat())]}
              | constant()
              | con()

src/aeso_syntax_utils.erl

@@ -48,8 +48,9 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
             {type_decl, _, I, _}     -> BindType(I);
             {type_def, _, I, _, D}   -> Plus(BindType(I), Decl(D));
             {fun_decl, _, _, T}      -> Type(T);
-            {letval, _, F, T, E}     -> Sum([BindExpr(F), Type(T), Expr(E)]);
+            {letval, _, P, E}        -> Scoped(BindExpr(P), Expr(E));
             {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]);
+            {fun_clauses, _, _, T, Cs} -> Sum([Type(T) | [Decl(C) || C <- Cs]]);
             %% typedef()
             {alias_t, T}    -> Type(T);
             {record_t, Fs}  -> Type(Fs);
@@ -76,8 +77,8 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
                 Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R})));
             {list_comp, A, Y, [{comprehension_if, _, E}|R]} ->
                 Plus(Expr(E), Expr({list_comp, A, Y, R}));
-            {list_comp, A, Y, [D = {letval, _, F, _, _} | R]} ->
+            {list_comp, A, Y, [D = {letval, _, Pat, _} | R]} ->
-                Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R})));
+                Plus(Decl(D), Scoped(BindExpr(Pat), Expr({list_comp, A, Y, R})));
             {list_comp, A, Y, [D = {letfun, _, F, _, _, _} | R]} ->
                 Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R})));
             {typed, _, E, T}       -> Plus(Expr(E), Type(T));

src/aeso_vm_decode.erl

@@ -18,9 +18,14 @@ from_aevm(word, {id, _, "address"},                     N) -> address_literal(ac
 from_aevm(word, {app_t, _, {id, _, "oracle"}, _},       N) -> address_literal(oracle_pubkey, N);
 from_aevm(word, {app_t, _, {id, _, "oracle_query"}, _}, N) -> address_literal(oracle_query_id, N);
 from_aevm(word, {con, _, _Name},                        N) -> address_literal(contract_pubkey, N);
-from_aevm(word, {id, _, "int"},     N) -> <<N1:256/signed>> = <<N:256>>, {int, [], N1};
+from_aevm(word, {id, _, "int"}, N0) ->
-from_aevm(word, {id, _, "bits"},    N) -> error({todo, bits, N});
+    <<N:256/signed>> = <<N0:256>>,
-from_aevm(word, {id, _, "bool"},    N) -> {bool, [], N /= 0};
+    if N < 0 -> {app, [{format, prefix}], {'-', []}, [{int, [], -N}]};
+       true  -> {int, [], N} end;
+from_aevm(word, {id, _, "bits"}, N0) ->
+    <<N:256/signed>> = <<N0:256>>,
+    make_bits(N);
+from_aevm(word, {id, _, "bool"}, N) -> {bool, [], N /= 0};
 from_aevm(word, {bytes_t, _, Len}, Val) when Len =< 32 ->
     <<Bytes:Len/unit:8, _/binary>> = <<Val:32/unit:8>>,
     {bytes, [], <<Bytes:Len/unit:8>>};
@@ -55,6 +60,7 @@ from_aevm({variant, VmCons}, {variant_t, Cons}, {variant, Tag, Args})
     VmTypes = lists:nth(Tag + 1, VmCons),
     ConType = lists:nth(Tag + 1, Cons),
     from_aevm(VmTypes, ConType, Args);
+from_aevm([], {constr_t, _, Con, []}, []) -> Con;
 from_aevm(VmTypes, {constr_t, _, Con, Types}, Args)
         when length(VmTypes) == length(Types),
              length(VmTypes) == length(Args) ->
@@ -70,8 +76,10 @@ from_fate({app_t, _, {id, _, "oracle"}, _}, ?FATE_ORACLE(Bin)) -> {oracle_pubkey
 from_fate({app_t, _, {id, _, "oracle_query"}, _}, ?FATE_ORACLE_Q(Bin)) -> {oracle_query_id, [], Bin};
 from_fate({con, _, _Name},  ?FATE_CONTRACT(Bin)) -> {contract_pubkey, [], Bin};
 from_fate({bytes_t, _, N},  ?FATE_BYTES(Bin)) when byte_size(Bin) == N -> {bytes, [], Bin};
-from_fate({id, _, "bits"},  ?FATE_BITS(Bin)) -> error({todo, bits, Bin});
+from_fate({id, _, "bits"},  ?FATE_BITS(N)) -> make_bits(N);
-from_fate({id, _, "int"},     N) when is_integer(N) -> {int, [], N};
+from_fate({id, _, "int"},     N) when is_integer(N) ->
+    if N < 0 -> {app, [{format, prefix}], {'-', []}, [{int, [], -N}]};
+       true  -> {int, [], N} end;
 from_fate({id, _, "bool"},    B) when is_boolean(B) -> {bool, [], B};
 from_fate({id, _, "string"}, S) when is_binary(S) -> {string, [], S};
 from_fate({app_t, _, {id, _, "list"}, [Type]}, List) when is_list(List) ->
@@ -105,9 +113,23 @@ from_fate({variant_t, Cons}, {variant, Ar, Tag, Args})
             from_fate(ConType, ArgList);
         _ -> throw(cannot_translate_to_sophia)
     end;
+from_fate({constr_t, _, Con, []}, []) -> Con;
 from_fate({constr_t, _, Con, Types}, Args)
         when length(Types) == length(Args) ->
     {app, [], Con, [ from_fate(Type, Arg)
                      || {Type, Arg} <- lists:zip(Types, Args) ]};
 from_fate(_Type, _Data) ->
     throw(cannot_translate_to_sophia).
+
+
+make_bits(N) ->
+    Id = fun(F) -> {qid, [], ["Bits", F]} end,
+    if N < 0 -> make_bits(Id("clear"), Id("all"), 0, bnot N);
+       true  -> make_bits(Id("set"), Id("none"), 0, N) end.
+
+make_bits(_Set, Zero, _I, 0) -> Zero;
+make_bits(Set, Zero, I, N) when 0 == N rem 2 ->
+    make_bits(Set, Zero, I + 1, N div 2);
+make_bits(Set, Zero, I, N) ->
+    {app, [], Set, [make_bits(Set, Zero, I + 1, N div 2), {int, [], I}]}.
+

src/aesophia.app.src

@@ -1,6 +1,6 @@
 {application, aesophia,
  [{description, "Contract Language for aeternity"},
-  {vsn, "4.0.0"},
+  {vsn, "4.2.0"},
   {registered, []},
   {applications,
    [kernel,

test/aeso_abi_tests.erl

@@ -62,7 +62,7 @@ encode_decode_sophia_test() ->
                                 Other -> Other
                               end end,
     ok = Check("int", "42"),
-    ok = Check("int", "-42"),
+    ok = Check("int", "- 42"),
     ok = Check("bool", "true"),
     ok = Check("bool", "false"),
     ok = Check("string", "\"Hello\""),

test/aeso_aci_tests.erl

@@ -106,7 +106,7 @@ aci_test_contract(Name) ->
     ok.
 
 check_stub(Stub, Options) ->
-    case aeso_parser:string(binary_to_list(Stub), Options) of
+    try aeso_parser:string(binary_to_list(Stub), Options) of
         Ast ->
             try
                 %% io:format("AST: ~120p\n", [Ast]),
@@ -117,9 +117,9 @@ check_stub(Stub, Options) ->
                   _:R ->
                 io:format("Error: ~p\n", [R]),
                 error(R)
-            end;
+            end
-        {error, E} ->
+    catch throw:{error, Errs} ->
-            io:format("Error: ~p\n", [E]),
+        _ = [ io:format("~s\n", [aeso_errors:pp(E)]) || E <- Errs ],
-            error({parse_error, E})
+        error({parse_errors, Errs})
     end.
 

test/aeso_calldata_tests.erl

@@ -29,11 +29,10 @@ calldata_test_() ->
                   true -> ast_exprs(ContractString, Fun, Args, [{backend, fate}]);
                   false -> undefined
               end,
-           case FateExprs == undefined orelse AevmExprs == undefined of
+           ParsedExprs = parse_args(Fun, Args),
-               true -> ok;
+           [ ?assertEqual(ParsedExprs, AevmExprs) || AevmExprs /= undefined ],
-               false ->
+           [ ?assertEqual(ParsedExprs, FateExprs) || FateExprs /= undefined ],
-                   ?assertEqual(FateExprs, AevmExprs)
+           ok
-           end
         end} || {ContractName, Fun, Args} <- compilable_contracts()].
 
 calldata_aci_test_() ->
@@ -53,19 +52,34 @@ calldata_aci_test_() ->
                   true -> ast_exprs(ContractACI, Fun, Args, [{backend, fate}]);
                   false -> undefined
               end,
-           case FateExprs == undefined orelse AevmExprs == undefined of
+           ParsedExprs = parse_args(Fun, Args),
-               true -> ok;
+           [ ?assertEqual(ParsedExprs, AevmExprs) || AevmExprs /= undefined ],
-               false ->
+           [ ?assertEqual(ParsedExprs, FateExprs) || FateExprs /= undefined ],
-                   ?assertEqual(FateExprs, AevmExprs)
+           ok
-           end
         end} || {ContractName, Fun, Args} <- compilable_contracts()].
 
+parse_args(Fun, Args) ->
+    [{contract, _, _, [{letfun, _, _, _, _, {app, _, _, AST}}]}] =
+        aeso_parser:string("contract Temp = function foo() = " ++ Fun ++ "(" ++ string:join(Args, ", ") ++ ")"),
+    strip_ann(AST).
+
+strip_ann(T) when is_tuple(T) ->
+    strip_ann1(setelement(2, T, []));
+strip_ann(X) -> strip_ann1(X).
+
+strip_ann1({map, [], KVs}) ->
+    {map, [], [{strip_ann(K), strip_ann(V)} || {K, V} <- KVs]};
+strip_ann1(T) when is_tuple(T) ->
+    list_to_tuple(strip_ann1(tuple_to_list(T)));
+strip_ann1(L) when is_list(L) ->
+    lists:map(fun strip_ann/1, L);
+strip_ann1(X) -> X.
 
 ast_exprs(ContractString, Fun, Args, Opts) ->
     {ok, Data} = (catch aeso_compiler:create_calldata(ContractString, Fun, Args, Opts)),
     {ok, _Types, Exprs} = (catch aeso_compiler:decode_calldata(ContractString, Fun, Data, Opts)),
     ?assert(is_list(Exprs)),
-    Exprs.
+    strip_ann(Exprs).
 
 check_errors(Expect, ErrorString) ->
     %% This removes the final single \n as well.
@@ -85,7 +99,9 @@ compilable_contracts() ->
      {"maps", "init", []},
      {"funargs", "menot", ["false"]},
      {"funargs", "append", ["[\"false\", \" is\", \" not\", \" true\"]"]},
-     %% TODO {"funargs", "bitsum", ["Bits.all"]},
+     {"funargs", "bitsum", ["Bits.all"]},
+     {"funargs", "bitsum", ["Bits.clear(Bits.clear(Bits.all, 4), 2)"]}, %% Order matters for test
+     {"funargs", "bitsum", ["Bits.set(Bits.set(Bits.none, 4), 2)"]},
      {"funargs", "read", ["{label = \"question 1\", result = 4}"]},
      {"funargs", "sjutton", ["#0011012003100011012003100011012003"]},
      {"funargs", "sextiosju", ["#01020304050607080910111213141516171819202122232425262728293031323334353637383940"

test/aeso_compiler_tests.erl

@@ -12,6 +12,14 @@
 
 -include_lib("eunit/include/eunit.hrl").
 
+run_test(Test) ->
+    TestFun = list_to_atom(lists:concat([Test, "_test_"])),
+    [ begin
+          io:format("~s\n", [Label]),
+          Fun()
+      end || {Label, Fun} <- ?MODULE:TestFun() ],
+    ok.
+
 %%  Very simply test compile the given contracts. Only basic checks
 %%  are made on the output, just that it is a binary which indicates
 %%  that the compilation worked.
@@ -130,6 +138,7 @@ compilable_contracts() ->
      "test",
      "builtin_bug",
      "builtin_map_get_bug",
+     "lc_record_bug",
      "nodeadcode",
      "deadcode",
      "variant_types",
@@ -153,7 +162,10 @@ compilable_contracts() ->
      "list_comp",
      "payable",
      "unapplied_builtins",
-     "underscore_number_literals"
+     "underscore_number_literals",
+     "qualified_constructor",
+     "let_patterns",
+     "lhs_matching"
     ].
 
 not_yet_compilable(fate) -> [];
@@ -288,9 +300,22 @@ failing_contracts() ->
           "Repeated name x in pattern\n"
           "  x :: x (at line 26, column 7)">>,
         <<?Pos(44, 14)
-          "Repeated argument x to function repeated_arg (at line 44, column 14).">>,
+          "Repeated names x, y in pattern\n"
-        <<?Pos(44, 14)
+          "  (x : int, y, x : string, y : bool) (at line 44, column 14)">>,
-          "Repeated argument y to function repeated_arg (at line 44, column 14).">>,
+        <<?Pos(44, 39)
+          "Cannot unify int\n"
+          "         and string\n"
+          "when checking the type of the expression at line 44, column 39\n"
+          "  x : int\n"
+          "against the expected type\n"
+          "  string">>,
+        <<?Pos(44, 72)
+          "Cannot unify int\n"
+          "         and string\n"
+          "when checking the type of the expression at line 44, column 72\n"
+          "  x : int\n"
+          "against the expected type\n"
+          "  string">>,
         <<?Pos(14, 24)
           "No record type with fields y, z (at line 14, column 24)">>,
         <<?Pos(15, 26)
@@ -356,73 +381,7 @@ failing_contracts() ->
          <<?Pos(3, 13)
            "Nested namespace not allowed\nNamespace 'Foo' at line 3, column 13 not defined at top level.">>])
     , ?TYPE_ERROR(bad_address_literals,
-        [<<?Pos(32, 5)
+        [<<?Pos(11, 5)
-           "The type bytes(32) is not a contract type\n"
-           "when checking that the contract literal\n"
-           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
-           "has the type\n"
-           "  bytes(32)">>,
-         <<?Pos(30, 5)
-           "The type oracle(int, bool) is not a contract type\n"
-           "when checking that the contract literal\n"
-           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
-           "has the type\n"
-           "  oracle(int, bool)">>,
-         <<?Pos(28, 5)
-           "The type address is not a contract type\n"
-           "when checking that the contract literal\n"
-           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
-           "has the type\n"
-           "  address">>,
-         <<?Pos(25, 5)
-           "Cannot unify oracle_query('a, 'b)\n"
-           "         and Remote\n"
-           "when checking the type of the expression at line 25, column 5\n"
-           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
-           "    oracle_query('a, 'b)\n"
-           "against the expected type\n"
-           "  Remote">>,
-         <<?Pos(23, 5)
-           "Cannot unify oracle_query('c, 'd)\n"
-           "         and bytes(32)\n"
-           "when checking the type of the expression at line 23, column 5\n"
-           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
-           "    oracle_query('c, 'd)\n"
-           "against the expected type\n"
-           "  bytes(32)">>,
-         <<?Pos(21, 5)
-           "Cannot unify oracle_query('e, 'f)\n"
-           "         and oracle(int, bool)\n"
-           "when checking the type of the expression at line 21, column 5\n"
-           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
-           "    oracle_query('e, 'f)\n"
-           "against the expected type\n"
-           "  oracle(int, bool)">>,
-         <<?Pos(18, 5)
-           "Cannot unify oracle('g, 'h)\n"
-           "         and Remote\n"
-           "when checking the type of the expression at line 18, column 5\n"
-           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
-           "    oracle('g, 'h)\n"
-           "against the expected type\n"
-           "  Remote">>,
-         <<?Pos(16, 5)
-           "Cannot unify oracle('i, 'j)\n"
-           "         and bytes(32)\n"
-           "when checking the type of the expression at line 16, column 5\n"
-           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
-           "    oracle('i, 'j)\n"
-           "against the expected type\n"
-           "  bytes(32)">>,
-         <<?Pos(14, 5)
-           "Cannot unify oracle('k, 'l)\n"
-           "         and oracle_query(int, bool)\n"
-           "when checking the type of the expression at line 14, column 5\n"
-           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
-           "    oracle('k, 'l)\n"
-           "against the expected type\n"
-           "  oracle_query(int, bool)">>,
-         <<?Pos(11, 5)
            "Cannot unify address\n"
            "         and oracle(int, bool)\n"
            "when checking the type of the expression at line 11, column 5\n"
@@ -443,6 +402,72 @@ failing_contracts() ->
            "  ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt : address\n"
            "against the expected type\n"
            "  bytes(32)">>,
+         <<?Pos(14, 5)
+           "Cannot unify oracle('a, 'b)\n"
+           "         and oracle_query(int, bool)\n"
+           "when checking the type of the expression at line 14, column 5\n"
+           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
+           "    oracle('a, 'b)\n"
+           "against the expected type\n"
+           "  oracle_query(int, bool)">>,
+         <<?Pos(16, 5)
+           "Cannot unify oracle('c, 'd)\n"
+           "         and bytes(32)\n"
+           "when checking the type of the expression at line 16, column 5\n"
+           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
+           "    oracle('c, 'd)\n"
+           "against the expected type\n"
+           "  bytes(32)">>,
+         <<?Pos(18, 5)
+           "Cannot unify oracle('e, 'f)\n"
+           "         and Remote\n"
+           "when checking the type of the expression at line 18, column 5\n"
+           "  ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5 :\n"
+           "    oracle('e, 'f)\n"
+           "against the expected type\n"
+           "  Remote">>,
+         <<?Pos(21, 5)
+           "Cannot unify oracle_query('g, 'h)\n"
+           "         and oracle(int, bool)\n"
+           "when checking the type of the expression at line 21, column 5\n"
+           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
+           "    oracle_query('g, 'h)\n"
+           "against the expected type\n"
+           "  oracle(int, bool)">>,
+         <<?Pos(23, 5)
+           "Cannot unify oracle_query('i, 'j)\n"
+           "         and bytes(32)\n"
+           "when checking the type of the expression at line 23, column 5\n"
+           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
+           "    oracle_query('i, 'j)\n"
+           "against the expected type\n"
+           "  bytes(32)">>,
+         <<?Pos(25, 5)
+           "Cannot unify oracle_query('k, 'l)\n"
+           "         and Remote\n"
+           "when checking the type of the expression at line 25, column 5\n"
+           "  oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY :\n"
+           "    oracle_query('k, 'l)\n"
+           "against the expected type\n"
+           "  Remote">>,
+         <<?Pos(28, 5)
+           "The type address is not a contract type\n"
+           "when checking that the contract literal\n"
+           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
+           "has the type\n"
+           "  address">>,
+         <<?Pos(30, 5)
+           "The type oracle(int, bool) is not a contract type\n"
+           "when checking that the contract literal\n"
+           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
+           "has the type\n"
+           "  oracle(int, bool)">>,
+         <<?Pos(32, 5)
+           "The type bytes(32) is not a contract type\n"
+           "when checking that the contract literal\n"
+           "  ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ\n"
+           "has the type\n"
+           "  bytes(32)">>,
          <<?Pos(34, 5),
            "The type address is not a contract type\n"
            "when checking that the call to\n"
@@ -558,7 +583,7 @@ failing_contracts() ->
             "Failed to resolve byte array lengths in call to Bytes.split with argument of type\n"
             "  - 'f  (at line 12, column 20)\n"
             "and result types\n"
-            "  - 'e  (at line 13, column 5)\n"
+            "  - 'e  (at line 12, column 25)\n"
             "  - bytes(20)  (at line 12, column 29)">>,
           <<?Pos(16, 5)
             "Failed to resolve byte array lengths in call to Bytes.split with argument of type\n"
@@ -571,7 +596,7 @@ failing_contracts() ->
             "  - 'b  (at line 18, column 20)\n"
             "and result types\n"
             "  - bytes(20)  (at line 18, column 25)\n"
-            "  - 'a  (at line 19, column 5)">>])
+            "  - 'a  (at line 18, column 37)">>])
     , ?TYPE_ERROR(wrong_compiler_version,
         [<<?Pos(1, 1)
            "Cannot compile with this version of the compiler,\n"
@@ -587,6 +612,17 @@ failing_contracts() ->
          [<<?Pos(5, 28)
             "Invalid call to contract entrypoint 'Foo.foo'.\n"
             "It must be called as 'c.foo' for some c : Foo.">>])
+    , ?TYPE_ERROR(bad_records,
+        [<<?Pos(3, 16)
+           "Mixed record fields and map keys in\n"
+           "  {x = 0, [0] = 1}">>,
+         <<?Pos(4, 6)
+           "Mixed record fields and map keys in\n"
+           "  r {x = 0, [0] = 1}">>,
+         <<?Pos(5, 6)
+           "Empty record/map update\n"
+           "  r {}">>
+        ])
     ].
 
 -define(Path(File), "code_errors/" ??File).
@@ -702,3 +738,44 @@ failing_code_gen_contracts() ->
             "The state cannot contain functions in the AEVM. Use FATE if you need this.")
     ].
 
+validation_test_() ->
+    [{"Validation fail: " ++ C1 ++ " /= " ++ C2,
+      fun() ->
+        Actual = case validate(C1, C2) of
+                    {error, Errs} -> Errs;
+                    ok -> #{}
+                 end,
+        check_errors(Expect, Actual)
+      end} || {C1, C2, Expect} <- validation_fails()] ++
+    [{"Validation of " ++ C,
+      fun() ->
+        ?assertEqual(ok, validate(C, C))
+      end} || C <- compilable_contracts()].
+
+validation_fails() ->
+    [{"deadcode", "nodeadcode",
+      [<<"Data error:\n"
+         "Byte code does not match source code.\n"
+         "- Functions in the source code but not in the byte code:\n"
+         "    .MyList.map2">>]},
+     {"validation_test1", "validation_test2",
+      [<<"Data error:\n"
+         "Byte code does not match source code.\n"
+         "- The implementation of the function code_fail is different.\n"
+         "- The attributes of the function attr_fail differ:\n"
+         "    Byte code:   payable\n"
+         "    Source code: \n"
+         "- The type of the function type_fail differs:\n"
+         "    Byte code:   integer => integer\n"
+         "    Source code: {tvar,0} => {tvar,0}">>]},
+     {"validation_test1", "validation_test3",
+      [<<"Data error:\n"
+         "Byte code contract is not payable, but source code contract is.">>]}].
+
+validate(Contract1, Contract2) ->
+    ByteCode = #{ fate_code := FCode } = compile(fate, Contract1),
+    FCode1   = aeb_fate_code:serialize(aeb_fate_code:strip_init_function(FCode)),
+    Source   = aeso_test_utils:read_contract(Contract2),
+    aeso_compiler:validate_byte_code(ByteCode#{ byte_code := FCode1 }, Source,
+                                     [{backend, fate}, {include, {file_system, [aeso_test_utils:contract_path()]}}]).
+

test/aeso_parser_tests.erl

@@ -4,6 +4,8 @@
 
 -include_lib("eunit/include/eunit.hrl").
 
+id(X) -> X.
+
 simple_contracts_test_() ->
     {foreach,
      fun() -> ok end,
@@ -14,7 +16,7 @@ simple_contracts_test_() ->
                    "  function id(x) = x\n",
             ?assertMatch(
                 [{contract, _, {con, _, "Identity"},
-                    [{letfun, _, {id, _, "id"}, [{arg, _, {id, _, "x"}, {id, _, "_"}}], {id, _, "_"},
+                    [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"},
                         {id, _, "x"}}]}], parse_string(Text)),
             ok
        end},
@@ -30,7 +32,7 @@ simple_contracts_test_() ->
                     end,
             Parse = fun(S) ->
                     try remove_line_numbers(parse_expr(S))
-                    catch _:_ -> ?assertMatch(ok, {parse_fail, S}) end
+                    catch _:_ -> ?assertMatch(ok, id({parse_fail, S})) end
                 end,
             CheckParens = fun(Expr) ->
                     ?assertEqual(Parse(NoPar(Expr)), Parse(Par(Expr)))
@@ -38,7 +40,6 @@ simple_contracts_test_() ->
             LeftAssoc  = fun(Op) -> CheckParens({{a, Op, b}, Op, c}) end,
             RightAssoc = fun(Op) -> CheckParens({a, Op, {b, Op, c}}) end,
             NonAssoc   = fun(Op) ->
-                            OpAtom = list_to_atom(Op),
                             ?assertThrow({error, [_]},
                                          parse_expr(NoPar({a, Op, {b, Op, c}}))) end,
             Stronger = fun(Op1, Op2) ->
@@ -77,7 +78,7 @@ parse_string(Text, Opts) ->
     aeso_parser:string(Text, Opts).
 
 parse_expr(Text) ->
-    [{letval, _, _, _, Expr}] =
+    [{letval, _, _, Expr}] =
         parse_string("let _ = " ++ Text),
     Expr.
 

test/contracts/bad_records.aes

@@ -0,0 +1,5 @@
+contract BadRecord =
+  entrypoint foo() =
+    let r = {x = 0, [0] = 1}
+    r{x = 0, [0] = 1}
+    r{}

test/contracts/factorial.aes

@@ -11,7 +11,7 @@ contract Factorial =
 
   stateful entrypoint set_worker(worker) = put(state{worker = worker})
 
-  entrypoint fac(x : int) : int =
+  entrypoint
-    if(x == 0) 1
+    fac : int => int
-    else x * state.worker.fac(x - 1)
+    fac(0) = 1
-
+    fac(x) = x * state.worker.fac(x - 1)

test/contracts/lc_record_bug.aes

@@ -0,0 +1,4 @@
+contract Foo =
+  record r = {x : int}
+  // Crashed in the backend due to missing type annotation on the lc body.
+  entrypoint lc(xs) = [ {x = x} | x <- xs ]

test/contracts/let_patterns.aes

@@ -0,0 +1,15 @@
+contract LetPatterns =
+
+  record r = {x : int, y : int, b : bool}
+
+  entrypoint test() = foo([1, 0], (2, 3), Some(4), {x = 5, y = 6, b = false})
+
+  entrypoint foo(xs : list(int), p : int * int, some : option(int), r : r) =
+    let x :: _  = xs
+    let (a, b)  = p
+    let Some(n) = some
+    let {x = i, y = j} = r
+    x + a + b + n + i + j
+
+  entrypoint lc(xs : list(option(int))) : list(int) =
+    [ x | Some(x) <- xs ]

test/contracts/lhs_matching.aes

@@ -0,0 +1,22 @@
+contract LHSMatching =
+
+  function from_some(Some(x)) = x
+
+  function
+    length : list('a) => int
+    length([])      = 0
+    length(_ :: xs) = 1 + length(xs)
+
+  function
+    append([], ys)      = ys
+    append(x :: xs, ys) = x :: append(xs, ys)
+
+  function local_match(xs : list('a)) =
+    let null([])     = true
+    let null(_ :: _) = false
+    !null(xs)
+
+  entrypoint main() =
+    from_some(Some([0]))
+      ++ append([length([true]), 2, 3], [4, 5, 6])
+      ++ [7 | if (local_match([false]))]

test/contracts/qualified_constructor.aes

@@ -0,0 +1,8 @@
+namespace Foo =
+  datatype x = A | B(int)
+
+contract Bar =
+  entrypoint f(a : Foo.x) =
+    switch(a)
+      Foo.A     => 0
+      Foo.B(n)  => n

test/contracts/stack.aes

@@ -8,10 +8,9 @@ contract Stack =
 
   entrypoint init(ss : list(string)) = { stack = ss, size = length(ss) }
 
-  function length(xs) =
+  function
-    switch(xs)
+    length([])      = 0
-      [] => 0
+    length(_ :: xs) = length(xs) + 1
-      _ :: xs => length(xs) + 1
 
   stateful entrypoint pop() : string =
     switch(state.stack)

test/contracts/validation_test1.aes

@@ -0,0 +1,4 @@
+contract ValidationTest =
+  payable entrypoint attr_fail() = ()
+  entrypoint type_fail(x : int) = x
+  entrypoint code_fail(x) = x + 1

test/contracts/validation_test2.aes

@@ -0,0 +1,4 @@
+contract ValidationTest =
+  entrypoint attr_fail() = ()
+  entrypoint type_fail(x) = x
+  entrypoint code_fail(x) = x - 1

test/contracts/validation_test3.aes

@@ -0,0 +1,4 @@
+payable contract ValidationTest =
+  payable entrypoint attr_fail() = ()
+  entrypoint type_fail(x : int) = x
+  entrypoint code_fail(x) = x + 1