.

CHANGELOG.md

@@ -1,39 +1,19 @@
 # Changelog
-All notable changes to this project will be documented in this file.
+All notable changes to this project shall be documented in this file.
 
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
-and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
+and this project adheres to [Semantic
+Versioning](https://semver.org/spec/v2.0.0.html). One deviation from _Keep a
+Changelog_ is that "Unreleased" may suggest a specific version bump in case of
+breaking changes.
 
-## [Unreleased]
+## [Unreleased] [8.x.x]
 ### Added
 ### Changed
-- Names of lifted lambdas now consist of parent function's name and their
+- `pp_assembler` option to `pp_fate` as it is more specific.
-  position in the source code.
 ### Removed
-### Fixed
+- `pp_sophia_code` option as it was a duplicate of `pp_ast`.
-- Lifted lambdas get their names assigned deterministically.
+- `aeso_ast` module as it was unused.
-
-## [7.3.0]
-### Fixed
-- Fixed a bug with polymorphism that allowed functions with the same name but different type to be considered as implementations for their corresponding interface function.
-- Fixed a bug in the byte code optimization that incorrectly reordered dependent instructions.
-
-## [7.2.1]
-### Fixed
-- Fixed bugs with the newly added debugging symbols
-
-## [7.2.0]
-### Added
-- Toplevel compile-time constants
-  ```
-  namespace N =
-    let nc = 1
-  contract C =
-    let cc = 2
-  ```
-- API functions for encoding/decoding Sophia values to/from FATE.
-### Removed
-- Remove the mapping from variables to FATE registers from the compilation output.
 ### Fixed
 - Warning about unused include when there is no include.
 
@@ -407,10 +387,7 @@ 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/v7.3.0...HEAD
+[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.1.0...HEAD
-[7.3.0]: https://github.com/aeternity/aesophia/compare/v7.2.1...v7.3.0
-[7.2.1]: https://github.com/aeternity/aesophia/compare/v7.2.0...v7.2.1
-[7.2.0]: https://github.com/aeternity/aesophia/compare/v7.1.0...v7.2.0
 [7.1.0]: https://github.com/aeternity/aesophia/compare/v7.0.1...v7.1.0
 [7.0.1]: https://github.com/aeternity/aesophia/compare/v7.0.0...v7.0.1
 [7.0.0]: https://github.com/aeternity/aesophia/compare/v6.1.0...v7.0.0

docs/aeso_compiler.md

@@ -53,6 +53,8 @@ The **pp_** options all print to standard output the following:
 
 The option `include_child_contract_symbols` includes the symbols of child contracts functions in the generated fate code. It is turned off by default to avoid making contracts bigger on chain.
 
+The option `debug_info` includes information related to debugging in the compiler output. Currently this option only includes the mapping from variables to registers.
+
 #### Options to control which compiler optimizations should run:
 
 By default all optimizations are turned on, to disable an optimization, it should be

docs/sophia_features.md

@@ -573,32 +573,6 @@ contract C =
 
 A hole expression found in the example above will generate the error `` Found a hole of type `(int) => int` ``. This says that the compiler expects a function from `int` to `int` in place of the `???` placeholder.
 
-## Constants
-
-Constants in Sophia are contract-level bindings that can be used in either contracts or namespaces. The value of a constant can be a literal, another constant, or arithmetic operations applied to other constants. Lists, tuples, maps, and records can also be used to define a constant as long as their elements are also constants.
-
-The following visibility rules apply to constants:
-*  Constants defined inside a contract are private in that contract. Thus, cannot be accessed through instances of their defining contract.
-* Constants defined inside a namespace are public. Thus, can be used in other contracts or namespaces.
-* Constants cannot be defined inside a contract interface.
-
-When a constant is shadowed, it can be accessed using its qualified name:
-
-```
-contract C =
-  let c = 1
-  entrypoint f() =
-    let c = 2
-    c + C.c  // the result is 3
-```
-
-The name of the constant must be an id; therefore, no pattern matching is allowed when defining a constant:
-
-```
-contract C
-  let x::y::_ = [1,2,3]  // this will result in an error
-```
-
 ## Arithmetic
 
 Sophia integers (`int`) are represented by arbitrary-sized signed words and support the following

docs/sophia_stdlib.md

@@ -190,7 +190,7 @@ using the private key of the `owner` account for signing.
 ##### update
 ```
 AENS.update(owner : address, name : string, expiry : option(Chain.ttl), client_ttl : option(int),
-            new_ptrs : option(map(string, AENS.pointee)), <signature : signature>) : unit
+            new_ptrs : map(string, AENS.pointee), <signature : signature>) : unit
 ```
 
 Updates the name. If the optional parameters are set to `None` that parameter
@@ -470,6 +470,38 @@ Chain.block_height : int"
 The height of the current block (i.e. the block in which the current call will be included).
 
 
+##### coinbase
+```
+Chain.coinbase : address
+```
+
+The address of the account that mined the current block.
+
+
+##### timestamp
+```
+Chain.timestamp : int
+```
+
+The timestamp of the current block (unix time, milliseconds).
+
+
+##### difficulty
+```
+Chain.difficulty : int
+```
+
+The difficulty of the current block.
+
+
+##### gas
+```
+Chain.gas_limit : int
+```
+
+The gas limit of the current block.
+
+
 ##### bytecode_hash
 ```
 Chain.bytecode_hash : 'c => option(hash)
@@ -533,7 +565,6 @@ main contract Market =
 The typechecker must be certain about the created contract's type, so it is
 worth writing it explicitly as shown in the example.
 
-
 ##### clone
 ```
 Chain.clone : ( ref : 'c, gas : int, value : int, protected : bool, ...
@@ -592,54 +623,11 @@ implementation of the `init` function does not actually return `state`, but
 calls `put` instead. Moreover, FATE prevents even handcrafted calls to `init`.
 
 
-##### coinbase
-```
-Chain.coinbase : address
-```
-
-The address of the account that mined the current block.
-
-
-##### difficulty
-```
-Chain.difficulty : int
-```
-
-The difficulty of the current block.
-
-
 ##### event
 ```
 Chain.event(e : event) : unit
 ```
-
+Emits the event. To use this function one needs to define the `event` type as a `datatype` in the contract.
-Emits the event. To use this function one needs to define the `event` type as a
-`datatype` in the contract.
-
-
-##### gas\_limit
-```
-Chain.gas_limit : int
-```
-
-The gas limit of the current block.
-
-
-##### spend
-```
-Chain.spend(to : address, amount : int) : unit
-```
-
-Spend `amount` tokens to `to`. Will fail (and abort the contract) if contract
-doesn't have `amount` tokens to transfer, or, if `to` is not `payable`.
-
-
-##### timestamp
-```
-Chain.timestamp : int
-```
-
-The timestamp of the current block (unix time, milliseconds).
 
 
 ### Char

docs/sophia_syntax.md

@@ -104,7 +104,6 @@ Implement ::= ':' Sep1(Con, ',')
 Decl ::= 'type'     Id ['(' TVar* ')'] '=' TypeAlias
        | 'record'   Id ['(' TVar* ')'] '=' RecordType
        | 'datatype' Id ['(' TVar* ')'] '=' DataType
-       | 'let'      Id [':' Type]      '=' Expr
        | (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
        | Using
 

rebar.config

@@ -2,7 +2,8 @@
 
 {erl_opts, [debug_info]}.
 
-{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.3.0"}}}
+{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {tag, "v3.2.0"}}}
+       , {getopt, "1.0.1"}
        , {eblake2, "1.0.0"}
        , {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}}
        ]}.
@@ -13,7 +14,7 @@
             {base_plt_apps, [erts, kernel, stdlib, crypto, mnesia]}
            ]}.
 
-{relx, [{release, {aesophia, "7.3.0"},
+{relx, [{release, {aesophia, "7.1.0"},
          [aesophia, aebytecode, getopt]},
 
         {dev_mode, true},

rebar.lock

@@ -1,11 +1,11 @@
 {"1.2.0",
 [{<<"aebytecode">>,
   {git,"https://github.com/aeternity/aebytecode.git",
-       {ref,"b38349274fc2bed98d7fe86877e6e1a2df302109"}},
+       {ref,"2a0a397afad6b45da52572170f718194018bf33c"}},
   0},
  {<<"aeserialization">>,
   {git,"https://github.com/aeternity/aeserialization.git",
-       {ref,"177bf604b2a05e940f92cf00e96e6e269e708245"}},
+       {ref,"eb68fe331bd476910394966b7f5ede7a74d37e35"}},
   1},
  {<<"base58">>,
   {git,"https://github.com/aeternity/erl-base58.git",
@@ -16,7 +16,7 @@
   {git,"https://github.com/aeternity/enacl.git",
        {ref,"793ddb502f7fe081302e1c42227dca70b09f8e17"}},
   2},
- {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},1},
+ {<<"getopt">>,{pkg,<<"getopt">>,<<"1.0.1">>},0},
  {<<"jsx">>,
   {git,"https://github.com/talentdeficit/jsx.git",
        {ref,"3074d4865b3385a050badf7828ad31490d860df5"}},

src/aeso_ast.erl

@@ -1,27 +0,0 @@
--module(aeso_ast).
-
--export([int/2,
-         line/1,
-         pp/1,
-         pp_typed/1,
-         symbol/2,
-         symbol_name/1
-        ]).
-
-
-symbol(Line, Chars) -> {symbol, Line, Chars}.
-int(Line, Int) -> {'Int', Line, Int}.
-
-line({symbol, Line, _}) -> Line.
-
-symbol_name({symbol, _, Name}) -> Name.
-
-pp(Ast) ->
-    String = prettypr:format(aeso_pretty:decls(Ast, [])),
-    io:format("Ast:\n~s\n", [String]).
-
-pp_typed(TypedAst) ->
-    %% io:format("Typed tree:\n~p\n",[TypedAst]),
-    String = prettypr:format(aeso_pretty:decls(TypedAst, [show_generated])),
-    io:format("Type ast:\n~s\n",[String]).
-

src/aeso_ast_code_analysis.erl

@@ -0,0 +1,154 @@
+-module(aeso_ast_code_analysis).
+
+
+all_warnings() ->
+    [ warn_unused_includes
+    , warn_unused_stateful
+    , warn_unused_variables
+    , warn_unused_typedefs
+    , warn_unused_return_value
+    , warn_unused_functions
+    , warn_shadowing
+    , warn_division_by_zero
+    , warn_negative_spend ].
+
+
+when_warning(Warn, Do) ->
+    case lists:member(Warn, all_warnings()) of
+        false ->
+            create_type_errors(),
+            type_error({unknown_warning, Warn}),
+            destroy_and_report_type_errors(global_env());
+        true ->
+            case ets_tab_exists(warnings) of
+                true ->
+                    IsEnabled = get_option(Warn, false),
+                    IsAll = get_option(warn_all, false) andalso lists:member(Warn, all_warnings()),
+                    if
+                        IsEnabled orelse IsAll -> Do();
+                        true -> ok
+                    end;
+                false ->
+                    ok
+            end
+    end.
+
+%% Warnings (Unused includes)
+
+potential_unused_include(Ann, SrcFile) ->
+    IsIncluded = aeso_syntax:get_ann(include_type, Ann, none) =/= none,
+    case IsIncluded of
+        false -> ok;
+        true  ->
+            case aeso_syntax:get_ann(file, Ann, no_file) of
+                no_file -> ok;
+                File    -> ets_insert(warnings, {unused_include, File, SrcFile})
+            end
+    end.
+
+used_include(Ann) ->
+    case aeso_syntax:get_ann(file, Ann, no_file) of
+        no_file -> ok;
+        File    -> ets_match_delete(warnings, {unused_include, File, '_'})
+    end.
+
+%% Warnings (Unused stateful)
+
+potential_unused_stateful(Ann, Fun) ->
+    case aeso_syntax:get_ann(stateful, Ann, false) of
+        false -> ok;
+        true  -> ets_insert(warnings, {unused_stateful, Ann, Fun})
+    end.
+
+used_stateful(Fun) ->
+    ets_match_delete(warnings, {unused_stateful, '_', Fun}).
+
+%% Warnings (Unused type defs)
+
+potential_unused_typedefs(Namespace, TypeDefs) ->
+    lists:map(fun({type_def, Ann, Id, Args, _}) ->
+        ets_insert(warnings, {unused_typedef, Ann, Namespace ++ qname(Id), length(Args)}) end, TypeDefs).
+
+used_typedef(TypeAliasId, Arity) ->
+    ets_match_delete(warnings, {unused_typedef, '_', qname(TypeAliasId), Arity}).
+
+%% Warnings (Unused variables)
+
+potential_unused_variables(Namespace, Fun, Vars0) ->
+    Vars = [ Var || Var = {id, _, VarName} <- Vars0, VarName /= "_" ],
+    lists:map(fun({id, Ann, VarName}) ->
+        ets_insert(warnings, {unused_variable, Ann, Namespace, Fun, VarName}) end, Vars).
+
+used_variable(Namespace, Fun, [VarName]) ->
+    ets_match_delete(warnings, {unused_variable, '_', Namespace, Fun, VarName});
+used_variable(_, _, _) -> ok.
+
+%% Warnings (Unused return value)
+
+potential_unused_return_value({typed, Ann, {app, _, {typed, _, _, {fun_t, _, _, _, {id, _, Type}}}, _}, _}) when Type /= "unit" ->
+    ets_insert(warnings, {unused_return_value, Ann});
+potential_unused_return_value(_) -> ok.
+
+%% Warnings (Unused functions)
+
+create_unused_functions() ->
+    ets_new(function_calls, [bag]),
+    ets_new(all_functions, [set]).
+
+register_function_call(Caller, Callee) ->
+    ets_insert(function_calls, {Caller, Callee}).
+
+potential_unused_function(#env{ what = namespace }, Ann, FunQName, FunId) ->
+    ets_insert(all_functions, {Ann, FunQName, FunId, not aeso_syntax:get_ann(private, Ann, false)});
+potential_unused_function(_Env, Ann, FunQName, FunId) ->
+    ets_insert(all_functions, {Ann, FunQName, FunId, aeso_syntax:get_ann(entrypoint, Ann, false)}).
+
+remove_used_funs(All) ->
+    {Used, Unused} = lists:partition(fun({_, _, _, IsUsed}) -> IsUsed end, All),
+    CallsByUsed = lists:flatmap(fun({_, F, _, _}) -> ets_lookup(function_calls, F) end, Used),
+    CalledFuns = sets:from_list(lists:map(fun({_, Callee}) -> Callee end, CallsByUsed)),
+    MarkUsedFun = fun(Fun, Acc) ->
+                      case lists:keyfind(Fun, 2, Acc) of
+                          false -> Acc;
+                          T     -> lists:keyreplace(Fun, 2, Acc, setelement(4, T, true))
+                      end
+                  end,
+    NewUnused = sets:fold(MarkUsedFun, Unused, CalledFuns),
+    case lists:keyfind(true, 4, NewUnused) of
+        false -> NewUnused;
+        _     -> remove_used_funs(NewUnused)
+    end.
+
+destroy_and_report_unused_functions() ->
+    AllFuns = ets_tab2list(all_functions),
+    lists:map(fun({Ann, _, FunId, _}) -> ets_insert(warnings, {unused_function, Ann, name(FunId)}) end,
+              remove_used_funs(AllFuns)),
+    ets_delete(all_functions),
+    ets_delete(function_calls).
+
+%% Warnings (Shadowing)
+
+warn_potential_shadowing(_, "_", _) -> ok;
+warn_potential_shadowing(Ann, Name, Vars) ->
+    case proplists:get_value(Name, Vars, false) of
+        false -> ok;
+        {AnnOld, _} -> ets_insert(warnings, {shadowing, Ann, Name, AnnOld})
+    end.
+
+%% Warnings (Division by zero)
+
+warn_potential_division_by_zero(Ann, Op, Args) ->
+    case {Op, Args} of
+        {{'/', _}, [_, {int, _, 0}]} -> ets_insert(warnings, {division_by_zero, Ann});
+        _ -> ok
+    end.
+
+%% Warnings (Negative spends)
+
+warn_potential_negative_spend(Ann, Fun, Args) ->
+    case {Fun, Args} of
+        { {typed, _, {qid, _, ["Chain", "spend"]}, _}
+        , [_, {typed, _, {app, _, {'-', _}, [{typed, _, {int, _, X}, _}]}, _}]} when X > 0 ->
+            ets_insert(warnings, {negative_spend, Ann});
+        _ -> ok
+    end.

src/aeso_ast_types_errors.erl

@@ -0,0 +1,721 @@
+-module(aeso_ast_types_errors).
+
+
+cannot_unify(A, B, Cxt, When) ->
+    type_error({cannot_unify, A, B, Cxt, When}).
+
+
+type_error(Err) ->
+    ets_insert(type_errors, Err).
+
+
+mk_t_err(Pos, Msg) ->
+    aeso_errors:new(type_error, Pos, lists:flatten(Msg)).
+mk_t_err(Pos, Msg, Ctxt) ->
+    aeso_errors:new(type_error, Pos, lists:flatten(Msg), lists:flatten(Ctxt)).
+
+mk_t_err_from_warn(Warn) ->
+    aeso_warnings:warn_to_err(type_error, Warn).
+
+mk_error({no_decls, File}) ->
+    Pos = aeso_errors:pos(File, 0, 0),
+    mk_t_err(Pos, "Empty contract");
+mk_error({mismatched_decl_in_funblock, Name, Decl}) ->
+    Msg = io_lib:format("Mismatch in the function block. Expected implementation/type declaration of ~s function", [Name]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({higher_kinded_typevar, T}) ->
+    Msg = io_lib:format("Type `~s` is a higher kinded type variable "
+                        "(takes another type as an argument)", [pp(instantiate(T))]
+                       ),
+    mk_t_err(pos(T), Msg);
+mk_error({wrong_type_arguments, X, ArityGiven, ArityReal}) ->
+    Msg = io_lib:format("Arity for ~s doesn't match. Expected ~p, got ~p"
+                       , [pp(instantiate(X)), ArityReal, ArityGiven]
+                       ),
+    mk_t_err(pos(X), Msg);
+mk_error({unnamed_map_update_with_default, Upd}) ->
+    Msg = "Invalid map update with default",
+    mk_t_err(pos(Upd), Msg);
+mk_error({fundecl_must_have_funtype, _Ann, Id, Type}) ->
+    Msg = io_lib:format("`~s` was declared with an invalid type `~s`. "
+                       "Entrypoints and functions must have functional types"
+                       , [pp(Id), pp(instantiate(Type))]),
+    mk_t_err(pos(Id), Msg);
+mk_error({cannot_unify, A, B, Cxt, When}) ->
+    VarianceContext = case Cxt of
+                          none -> "";
+                          _    -> io_lib:format(" in a ~p context", [Cxt])
+                      end,
+    Msg = io_lib:format("Cannot unify `~s` and `~s`" ++ VarianceContext,
+                        [pp(instantiate(A)), pp(instantiate(B))]),
+    {Pos, Ctxt} = pp_when(When),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({hole_found, Ann, Type}) ->
+    Msg = io_lib:format("Found a hole of type `~s`", [pp(instantiate(Type))]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({unbound_variable, Id}) ->
+    Msg = io_lib:format("Unbound variable `~s`", [pp(Id)]),
+    case Id of
+        {qid, _, ["Chain", "event"]} ->
+            Cxt = "Did you forget to define the event type?",
+            mk_t_err(pos(Id), Msg, Cxt);
+        _ -> mk_t_err(pos(Id), Msg)
+    end;
+mk_error({undefined_field, Id}) ->
+    Msg = io_lib:format("Unbound field ~s", [pp(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({not_a_record_type, Type, Why}) ->
+    Msg = io_lib:format("Not a record type: `~s`", [pp_type(Type)]),
+    {Pos, Ctxt} = pp_why_record(Why),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({not_a_contract_type, Type, Cxt}) ->
+    Msg =
+        case Type of
+            {tvar, _, _} ->
+                "Unresolved contract type";
+            _ ->
+                io_lib:format("The type `~s` is not a contract type", [pp_type(Type)])
+        end,
+    {Pos, Cxt1} =
+        case Cxt of
+            {var_args, Ann, Fun} ->
+                {pos(Ann),
+                 io_lib:format("when calling variadic function `~s`", [pp_expr(Fun)])};
+            {contract_literal, Lit} ->
+                {pos(Lit),
+                 io_lib:format("when checking that the contract literal `~s` has the type `~s`",
+                               [pp_expr(Lit), pp_type(Type)])};
+            {address_to_contract, Ann} ->
+                {pos(Ann),
+                 io_lib:format("when checking that the call to `Address.to_contract` has the type `~s`",
+                               [pp_type(Type)])}
+        end,
+    mk_t_err(Pos, Msg, Cxt1);
+mk_error({non_linear_pattern, Pattern, Nonlinear}) ->
+    Msg = io_lib:format("Repeated name~s ~s in the pattern `~s`",
+                        [plural("", "s", Nonlinear),
+                         string:join(lists:map(fun(F) -> "`" ++ F ++ "`" end, Nonlinear), ", "),
+                         pp_expr(Pattern)]),
+    mk_t_err(pos(Pattern), Msg);
+mk_error({ambiguous_record, Fields = [{_, First} | _], Candidates}) ->
+    Msg = io_lib:format("Ambiguous record type with field~s ~s could be one of~s",
+                        [plural("", "s", Fields),
+                         string:join([ "`" ++ pp(F) ++ "`" || {_, F} <- Fields ], ", "),
+                         [ ["\n  - ", "`" ++ pp(C) ++ "`", " (at ", pp_loc(C), ")"] || C <- Candidates ]]),
+    mk_t_err(pos(First), Msg);
+mk_error({missing_field, Field, Rec}) ->
+    Msg = io_lib:format("Record type `~s` does not have field `~s`",
+                        [pp(Rec), pp(Field)]),
+    mk_t_err(pos(Field), Msg);
+mk_error({missing_fields, Ann, RecType, Fields}) ->
+    Msg = io_lib:format("The field~s ~s ~s missing when constructing an element of type `~s`",
+                        [plural("", "s", Fields),
+                         string:join(lists:map(fun(F) -> "`" ++ F ++ "`" end, Fields), ", "),
+                         plural("is", "are", Fields), pp(RecType)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({no_records_with_all_fields, Fields = [{_, First} | _]}) ->
+    Msg = io_lib:format("No record type with field~s ~s",
+                        [plural("", "s", Fields),
+                         string:join([ "`" ++ pp(F) ++ "`" || {_, F} <- Fields ], ", ")]),
+    mk_t_err(pos(First), Msg);
+mk_error({recursive_types_not_implemented, Types}) ->
+    S = plural(" is", "s are mutually", Types),
+    Msg = io_lib:format("The following type~s recursive, which is not yet supported:~s",
+                        [S, [io_lib:format("\n  - `~s` (at ~s)", [pp(T), pp_loc(T)]) || T <- Types]]),
+    mk_t_err(pos(hd(Types)), Msg);
+mk_error({event_must_be_variant_type, Where}) ->
+    Msg = io_lib:format("The event type must be a variant type", []),
+    mk_t_err(pos(Where), Msg);
+mk_error({indexed_type_must_be_word, Type, Type}) ->
+    Msg = io_lib:format("The indexed type `~s` is not a word type",
+                        [pp_type(Type)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({indexed_type_must_be_word, Type, Type1}) ->
+    Msg = io_lib:format("The indexed type `~s` equals `~s` which is not a word type",
+                        [pp_type(Type), pp_type(Type1)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({event_0_to_3_indexed_values, Constr}) ->
+    Msg = io_lib:format("The event constructor `~s` has too many indexed values (max 3)",
+                        [name(Constr)]),
+    mk_t_err(pos(Constr), Msg);
+mk_error({event_0_to_1_string_values, Constr}) ->
+    Msg = io_lib:format("The event constructor `~s` has too many non-indexed values (max 1)",
+                        [name(Constr)]),
+    mk_t_err(pos(Constr), Msg);
+mk_error({repeated_constructor, Cs}) ->
+    Msg = io_lib:format("Variant types must have distinct constructor names~s",
+                        [[ io_lib:format("\n`~s`  (at ~s)", [pp_typed("  - ", C, T), pp_loc(C)]) || {C, T} <- Cs ]]),
+    mk_t_err(pos(element(1, hd(Cs))), Msg);
+mk_error({bad_named_argument, [], Name}) ->
+    Msg = io_lib:format("Named argument ~s supplied to function expecting no named arguments.",
+                        [pp(Name)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({bad_named_argument, Args, Name}) ->
+    Msg = io_lib:format("Named argument `~s` is not one of the expected named arguments~s",
+                        [pp(Name),
+                        [ io_lib:format("\n  - `~s`", [pp_typed("", Arg, Type)])
+                          || {named_arg_t, _, Arg, Type, _} <- Args ]]),
+    mk_t_err(pos(Name), Msg);
+mk_error({unsolved_named_argument_constraint, #named_argument_constraint{name = Name, type = Type}}) ->
+    Msg = io_lib:format("Named argument ~s supplied to function with unknown named arguments.",
+                        [pp_typed("", Name, Type)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({reserved_entrypoint, Name, Def}) ->
+    Msg = io_lib:format("The name '~s' is reserved and cannot be used for a "
+                        "top-level contract function.", [Name]),
+    mk_t_err(pos(Def), Msg);
+mk_error({duplicate_definition, Name, Locs}) ->
+    Msg = io_lib:format("Duplicate definitions of `~s` at~s",
+                        [Name, [ ["\n  - ", pp_loc(L)] || L <- Locs ]]),
+    mk_t_err(pos(lists:last(Locs)), Msg);
+mk_error({duplicate_scope, Kind, Name, OtherKind, L}) ->
+    Msg = io_lib:format("The ~p `~s` has the same name as a ~p at ~s",
+                        [Kind, pp(Name), OtherKind, pp_loc(L)]),
+    mk_t_err(pos(Name), Msg);
+mk_error({include, _, {string, Pos, Name}}) ->
+    Msg = io_lib:format("Include of `~s` is not allowed, include only allowed at top level.",
+                        [binary_to_list(Name)]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({namespace, _Pos, {con, Pos, Name}, _Def}) ->
+    Msg = io_lib:format("Nested namespaces are not allowed. Namespace `~s` is not defined at top level.",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({Contract, _Pos, {con, Pos, Name}, _Impls, _Def}) when ?IS_CONTRACT_HEAD(Contract) ->
+    Msg = io_lib:format("Nested contracts are not allowed. Contract `~s` is not defined at top level.",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({type_decl, _, {id, Pos, Name}, _}) ->
+    Msg = io_lib:format("Empty type declarations are not supported. Type `~s` lacks a definition",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({letval, _Pos, {id, Pos, Name}, _Def}) ->
+    Msg = io_lib:format("Toplevel \"let\" definitions are not supported. Value `~s` could be replaced by 0-argument function.",
+                        [Name]),
+    mk_t_err(pos(Pos), Msg);
+mk_error({stateful_not_allowed, Id, Fun}) ->
+    Msg = io_lib:format("Cannot reference stateful function `~s` in the definition of non-stateful function `~s`.",
+                        [pp(Id), pp(Fun)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({stateful_not_allowed_in_guards, Id}) ->
+    Msg = io_lib:format("Cannot reference stateful function `~s` in a pattern guard.",
+                        [pp(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({value_arg_not_allowed, Value, Fun}) ->
+    Msg = io_lib:format("Cannot pass non-zero value argument `~s` in the definition of non-stateful function `~s`.",
+                        [pp_expr(Value), pp(Fun)]),
+    mk_t_err(pos(Value), Msg);
+mk_error({init_depends_on_state, Which, [_Init | Chain]}) ->
+    WhichCalls = fun("put") -> ""; ("state") -> ""; (_) -> ", which calls" end,
+    Msg = io_lib:format("The `init` function should return the initial state as its result and cannot ~s the state, but it calls~s",
+                        [if Which == put -> "write"; true -> "read" end,
+                         [ io_lib:format("\n  - `~s` (at ~s)~s", [Fun, pp_loc(Ann), WhichCalls(Fun)])
+                           || {[_, Fun], Ann} <- Chain]]),
+    mk_t_err(pos(element(2, hd(Chain))), Msg);
+mk_error({missing_body_for_let, Ann}) ->
+    Msg = io_lib:format("Let binding must be followed by an expression.", []),
+    mk_t_err(pos(Ann), Msg);
+mk_error({public_modifier_in_contract, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("Use `entrypoint` instead of `function` for public function `~s`: `~s`",
+                        [pp_expr(element(3, Decl)),
+                         prettypr:format(aeso_pretty:decl(Decl1))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({init_must_be_an_entrypoint, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("The init function must be an entrypoint: ~s",
+                        [prettypr:format(prettypr:nest(2, aeso_pretty:decl(Decl1)))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({init_must_not_be_payable, Decl}) ->
+    Msg = io_lib:format("The init function cannot be payable. "
+                        "You don't need the 'payable' annotation to be able to attach "
+                        "funds to the create contract transaction.",
+                        []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({proto_must_be_entrypoint, Decl}) ->
+    Decl1 = mk_entrypoint(Decl),
+    Msg = io_lib:format("Use `entrypoint` for declaration of `~s`: `~s`",
+                        [pp_expr(element(3, Decl)),
+                         prettypr:format(aeso_pretty:decl(Decl1))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({proto_in_namespace, Decl}) ->
+    Msg = io_lib:format("Namespaces cannot contain function prototypes.", []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({entrypoint_in_namespace, Decl}) ->
+    Msg = io_lib:format("Namespaces cannot contain entrypoints. Use `function` instead.", []),
+    mk_t_err(pos(Decl), Msg);
+mk_error({private_entrypoint, Decl}) ->
+    Msg = io_lib:format("The entrypoint `~s` cannot be private. Use `function` instead.",
+                        [pp_expr(element(3, Decl))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({private_and_public, Decl}) ->
+    Msg = io_lib:format("The function `~s` cannot be both public and private.",
+                        [pp_expr(element(3, Decl))]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({contract_has_no_entrypoints, Con}) ->
+    Msg = io_lib:format("The contract `~s` has no entrypoints. Since Sophia version 3.2, public "
+                        "contract functions must be declared with the `entrypoint` keyword instead of "
+                        "`function`.", [pp_expr(Con)]),
+    mk_t_err(pos(Con), Msg);
+mk_error({definition_in_contract_interface, Ann, {id, _, Id}}) ->
+    Msg = "Contract interfaces cannot contain defined functions or entrypoints.",
+    Cxt = io_lib:format("Fix: replace the definition of `~s` by a type signature.", [Id]),
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({unbound_type, Type}) ->
+    Msg = io_lib:format("Unbound type ~s.", [pp_type(Type)]),
+    mk_t_err(pos(Type), Msg);
+mk_error({new_tuple_syntax, Ann, Ts}) ->
+    Msg = io_lib:format("Invalid type `~s`. The syntax of tuple types changed in Sophia version 4.0. Did you mean `~s`",
+                        [pp_type({args_t, Ann, Ts}), pp_type({tuple_t, Ann, Ts})]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({map_in_map_key, Ann, KeyType}) ->
+    Msg = io_lib:format("Invalid key type `~s`", [pp_type(KeyType)]),
+    Cxt = "Map keys cannot contain other maps.",
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({cannot_call_init_function, Ann}) ->
+    Msg = "The 'init' function is called exclusively by the create contract transaction "
+          "and cannot be called from the contract code.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({contract_treated_as_namespace, Ann, [Con, Fun] = QName}) ->
+    Msg = io_lib:format("Invalid call to contract entrypoint `~s`.", [string:join(QName, ".")]),
+    Cxt = io_lib:format("It must be called as `c.~s` for some `c : ~s`.", [Fun, Con]),
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({bad_top_level_decl, Decl}) ->
+    What = case element(1, Decl) of
+               letval -> "function or entrypoint";
+               _      -> "contract or namespace"
+           end,
+    Id = element(3, Decl),
+    Msg = io_lib:format("The definition of '~s' must appear inside a ~s.",
+                        [pp_expr(Id), What]),
+    mk_t_err(pos(Decl), Msg);
+mk_error({unknown_byte_length, Type}) ->
+    Msg = io_lib:format("Cannot resolve length of byte array.", []),
+    mk_t_err(pos(Type), Msg);
+mk_error({unsolved_bytes_constraint, Ann, concat, A, B, C}) ->
+    Msg = io_lib:format("Failed to resolve byte array lengths in call to Bytes.concat with arguments of type\n"
+                        "~s  (at ~s)\n~s  (at ~s)\nand result type\n~s  (at ~s)",
+                        [pp_type("  - ", A), pp_loc(A), pp_type("  - ", B),
+                         pp_loc(B), pp_type("  - ", C), pp_loc(C)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({unsolved_bytes_constraint, Ann, split, A, B, C}) ->
+    Msg = io_lib:format("Failed to resolve byte array lengths in call to Bytes.split with argument of type\n"
+                        "~s  (at ~s)\nand result types\n~s  (at ~s)\n~s  (at ~s)",
+                        [ pp_type("  - ", C), pp_loc(C), pp_type("  - ", A), pp_loc(A),
+                          pp_type("  - ", B), pp_loc(B)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({failed_to_get_compiler_version, Err}) ->
+    Msg = io_lib:format("Failed to get compiler version. Error: ~p", [Err]),
+    mk_t_err(pos(0, 0), Msg);
+mk_error({compiler_version_mismatch, Ann, Version, Op, Bound}) ->
+    PrintV = fun(V) -> string:join([integer_to_list(N) || N <- V], ".") end,
+    Msg = io_lib:format("Cannot compile with this version of the compiler, "
+                        "because it does not satisfy the constraint"
+                        " ~s ~s ~s", [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 `~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 `~s`", [pp_expr(Expr)]),
+    mk_t_err(pos(Expr), Msg);
+mk_error({named_argument_must_be_literal_bool, Name, Arg}) ->
+    Msg = io_lib:format("Invalid `~s` argument `~s`. "
+                        "It must be either `true` or `false`.",
+                        [Name, pp_expr(instantiate(Arg))]),
+    mk_t_err(pos(Arg), Msg);
+mk_error({conflicting_updates_for_field, Upd, Key}) ->
+    Msg = io_lib:format("Conflicting updates for field '~s'", [Key]),
+    mk_t_err(pos(Upd), Msg);
+mk_error({ambiguous_main_contract, Ann}) ->
+    Msg = "Could not deduce the main contract. You can point it out manually with the `main` keyword.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({main_contract_undefined, Ann}) ->
+    Msg = "No contract defined.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({multiple_main_contracts, Ann}) ->
+    Msg = "Only one main contract can be defined.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({unify_varargs, When}) ->
+    Msg = "Cannot infer types for variable argument list.",
+    {Pos, Ctxt} = pp_when(When),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({clone_no_contract, Ann}) ->
+    Msg = "Chain.clone requires `ref` named argument of contract type.",
+    mk_t_err(pos(Ann), Msg);
+mk_error({contract_lacks_definition, Type, When}) ->
+    Msg = io_lib:format(
+            "~s is not implemented.",
+            [pp_type(Type)]
+           ),
+    {Pos, Ctxt} = pp_when(When),
+    mk_t_err(Pos, Msg, Ctxt);
+mk_error({ambiguous_name, Name, QIds}) ->
+    Msg = io_lib:format("Ambiguous name `~s` could be one of~s",
+                        [pp(Name),
+                         [io_lib:format("\n  - `~s` (at ~s)", [pp(QId), pp_loc(QId)]) || QId <- QIds]]),
+    mk_t_err(pos(Name), Msg);
+mk_error({using_undefined_namespace, Ann, Namespace}) ->
+    Msg = io_lib:format("Cannot use undefined namespace ~s", [Namespace]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({using_undefined_namespace_parts, Ann, Namespace, Parts}) ->
+    PartsStr = lists:concat(lists:join(", ", Parts)),
+    Msg = io_lib:format("The namespace ~s does not define the following names: ~s", [Namespace, PartsStr]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({unknown_warning, Warning}) ->
+    Msg = io_lib:format("Trying to report unknown warning: ~p", [Warning]),
+    mk_t_err(pos(0, 0), Msg);
+mk_error({empty_record_definition, Ann, Name}) ->
+    Msg = io_lib:format("Empty record definitions are not allowed. Cannot define the record `~s`", [Name]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({unimplemented_interface_function, ConId, InterfaceName, FunName}) ->
+    Msg = io_lib:format("Unimplemented entrypoint `~s` from the interface `~s` in the contract `~s`", [FunName, InterfaceName, pp(ConId)]),
+    mk_t_err(pos(ConId), Msg);
+mk_error({referencing_undefined_interface, InterfaceId}) ->
+    Msg = io_lib:format("Trying to implement or extend an undefined interface `~s`", [pp(InterfaceId)]),
+    mk_t_err(pos(InterfaceId), Msg);
+mk_error({missing_definition, Id}) ->
+    Msg = io_lib:format("Missing definition of function `~s`", [name(Id)]),
+    mk_t_err(pos(Id), Msg);
+mk_error({parameterized_state, Ann}) ->
+    Msg = "The state type cannot be parameterized",
+    mk_t_err(pos(Ann), Msg);
+mk_error({parameterized_event, Ann}) ->
+    Msg = "The event type cannot be parameterized",
+    mk_t_err(pos(Ann), Msg);
+mk_error({missing_init_function, Con}) ->
+    Msg = io_lib:format("Missing `init` function for the contract `~s`.", [name(Con)]),
+    Cxt = "The `init` function can only be omitted if the state type is `unit`",
+    mk_t_err(pos(Con), Msg, Cxt);
+mk_error({higher_order_entrypoint, Ann, {id, _, Name}, Thing}) ->
+    What = "higher-order (contains function types)",
+    ThingS = case Thing of
+                 {argument, X, T} -> io_lib:format("argument\n~s`\n", [pp_typed("  `", X, T)]);
+                 {result, T}      -> io_lib:format("return type\n~s`\n", [pp_type("  `", T)])
+             end,
+    Bad = case Thing of
+              {argument, _, _} -> io_lib:format("has a ~s type", [What]);
+              {result, _}      -> io_lib:format("is ~s", [What])
+          end,
+    Msg = io_lib:format("The ~sof entrypoint `~s` ~s",
+                        [ThingS, Name, Bad]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({invalid_aens_resolve_type, Ann, T}) ->
+    Msg = io_lib:format("Invalid return type of `AENS.resolve`:\n"
+                        "~s`\n"
+                        "It must be a `string` or a pubkey type (`address`, `oracle`, etc)",
+                        [pp_type("  `", T)]),
+    mk_t_err(pos(Ann), Msg);
+mk_error({invalid_oracle_type, Why, What, Ann, Type}) ->
+    WhyS = case Why of higher_order -> "higher-order (contain function types)";
+                       polymorphic  -> "polymorphic (contain type variables)" end,
+    Msg = io_lib:format("Invalid oracle type\n~s`", [pp_type("  `", Type)]),
+    Cxt = io_lib:format("The ~s type must not be ~s", [What, WhyS]),
+    mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({interface_implementation_conflict, Contract, I1, I2, Fun}) ->
+    Msg = io_lib:format("Both interfaces `~s` and `~s` implemented by "
+                        "the contract `~s` have a function called `~s`",
+                        [name(I1), name(I2), name(Contract), name(Fun)]),
+    mk_t_err(pos(Contract), Msg);
+mk_error({function_should_be_entrypoint, Impl, Base, Interface}) ->
+    Msg = io_lib:format("`~s` must be declared as an entrypoint instead of a function "
+                        "in order to implement the entrypoint `~s` from the interface `~s`",
+                        [name(Impl), name(Base), name(Interface)]),
+    mk_t_err(pos(Impl), Msg);
+mk_error({entrypoint_cannot_be_stateful, Impl, Base, Interface}) ->
+    Msg = io_lib:format("`~s` cannot be stateful because the entrypoint `~s` in the "
+                        "interface `~s` is not stateful",
+                        [name(Impl), name(Base), name(Interface)]),
+    mk_t_err(pos(Impl), Msg);
+mk_error({entrypoint_must_be_payable, Impl, Base, Interface}) ->
+    Msg = io_lib:format("`~s` must be payable because the entrypoint `~s` in the "
+                        "interface `~s` is payable",
+                        [name(Impl), name(Base), name(Interface)]),
+    mk_t_err(pos(Impl), Msg);
+mk_error({unpreserved_payablity, Kind, ContractCon, InterfaceCon}) ->
+    KindStr = case Kind of
+                  contract -> "contract";
+                  contract_interface -> "interface"
+              end,
+    Msg = io_lib:format("Non-payable ~s `~s` cannot implement payable interface `~s`",
+                        [KindStr, name(ContractCon), name(InterfaceCon)]),
+    mk_t_err(pos(ContractCon), Msg);
+mk_error(Err) ->
+    Msg = io_lib:format("Unknown error: ~p", [Err]),
+    mk_t_err(pos(0, 0), Msg).
+
+mk_warning({unused_include, FileName, SrcFile}) ->
+    Msg = io_lib:format("The file `~s` is included but not used.", [FileName]),
+    aeso_warnings:new(aeso_errors:pos(SrcFile, 0, 0), Msg);
+mk_warning({unused_stateful, Ann, FunName}) ->
+    Msg = io_lib:format("The function `~s` is unnecessarily marked as stateful.", [name(FunName)]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({unused_variable, Ann, _Namespace, _Fun, VarName}) ->
+    Msg = io_lib:format("The variable `~s` is defined but never used.", [VarName]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({unused_typedef, Ann, QName, _Arity}) ->
+    Msg = io_lib:format("The type `~s` is defined but never used.", [lists:last(QName)]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({unused_return_value, Ann}) ->
+    Msg = io_lib:format("Unused return value.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({unused_function, Ann, FunName}) ->
+    Msg = io_lib:format("The function `~s` is defined but never used.", [FunName]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({shadowing, Ann, VarName, AnnOld}) ->
+    Msg = io_lib:format("The definition of `~s` shadows an older definition at ~s.", [VarName, pp_loc(AnnOld)]),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({division_by_zero, Ann}) ->
+    Msg = io_lib:format("Division by zero.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning({negative_spend, Ann}) ->
+    Msg = io_lib:format("Negative spend.", []),
+    aeso_warnings:new(pos(Ann), Msg);
+mk_warning(Warn) ->
+    Msg = io_lib:format("Unknown warning: ~p", [Warn]),
+    aeso_warnings:new(Msg).
+
+mk_entrypoint(Decl) ->
+    Ann   = [entrypoint | lists:keydelete(public, 1,
+                          lists:keydelete(private, 1,
+                            aeso_syntax:get_ann(Decl))) -- [public, private]],
+    aeso_syntax:set_ann(Ann, Decl).
+
+pp_when({todo, What}) -> {pos(0, 0), io_lib:format("[TODO] ~p", [What])};
+pp_when({at, Ann}) -> {pos(Ann), io_lib:format("at ~s", [pp_loc(Ann)])};
+pp_when({check_typesig, Name, Inferred, Given}) ->
+    {pos(Given),
+     io_lib:format("when checking the definition of `~s`\n"
+                   "  inferred type: `~s`\n"
+                   "  given type:    `~s`",
+         [Name, pp(instantiate(Inferred)), pp(instantiate(Given))])};
+pp_when({infer_app, Fun, NamedArgs, Args, Inferred0, ArgTypes0}) ->
+    Inferred = instantiate(Inferred0),
+    ArgTypes = instantiate(ArgTypes0),
+    {pos(Fun),
+     io_lib:format("when checking the application of\n"
+                   "  `~s`\n"
+                   "to arguments~s",
+                   [pp_typed("", Fun, Inferred),
+                    [ ["\n  ", "`" ++ pp_expr(NamedArg) ++ "`"] || NamedArg <- NamedArgs ] ++
+                    [ ["\n  ", "`" ++ pp_typed("", Arg, ArgT) ++ "`"]
+                       || {Arg, ArgT} <- lists:zip(Args, ArgTypes) ] ])};
+pp_when({field_constraint, FieldType0, InferredType0, Fld}) ->
+    FieldType    = instantiate(FieldType0),
+    InferredType = instantiate(InferredType0),
+    {pos(Fld),
+     case Fld of
+         {var_args, _Ann, _Fun} ->
+             io_lib:format("when checking contract construction of type\n~s (at ~s)\nagainst the expected type\n~s\n",
+                          [pp_type("  ", FieldType),
+                           pp_loc(Fld),
+                           pp_type("  ", InferredType)
+                          ]);
+         {field, _Ann, LV, Id, E} ->
+             io_lib:format("when checking the assignment of the field `~s` to the old value `~s` and the new value `~s`",
+                 [pp_typed("", {lvalue, [], LV}, FieldType),
+                  pp(Id),
+                  pp_typed("", E, InferredType)]);
+         {field, _Ann, LV, E} ->
+             io_lib:format("when checking the assignment of the field `~s` to the value `~s`",
+                 [pp_typed("", {lvalue, [], LV}, FieldType),
+                  pp_typed("", E, InferredType)]);
+         {proj, _Ann, _Rec, _Fld} ->
+             io_lib:format("when checking the record projection `~s` against the expected type `~s`",
+                 [pp_typed("  ", Fld, FieldType),
+                  pp_type("  ", InferredType)])
+     end};
+pp_when({record_constraint, RecType0, InferredType0, Fld}) ->
+    RecType      = instantiate(RecType0),
+    InferredType = instantiate(InferredType0),
+    {Pos, WhyRec} = pp_why_record(Fld),
+    case Fld of
+        {var_args, _Ann, _Fun} ->
+            {Pos,
+             io_lib:format("when checking that contract construction of type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                           [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)]
+                          )
+            };
+        {field, _Ann, _LV, _Id, _E} ->
+            {Pos,
+             io_lib:format("when checking that the record type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                 [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)])};
+        {field, _Ann, _LV, _E} ->
+            {Pos,
+             io_lib:format("when checking that the record type\n~s\n~s\n"
+                           "matches the expected type\n~s",
+                 [pp_type("  ", RecType), WhyRec, pp_type("  ", InferredType)])};
+        {proj, _Ann, Rec, _FldName} ->
+            {pos(Rec),
+             io_lib:format("when checking that the expression\n~s (at ~s)\nhas type\n~s\n~s",
+                 [pp_typed("  ", Rec, InferredType), pp_loc(Rec),
+                  pp_type("  ", RecType), WhyRec])}
+    end;
+pp_when({if_branches, Then, ThenType0, Else, ElseType0}) ->
+    {ThenType, ElseType} = instantiate({ThenType0, ElseType0}),
+    Branches = [ {Then, ThenType} | [ {B, ElseType} || B <- if_branches(Else) ] ],
+    {pos(element(1, hd(Branches))),
+     io_lib:format("when comparing the types of the if-branches\n"
+                   "~s", [ [ io_lib:format("~s (at ~s)\n", [pp_typed("  - ", B, BType), pp_loc(B)])
+                           || {B, BType} <- Branches ] ])};
+pp_when({case_pat, Pat, PatType0, ExprType0}) ->
+    {PatType, ExprType} = instantiate({PatType0, ExprType0}),
+    {pos(Pat),
+     io_lib:format("when checking the type of the pattern `~s` against the expected type `~s`",
+                   [pp_typed("", Pat, PatType),
+                    pp_type(ExprType)])};
+pp_when({check_expr, Expr, Inferred0, Expected0}) ->
+    {Inferred, Expected} = instantiate({Inferred0, Expected0}),
+    {pos(Expr),
+     io_lib:format("when checking the type of the expression `~s` against the expected type `~s`",
+                   [pp_typed("", Expr, Inferred), pp_type(Expected)])};
+pp_when({checking_init_type, Ann}) ->
+    {pos(Ann),
+     io_lib:format("when checking that `init` returns a value of type `state`", [])};
+pp_when({list_comp, BindExpr, Inferred0, Expected0}) ->
+    {Inferred, Expected} = instantiate({Inferred0, Expected0}),
+    {pos(BindExpr),
+     io_lib:format("when checking rvalue of list comprehension binding `~s` against type `~s`",
+                   [pp_typed("", BindExpr, Inferred), pp_type(Expected)])};
+pp_when({check_named_arg_constraint, C}) ->
+    {id, _, Name} = Arg = C#named_argument_constraint.name,
+    [Type | _] = [ Type || {named_arg_t, _, {id, _, Name1}, Type, _} <- C#named_argument_constraint.args, Name1 == Name ],
+    Err = io_lib:format("when checking named argument `~s` against inferred type `~s`",
+                        [pp_typed("", Arg, Type), pp_type(C#named_argument_constraint.type)]),
+    {pos(Arg), Err};
+pp_when({checking_init_args, Ann, Con0, ArgTypes0}) ->
+    Con = instantiate(Con0),
+    ArgTypes = instantiate(ArgTypes0),
+    {pos(Ann),
+     io_lib:format("when checking arguments of `~s`'s init entrypoint to match\n(~s)",
+                   [pp_type(Con), string:join([pp_type(A) || A <- ArgTypes], ", ")])
+    };
+pp_when({return_contract, App, Con0}) ->
+    Con = instantiate(Con0),
+    {pos(App)
+    , io_lib:format("when checking that expression returns contract of type `~s`", [pp_type(Con)])
+    };
+pp_when({arg_name, Id1, Id2, When}) ->
+    {Pos, Ctx} = pp_when(When),
+    {Pos
+    , io_lib:format("when unifying names of named arguments: `~s` and `~s`\n~s", [pp_expr(Id1), pp_expr(Id2), Ctx])
+    };
+pp_when({var_args, Ann, Fun}) ->
+    {pos(Ann)
+    , io_lib:format("when resolving arguments of variadic function `~s`", [pp_expr(Fun)])
+    };
+pp_when(unknown) -> {pos(0,0), ""}.
+
+-spec pp_why_record(why_record()) -> {pos(), iolist()}.
+pp_why_record({var_args, Ann, Fun}) ->
+    {pos(Ann),
+     io_lib:format("arising from resolution of variadic function `~s`",
+                   [pp_expr(Fun)])};
+pp_why_record(Fld = {field, _Ann, LV, _E}) ->
+    {pos(Fld),
+     io_lib:format("arising from an assignment of the field `~s`",
+                   [pp_expr({lvalue, [], LV})])};
+pp_why_record(Fld = {field, _Ann, LV, _Alias, _E}) ->
+    {pos(Fld),
+     io_lib:format("arising from an assignment of the field `~s`",
+                   [pp_expr({lvalue, [], LV})])};
+pp_why_record({proj, _Ann, Rec, FldName}) ->
+    {pos(Rec),
+     io_lib:format("arising from the projection of the field `~s`",
+         [pp(FldName)])}.
+
+
+if_branches(If = {'if', Ann, _, Then, Else}) ->
+    case proplists:get_value(format, Ann) of
+        elif -> [Then | if_branches(Else)];
+        _    -> [If]
+    end;
+if_branches(E) -> [E].
+
+pp_typed(Label, E, T = {type_sig, _, _, _, _, _}) -> pp_typed(Label, E, typesig_to_fun_t(T));
+pp_typed(Label, {typed, _, Expr, _}, Type) ->
+    pp_typed(Label, Expr, Type);
+pp_typed(Label, Expr, Type) ->
+    pp_expr(Label, {typed, [], Expr, Type}).
+
+pp_expr(Expr) ->
+    pp_expr("", Expr).
+pp_expr(Label, Expr) ->
+    prettypr:format(prettypr:beside(prettypr:text(Label), aeso_pretty:expr(Expr, [show_generated])), 80, 80).
+
+pp_type(Type) ->
+    pp_type("", Type).
+pp_type(Label, Type) ->
+    prettypr:format(prettypr:beside(prettypr:text(Label), aeso_pretty:type(Type, [show_generated])), 80, 80).
+
+src_file(T)      -> aeso_syntax:get_ann(file, T, no_file).
+include_type(T)  -> aeso_syntax:get_ann(include_type, T, none).
+line_number(T)   -> aeso_syntax:get_ann(line, T, 0).
+column_number(T) -> aeso_syntax:get_ann(col, T, 0).
+
+pos(T)    -> aeso_errors:pos(src_file(T), line_number(T), column_number(T)).
+pos(L, C) -> aeso_errors:pos(L, C).
+
+loc(T) ->
+    {src_file(T), include_type(T), line_number(T), column_number(T)}.
+
+pp_loc(T) ->
+    {File, IncludeType, Line, Col} = loc(T),
+    case {Line, Col} of
+        {0, 0} -> "(builtin location)";
+        _      -> case IncludeType of
+                      none -> io_lib:format("line ~p, column ~p", [Line, Col]);
+                      _    -> io_lib:format("line ~p, column ~p in ~s", [Line, Col, File])
+                  end
+    end.
+
+plural(No, _Yes, [_]) -> No;
+plural(_No, Yes, _)   -> Yes.
+
+pp(T = {type_sig, _, _, _, _, _}) ->
+    pp(typesig_to_fun_t(T));
+pp([]) ->
+    "";
+pp([T]) ->
+    pp(T);
+pp([T|Ts]) ->
+    [pp(T), ", "|pp(Ts)];
+pp({id, _, Name}) ->
+    Name;
+pp({qid, _, Name}) ->
+    string:join(Name, ".");
+pp({con, _, Name}) ->
+    Name;
+pp({qcon, _, Name}) ->
+    string:join(Name, ".");
+pp({uvar, _, Ref}) ->
+    %% Show some unique representation
+    ["?u" | integer_to_list(erlang:phash2(Ref, 16384)) ];
+pp({tvar, _, Name}) ->
+    Name;
+pp({if_t, _, Id, Then, Else}) ->
+    ["if(", pp([Id, Then, Else]), ")"];
+pp({tuple_t, _, []}) ->
+    "unit";
+pp({tuple_t, _, Cpts}) ->
+    ["(", string:join(lists:map(fun pp/1, Cpts), " * "), ")"];
+pp({bytes_t, _, any}) -> "bytes(_)";
+pp({bytes_t, _, Len}) ->
+    ["bytes(", integer_to_list(Len), ")"];
+pp({app_t, _, T, []}) ->
+    pp(T);
+pp({app_t, _, Type, Args}) ->
+    [pp(Type), "(", pp(Args), ")"];
+pp({named_arg_t, _, Name, Type, _Default}) ->
+    [pp(Name), " : ", pp(Type)];
+pp({fun_t, _, Named = {uvar, _, _}, As, B}) ->
+    ["(", pp(Named), " | ", pp(As), ") => ", pp(B)];
+pp({fun_t, _, Named, As, B}) when is_list(Named) ->
+    ["(", pp(Named ++ As), ") => ", pp(B)];
+pp(Other) ->
+    io_lib:format("~p", [Other]).
+
+
+plural(No, _Yes, [_]) -> No;
+plural(_No, Yes, _)   -> Yes.

src/aeso_ast_types_solve.erl

@@ -0,0 +1,344 @@
+-module(aeso_ast_types_solve).
+
+
+
+-spec solve_constraints(env()) -> ok.
+solve_constraints(Env) ->
+    %% First look for record fields that appear in only one type definition
+    IsAmbiguous =
+        fun(#field_constraint{
+               record_t = RecordType,
+               field    = Field={id, _Attrs, FieldName},
+               field_t  = FieldType,
+               kind     = Kind,
+               context  = When }) ->
+                Arity = fun_arity(dereference_deep(FieldType)),
+                FieldInfos = case Arity of
+                                 none -> lookup_record_field(Env, FieldName, Kind);
+                                 _    -> lookup_record_field_arity(Env, FieldName, Arity, Kind)
+                             end,
+                case FieldInfos of
+                    [] ->
+                        type_error({undefined_field, Field}),
+                        false;
+                    [#field_info{field_t = FldType, record_t = RecType}] ->
+                        create_freshen_tvars(),
+                        FreshFldType = freshen(FldType),
+                        FreshRecType = freshen(RecType),
+                        destroy_freshen_tvars(),
+                        unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}),
+                        unify(Env, FreshRecType, RecordType, {record_constraint, FreshRecType, RecordType, When}),
+                        false;
+                    _ ->
+                        %% ambiguity--need cleverer strategy
+                        true
+                end;
+           (_) -> true
+        end,
+    AmbiguousConstraints = lists:filter(IsAmbiguous, get_constraints()),
+
+    % The two passes on AmbiguousConstraints are needed
+    solve_ambiguous_constraints(Env, AmbiguousConstraints ++ AmbiguousConstraints).
+
+-spec solve_ambiguous_constraints(env(), [constraint()]) -> ok.
+solve_ambiguous_constraints(Env, Constraints) ->
+    Unknown = solve_known_record_types(Env, Constraints),
+    if Unknown == [] -> ok;
+       length(Unknown) < length(Constraints) ->
+            %% progress! Keep trying.
+            solve_ambiguous_constraints(Env, Unknown);
+       true ->
+            case solve_unknown_record_types(Env, Unknown) of
+                true -> %% Progress!
+                    solve_ambiguous_constraints(Env, Unknown);
+                _ -> ok %% No progress. Report errors later.
+            end
+    end.
+
+solve_then_destroy_and_report_unsolved_constraints(Env) ->
+    solve_constraints(Env),
+    destroy_and_report_unsolved_constraints(Env).
+
+destroy_and_report_unsolved_constraints(Env) ->
+    {FieldCs, OtherCs} =
+        lists:partition(fun(#field_constraint{}) -> true; (_) -> false end,
+                        get_constraints()),
+    {CreateCs, OtherCs1} =
+        lists:partition(fun(#record_create_constraint{}) -> true; (_) -> false end,
+                        OtherCs),
+    {ContractCs, OtherCs2} =
+        lists:partition(fun(#is_contract_constraint{}) -> true; (_) -> false end, OtherCs1),
+    {NamedArgCs, OtherCs3} =
+        lists:partition(fun(#dependent_type_constraint{}) -> true;
+                           (#named_argument_constraint{}) -> true;
+                           (_)                            -> false
+                        end, OtherCs2),
+    {BytesCs, OtherCs4} =
+        lists:partition(fun({is_bytes, _})              -> true;
+                           ({add_bytes, _, _, _, _, _}) -> true;
+                           (_)                          -> false
+                        end, OtherCs3),
+    {AensResolveCs, OtherCs5} =
+        lists:partition(fun({aens_resolve_type, _}) -> true;
+                           (_)                      -> false
+                        end, OtherCs4),
+    {OracleTypeCs, []} =
+        lists:partition(fun({oracle_type, _, _}) -> true;
+                           (_)                   -> false
+                        end, OtherCs5),
+
+    Unsolved = [ S || S <- [ solve_constraint(Env, dereference_deep(C)) || C <- NamedArgCs ],
+                      S == unsolved ],
+    [ type_error({unsolved_named_argument_constraint, C}) || C <- Unsolved ],
+
+    Unknown = solve_known_record_types(Env, FieldCs),
+    if Unknown == [] -> ok;
+       true ->
+            case solve_unknown_record_types(Env, Unknown) of
+                true   -> ok;
+                Errors -> [ type_error(Err) || Err <- Errors ]
+            end
+    end,
+
+    check_record_create_constraints(Env, CreateCs),
+    check_is_contract_constraints(Env, ContractCs),
+    check_bytes_constraints(Env, BytesCs),
+    check_aens_resolve_constraints(Env, AensResolveCs),
+    check_oracle_type_constraints(Env, OracleTypeCs),
+
+    destroy_constraints().
+
+%% If false, a type error has been emitted, so it's safe to drop the constraint.
+-spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false | unsolved.
+check_named_argument_constraint(_Env, #named_argument_constraint{ args = {uvar, _, _} }) ->
+    unsolved;
+check_named_argument_constraint(Env,
+        C = #named_argument_constraint{ args = Args,
+                                        name = Id = {id, _, Name},
+                                        type = Type }) ->
+    case [ T || {named_arg_t, _, {id, _, Name1}, T, _} <- Args, Name1 == Name ] of
+        []  ->
+            type_error({bad_named_argument, Args, Id}),
+            false;
+        [T] -> unify(Env, T, Type, {check_named_arg_constraint, C}), true
+    end;
+check_named_argument_constraint(Env,
+        #dependent_type_constraint{ named_args_t = NamedArgsT0,
+                                    named_args = NamedArgs,
+                                    general_type = GenType,
+                                    specialized_type = SpecType,
+                                    context = {check_return, App} }) ->
+    NamedArgsT = dereference(NamedArgsT0),
+    case dereference(NamedArgsT0) of
+        [_ | _] = NamedArgsT ->
+            GetVal = fun(Name, Default) ->
+                        hd([ Val || {named_arg, _, {id, _, N}, Val} <- NamedArgs, N == Name] ++
+                           [ Default ])
+                     end,
+            ArgEnv = maps:from_list([ {Name, GetVal(Name, Default)}
+                                      || {named_arg_t, _, {id, _, Name}, _, Default} <- NamedArgsT ]),
+            GenType1 = specialize_dependent_type(ArgEnv, GenType),
+            unify(Env, GenType1, SpecType, {check_expr, App, GenType1, SpecType}),
+            true;
+        _ -> unify(Env, GenType, SpecType, {check_expr, App, GenType, SpecType}), true
+    end.
+
+solve_constraint(_Env, #field_constraint{record_t = {uvar, _, _}}) ->
+    not_solved;
+solve_constraint(Env, C = #field_constraint{record_t = RecType,
+                                            field    = FieldName,
+                                            field_t  = FieldType,
+                                            context  = When}) ->
+    RecId = record_type_name(RecType),
+    Attrs = aeso_syntax:get_ann(RecId),
+    case lookup_type(Env, RecId) of
+        {_, {_Ann, {Formals, {What, Fields}}}} when What =:= record_t; What =:= contract_t ->
+            FieldTypes = [{Name, Type} || {field_t, _, {id, _, Name}, Type} <- Fields],
+            {id, _, FieldString} = FieldName,
+            case proplists:get_value(FieldString, FieldTypes) of
+                undefined ->
+                    type_error({missing_field, FieldName, RecId}),
+                    not_solved;
+                FldType ->
+                    create_freshen_tvars(),
+                    FreshFldType = freshen(FldType),
+                    FreshRecType = freshen(app_t(Attrs, RecId, Formals)),
+                    destroy_freshen_tvars(),
+                    unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}),
+                    unify(Env, FreshRecType, RecType, {record_constraint, FreshRecType, RecType, When}),
+                    C
+            end;
+        _ ->
+            type_error({not_a_record_type, instantiate(RecType), When}),
+            not_solved
+    end;
+solve_constraint(Env, C = #dependent_type_constraint{}) ->
+    check_named_argument_constraint(Env, C);
+solve_constraint(Env, C = #named_argument_constraint{}) ->
+    check_named_argument_constraint(Env, C);
+solve_constraint(_Env, {is_bytes, _}) -> ok;
+solve_constraint(Env, {add_bytes, Ann, _, A0, B0, C0}) ->
+    A = unfold_types_in_type(Env, dereference(A0)),
+    B = unfold_types_in_type(Env, dereference(B0)),
+    C = unfold_types_in_type(Env, dereference(C0)),
+    case {A, B, C} of
+        {{bytes_t, _, M}, {bytes_t, _, N}, _} -> unify(Env, {bytes_t, Ann, M + N}, C, {at, Ann});
+        {{bytes_t, _, M}, _, {bytes_t, _, R}} when R >= M -> unify(Env, {bytes_t, Ann, R - M}, B, {at, Ann});
+        {_, {bytes_t, _, N}, {bytes_t, _, R}} when R >= N -> unify(Env, {bytes_t, Ann, R - N}, A, {at, Ann});
+        _ -> ok
+    end;
+solve_constraint(_, _) -> ok.
+
+check_bytes_constraints(Env, Constraints) ->
+    InAddConstraint = [ T || {add_bytes, _, _, A, B, C} <- Constraints,
+                             T <- [A, B, C],
+                             element(1, T) /= bytes_t ],
+    %% Skip is_bytes constraints for types that occur in add_bytes constraints
+    %% (no need to generate error messages for both is_bytes and add_bytes).
+    Skip = fun({is_bytes, T}) -> lists:member(T, InAddConstraint);
+              (_) -> false end,
+    [ check_bytes_constraint(Env, C) || C <- Constraints, not Skip(C) ].
+
+check_bytes_constraint(Env, {is_bytes, Type}) ->
+    Type1 = unfold_types_in_type(Env, instantiate(Type)),
+    case Type1 of
+        {bytes_t, _, _} -> ok;
+        _               ->
+            type_error({unknown_byte_length, Type})
+    end;
+check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) ->
+    A = unfold_types_in_type(Env, instantiate(A0)),
+    B = unfold_types_in_type(Env, instantiate(B0)),
+    C = unfold_types_in_type(Env, instantiate(C0)),
+    case {A, B, C} of
+        {{bytes_t, _, _M}, {bytes_t, _, _N}, {bytes_t, _, _R}} ->
+            ok; %% If all are solved we checked M + N == R in solve_constraint.
+        _ -> type_error({unsolved_bytes_constraint, Ann, Fun, A, B, C})
+    end.
+
+check_aens_resolve_constraints(_Env, []) ->
+    ok;
+check_aens_resolve_constraints(Env, [{aens_resolve_type, Type} | Rest]) ->
+    Type1 = unfold_types_in_type(Env, instantiate(Type)),
+    {app_t, _, {id, _, "option"}, [Type2]} = Type1,
+    case Type2 of
+        {id, _, "string"} -> ok;
+        {id, _, "address"} -> ok;
+        {con, _, _} -> ok;
+        {app_t, _, {id, _, "oracle"}, [_, _]} -> ok;
+        {app_t, _, {id, _, "oracle_query"}, [_, _]} -> ok;
+        _ -> type_error({invalid_aens_resolve_type, aeso_syntax:get_ann(Type), Type2})
+    end,
+    check_aens_resolve_constraints(Env, Rest).
+
+check_oracle_type_constraints(_Env, []) ->
+    ok;
+check_oracle_type_constraints(Env, [{oracle_type, Ann, OType} | Rest]) ->
+    Type = unfold_types_in_type(Env, instantiate(OType)),
+    {app_t, _, {id, _, "oracle"}, [QType, RType]} = Type,
+    ensure_monomorphic(QType, {invalid_oracle_type, polymorphic,  query,    Ann, Type}),
+    ensure_monomorphic(RType, {invalid_oracle_type, polymorphic,  response, Ann, Type}),
+    ensure_first_order(QType, {invalid_oracle_type, higher_order, query,    Ann, Type}),
+    ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}),
+    check_oracle_type_constraints(Env, Rest).
+
+%% -- Field constraints --
+
+check_record_create_constraints(_, []) -> ok;
+check_record_create_constraints(Env, [C | Cs]) ->
+    #record_create_constraint{
+        record_t = Type,
+        fields   = Fields,
+        context  = When } = C,
+    Type1 = unfold_types_in_type(Env, instantiate(Type)),
+    try lookup_type(Env, record_type_name(Type1)) of
+        {_QId, {_Ann, {_Args, {record_t, RecFields}}}} ->
+            ActualNames = [ Fld || {field_t, _, {id, _, Fld}, _} <- RecFields ],
+            GivenNames  = [ Fld || {id, _, Fld} <- Fields ],
+            case ActualNames -- GivenNames of   %% We know already that we don't have too many fields
+                []      -> ok;
+                Missing -> type_error({missing_fields, When, Type1, Missing})
+            end;
+        _ -> %% We can get here if there are other type errors.
+            ok
+    catch _:_ ->    %% Might be unsolved, we get a different error in that case
+        ok
+    end,
+    check_record_create_constraints(Env, Cs).
+
+check_is_contract_constraints(_Env, []) -> ok;
+check_is_contract_constraints(Env, [C | Cs]) ->
+    #is_contract_constraint{ contract_t = Type, context = Cxt, force_def = ForceDef } = C,
+    Type1 = unfold_types_in_type(Env, instantiate(Type)),
+    TypeName = record_type_name(Type1),
+    case lookup_type(Env, TypeName) of
+        {_, {_Ann, {[], {contract_t, _}}}} ->
+            case not ForceDef orelse is_contract_defined(TypeName) of
+                true -> ok;
+                false -> type_error({contract_lacks_definition, Type1, Cxt})
+                end;
+        _ -> type_error({not_a_contract_type, Type1, Cxt})
+    end,
+    check_is_contract_constraints(Env, Cs).
+
+-spec solve_unknown_record_types(env(), [field_constraint()]) -> true | [tuple()].
+solve_unknown_record_types(Env, Unknown) ->
+    UVars = lists:usort([UVar || #field_constraint{record_t = UVar = {uvar, _, _}} <- Unknown]),
+    Solutions = [solve_for_uvar(Env, UVar, [{Kind, When, Field}
+                                            || #field_constraint{record_t = U, field = Field, kind = Kind, context = When} <- Unknown,
+                                               U == UVar])
+                 || UVar <- UVars],
+    case lists:member(true, Solutions) of
+        true  -> true;
+        false -> Solutions
+    end.
+
+%% This will solve all kinds of constraints but will only return the
+%% unsolved field constraints
+-spec solve_known_record_types(env(), [constraint()]) -> [field_constraint()].
+solve_known_record_types(Env, Constraints) ->
+    DerefConstraints = lists:map(fun(C = #field_constraint{record_t = RecordType}) ->
+                                        C#field_constraint{record_t = dereference(RecordType)};
+                                    (C) -> dereference_deep(C)
+                                 end, Constraints),
+    SolvedConstraints = lists:map(fun(C) -> solve_constraint(Env, dereference_deep(C)) end, DerefConstraints),
+    Unsolved = DerefConstraints--SolvedConstraints,
+    lists:filter(fun(#field_constraint{}) -> true; (_) -> false end, Unsolved).
+
+solve_for_uvar(Env, UVar = {uvar, Attrs, _}, Fields0) ->
+    Fields = [{Kind, Fld} || {Kind, _, Fld} <- Fields0],
+    [{_, When, _} | _] = Fields0,    %% Get the location from the first field
+    %% If we have 'create' constraints they must be complete.
+    Covering = lists:usort([ Name || {create, {id, _, Name}} <- Fields ]),
+    %% Does this set of fields uniquely identify a record type?
+    FieldNames = [ Name || {_Kind, {id, _, Name}} <- Fields ],
+    UniqueFields = lists:usort(FieldNames),
+    Candidates = [RecType || #field_info{record_t = RecType} <- lookup_record_field(Env, hd(FieldNames))],
+    TypesAndFields = [case lookup_type(Env, record_type_name(RecType)) of
+                        {_, {_, {_, {record_t, RecFields}}}} ->
+                            {RecType, [Field || {field_t, _, {id, _, Field}, _} <- RecFields]};
+                        {_, {_, {_, {contract_t, ConFields}}}} ->
+                            %% TODO: is this right?
+                            {RecType, [Field || {field_t, _, {id, _, Field}, _} <- ConFields]};
+                        false -> %% impossible?
+                            error({no_definition_for, record_type_name(RecType), in, Env})
+                      end
+                      || RecType <- Candidates],
+    PartialSolutions =
+        lists:sort([{RecType, if Covering == [] -> []; true -> RecFields -- Covering end}
+                    || {RecType, RecFields} <- TypesAndFields,
+                       UniqueFields -- RecFields == []]),
+    Solutions = [RecName || {RecName, []} <- PartialSolutions],
+
+
+apply_typesig_constraint(_Ann, none, _FunT) -> ok;
+apply_typesig_constraint(Ann, address_to_contract, {fun_t, _, [], [_], Type}) ->
+    add_constraint([#is_contract_constraint{ contract_t = Type,
+                                        context    = {address_to_contract, Ann}}]);
+apply_typesig_constraint(Ann, bytes_concat, {fun_t, _, [], [A, B], C}) ->
+    add_constraint({add_bytes, Ann, concat, A, B, C});
+apply_typesig_constraint(Ann, bytes_split, {fun_t, _, [], [C], {tuple_t, _, [A, B]}}) ->
+    add_constraint({add_bytes, Ann, split, A, B, C});
+apply_typesig_constraint(Ann, bytecode_hash, {fun_t, _, _, [Con], _}) ->
+    add_constraint([#is_contract_constraint{ contract_t = Con,
+                                        context    = {bytecode_hash, Ann} }]).

src/aeso_compiler.erl

@@ -12,8 +12,6 @@
         , file/2
         , from_string/2
         , check_call/4
-        , decode_value/4
-        , encode_value/4
         , create_calldata/3
         , create_calldata/4
         , version/0
@@ -31,11 +29,10 @@
 -include("aeso_utils.hrl").
 
 
--type option() :: pp_sophia_code
+-type option() :: pp_ast
-                | pp_ast
                 | pp_types
                 | pp_typed_ast
-                | pp_assembler
+                | pp_fate
                 | no_code
                 | keep_included
                 | debug_mode
@@ -119,8 +116,8 @@ from_string1(ContractString, Options) ->
      , warnings := Warnings } = string_to_code(ContractString, Options),
     #{ child_con_env := ChildContracts } = FCodeEnv,
     SavedFreshNames = maps:get(saved_fresh_names, FCodeEnv, #{}),
-    FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
+    {FateCode, VarsRegs} = aeso_fcode_to_fate:compile(ChildContracts, FCode, SavedFreshNames, Options),
-    pp_assembler(FateCode, Options),
+    pp_fate(FateCode, Options),
     ByteCode = aeb_fate_code:serialize(FateCode, []),
     {ok, Version} = version(),
     Res = #{byte_code => ByteCode,
@@ -132,7 +129,13 @@ from_string1(ContractString, Options) ->
             payable => maps:get(payable, FCode),
             warnings => Warnings
            },
-    {ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}.
+    ResDbg = Res#{variables_registers => VarsRegs},
+    FinalRes =
+        case proplists:get_value(debug_info, Options, false) of
+            true  -> ResDbg;
+            false -> Res
+        end,
+    {ok, maybe_generate_aci(FinalRes, FoldedTypedAst, Options)}.
 
 maybe_generate_aci(Result, FoldedTypedAst, Options) ->
     case proplists:get_value(aci, Options) of
@@ -146,7 +149,6 @@ maybe_generate_aci(Result, FoldedTypedAst, Options) ->
 -spec string_to_code(string(), options()) -> map().
 string_to_code(ContractString, Options) ->
     Ast = parse(ContractString, Options),
-    pp_sophia_code(Ast, Options),
     pp_ast(Ast, Options),
     {TypeEnv, FoldedTypedAst, UnfoldedTypedAst, Warnings} = aeso_ast_infer_types:infer(Ast, [return_env | Options]),
     pp_typed_ast(UnfoldedTypedAst, Options),
@@ -184,55 +186,30 @@ check_call(Source, FunName, Args, Options) ->
     check_call1(Source, FunName, Args, Options).
 
 check_call1(ContractString0, FunName, Args, Options) ->
-    case add_extra_call(ContractString0, {call, FunName, Args}, Options) of
-        {ok, CallName, Code} ->
-            {def, _, _, FcodeArgs} = get_call_body(CallName, Code),
-            {ok, FunName, [ aeso_fcode_to_fate:term_to_fate(A) || A <- FcodeArgs ]};
-        Err = {error, _} ->
-            Err
-    end.
-
-add_extra_call(Contract0, Call, Options) ->
     try
         %% First check the contract without the __call function
         #{fcode := OrgFcode
         , fcode_env := #{child_con_env := ChildContracts}
-        , ast := Ast} = string_to_code(Contract0, Options),
+        , ast := Ast} = string_to_code(ContractString0, Options),
-        FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
+        {FateCode, _} = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, #{}, []),
         %% collect all hashes and compute the first name without hash collision to
         SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)),
         CallName = first_none_match(?CALL_NAME, SymbolHashes,
                                     lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)),
-        Contract = insert_call_function(Ast, Contract0, CallName, Call),
+        ContractString = insert_call_function(Ast, ContractString0, CallName, FunName, Args),
-        {ok, CallName, string_to_code(Contract, Options)}
+        #{fcode := Fcode} = string_to_code(ContractString, Options),
+        CallArgs = arguments_of_body(CallName, FunName, Fcode),
+
+        {ok, FunName, CallArgs}
     catch
         throw:{error, Errors} -> {error, Errors}
     end.
 
-get_call_body(CallName, #{fcode := Fcode}) ->
+arguments_of_body(CallName, _FunName, Fcode) ->
     #{body := Body} = maps:get({entrypoint, list_to_binary(CallName)}, maps:get(functions, Fcode)),
-    Body.
+    {def, _FName, Args} = Body,
-
+    %% FName is either {entrypoint, list_to_binary(FunName)} or 'init'
-encode_value(Contract0, Type, Value, Options) ->
+    [ aeso_fcode_to_fate:term_to_fate(A) || A <- Args ].
-    case add_extra_call(Contract0, {value, Type, Value}, Options) of
-        {ok, CallName, Code} ->
-            Body = get_call_body(CallName, Code),
-            {ok, aeb_fate_encoding:serialize(aeso_fcode_to_fate:term_to_fate(Body))};
-        Err = {error, _} ->
-            Err
-    end.
-
-decode_value(Contract0, Type, FateValue, Options) ->
-    case add_extra_call(Contract0, {type, Type}, Options) of
-        {ok, CallName, Code} ->
-            #{ unfolded_typed_ast := TypedAst
-             , type_env           := TypeEnv} = Code,
-            {ok, _, Type0} = get_decode_type(CallName, TypedAst),
-            Type1 = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
-            fate_data_to_sophia_value(Type0, Type1, FateValue);
-        Err = {error, _} ->
-            Err
-    end.
 
 first_none_match(_CallName, _Hashes, []) ->
     error(unable_to_find_unique_call_name);
@@ -245,31 +222,14 @@ first_none_match(CallName, Hashes, [Char|Chars]) ->
     end.
 
 %% Add the __call function to a contract.
--spec insert_call_function(aeso_syntax:ast(), string(), string(),
+-spec insert_call_function(aeso_syntax:ast(), string(), string(), string(), [string()]) -> string().
-                           {call, string(), [string()]} | {value, string(), string()} | {type, string()}) -> string().
+insert_call_function(Ast, Code, Call, FunName, Args) ->
-insert_call_function(Ast, Code, Call, {call, FunName, Args}) ->
     Ind = last_contract_indent(Ast),
     lists:flatten(
         [ Code,
           "\n\n",
           lists:duplicate(Ind, " "),
           "stateful entrypoint ", Call, "() = ", FunName, "(", string:join(Args, ","), ")\n"
-        ]);
-insert_call_function(Ast, Code, Call, {value, Type, Value}) ->
-    Ind = last_contract_indent(Ast),
-    lists:flatten(
-        [ Code,
-          "\n\n",
-          lists:duplicate(Ind, " "),
-          "entrypoint ", Call, "() : ", Type, " = ", Value, "\n"
-        ]);
-insert_call_function(Ast, Code, Call, {type, Type}) ->
-    Ind = last_contract_indent(Ast),
-    lists:flatten(
-        [ Code,
-          "\n\n",
-          lists:duplicate(Ind, " "),
-          "entrypoint ", Call, "(val : ", Type, ") = val\n"
         ]).
 
 -spec insert_init_function(string(), options()) -> string().
@@ -312,23 +272,20 @@ to_sophia_value(ContractString, FunName, ok, Data, Options0) ->
         {ok, _, Type0} = get_decode_type(FunName, TypedAst),
         Type   = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]),
 
-        fate_data_to_sophia_value(Type0, Type, Data)
-    catch
-        throw:{error, Errors} -> {error, Errors}
-    end.
-
-fate_data_to_sophia_value(Type, UnfoldedType, FateData) ->
         try
-        {ok, aeso_vm_decode:from_fate(UnfoldedType, aeb_fate_encoding:deserialize(FateData))}
+            {ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))}
         catch throw:cannot_translate_to_sophia ->
-            Type1 = prettypr:format(aeso_pretty:type(Type)),
+                Type1 = prettypr:format(aeso_pretty:type(Type0)),
                 Msg = io_lib:format("Cannot translate FATE value ~p\n  of Sophia type ~s",
-                                [aeb_fate_encoding:deserialize(FateData), Type1]),
+                                    [aeb_fate_encoding:deserialize(Data), Type1]),
                 {error, [aeso_errors:new(data_error, Msg)]};
               _:_ ->
-            Type1 = prettypr:format(aeso_pretty:type(Type)),
+                Type1 = prettypr:format(aeso_pretty:type(Type0)),
                 Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]),
                 {error, [aeso_errors:new(data_error, Msg)]}
+        end
+    catch
+        throw:{error, Errors} -> {error, Errors}
     end.
 
 -spec create_calldata(string(), string(), [string()]) ->
@@ -406,21 +363,22 @@ get_decode_type(FunName, [_ | Contracts]) ->
     %% The __decode should be in the final contract
     get_decode_type(FunName, Contracts).
 
-pp_sophia_code(C, Opts)->  pp(C, Opts, pp_sophia_code, fun(Code) ->
+pp_ast(C, Opts) ->
-                                io:format("~s\n", [prettypr:format(aeso_pretty:decls(Code))])
+    [ io:format("AST:\n~s\n",
-                            end).
+                [prettypr:format(aeso_pretty:decls(Ast, []))])
-pp_ast(C, Opts)      ->  pp(C, Opts, pp_ast, fun aeso_ast:pp/1).
+      || true <- proplists:get_value(pp_ast, Opts)
-pp_typed_ast(C, Opts)->  pp(C, Opts, pp_typed_ast, fun aeso_ast:pp_typed/1).
+    ].
 
-pp_assembler(C, Opts) ->  pp(C, Opts, pp_assembler, fun(Asm) -> io:format("~s", [aeb_fate_asm:pp(Asm)]) end).
+pp_typed_ast(C, Opts) ->
+    [ io:format("Typed AST:\n~s\n",
+                [prettypr:format(aeso_pretty:decls(Ast, [show_generated]))])
+      || true <- proplists:get_value(pp_typed_ast, Opts)
+    ].
 
-pp(Code, Options, Option, PPFun) ->
+pp_fate(C, Opts) ->
-    case proplists:lookup(Option, Options) of
+    [ io:format("FATE:\n~s\n", [aeb_fate_asm:pp(Asm)])
-        {Option1, true} when Option1 =:= Option ->
+      || true <- proplists:get_value(pp_fate, Opts)
-            PPFun(Code);
+    ].
-        none ->
-            ok
-    end.
 
 %% -- Byte code validation ---------------------------------------------------
 

src/aeso_fcode_to_fate.erl

@@ -52,8 +52,7 @@
                tailpos           = true,
                child_contracts   = #{},
                saved_fresh_names = #{},
-               options           = [],
+               options           = [] }).
-               debug_info        = false }).
 
 %% -- Debugging --------------------------------------------------------------
 
@@ -82,16 +81,24 @@ code_error(Err) ->
 compile(FCode, SavedFreshNames, Options) ->
     compile(#{}, FCode, SavedFreshNames, Options).
 compile(ChildContracts, FCode, SavedFreshNames, Options) ->
+    try
+        compile1(ChildContracts, FCode, SavedFreshNames, Options)
+    after
+        put(variables_registers, undefined)
+    end.
+
+compile1(ChildContracts, FCode, SavedFreshNames, Options) ->
     #{ contract_name := ContractName,
        functions     := Functions } = FCode,
     SFuns  = functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Options),
     SFuns1 = optimize_scode(SFuns, Options),
     FateCode = to_basic_blocks(SFuns1),
     ?debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]),
-    case proplists:get_value(include_child_contract_symbols, Options, false) of
+    FateCode1 = case proplists:get_value(include_child_contract_symbols, Options, false) of
                     false -> FateCode;
                     true -> add_child_symbols(ChildContracts, FateCode)
-    end.
+                end,
+    {FateCode1, get_variables_registers()}.
 
 make_function_id(X) ->
     aeb_fate_code:symbol_identifier(make_function_name(X)).
@@ -116,15 +123,31 @@ functions_to_scode(ChildContracts, ContractName, Functions, SavedFreshNames, Opt
 
 function_to_scode(ChildContracts, ContractName, Functions, Name, Attrs0, Args, Body, ResType, SavedFreshNames, Options) ->
     {ArgTypes, ResType1} = typesig_to_scode(Args, ResType),
-    Attrs = [ A || A <- Attrs0, A == private orelse A == payable ],
+    Attrs = Attrs0 -- [stateful], %% Only track private and payable from here.
     Env = init_env(ChildContracts, ContractName, Functions, Name, Args, SavedFreshNames, Options),
-    ArgsNames = [ X || {X, _} <- lists:reverse(Env#env.vars) ],
+    [ add_variables_register(Env, Arg, Register) ||
-
+        proplists:get_value(debug_info, Options, false),
-    %% DBG_LOC is added before the function body to make it possible to break
+        {Arg, Register} <- Env#env.vars ],
-    %% at the function signature
     SCode = to_scode(Env, Body),
-    DbgSCode = dbg_contract(Env) ++ dbg_loc(Env, Attrs0) ++ dbg_scoped_vars(Env, ArgsNames, SCode),
+    {Attrs, {ArgTypes, ResType1}, SCode}.
-    {Attrs, {ArgTypes, ResType1}, DbgSCode}.
+
+get_variables_registers() ->
+    case get(variables_registers) of
+        undefined -> #{};
+        Vs        -> Vs
+    end.
+
+add_variables_register(Env = #env{saved_fresh_names = SavedFreshNames}, Name, Register) ->
+    Olds = get_variables_registers(),
+    RealName = maps:get(Name, SavedFreshNames, Name),
+    FunName =
+        case Env#env.current_function of
+            event -> "Chain.event";
+            {entrypoint, BinName} -> binary_to_list(BinName);
+            {local_fun, QualName} -> lists:last(QualName)
+        end,
+    New = {Env#env.contract, FunName, RealName},
+    put(variables_registers, Olds#{New => Register}).
 
 -define(tvars, '$tvars').
 
@@ -178,13 +201,13 @@ init_env(ChildContracts, ContractName, FunNames, Name, Args, SavedFreshNames, Op
           current_function = Name,
           options = Options,
           tailpos   = true,
-          saved_fresh_names = SavedFreshNames,
+          saved_fresh_names = SavedFreshNames }.
-          debug_info        = proplists:get_value(debug_info, Options, false) }.
 
 next_var(#env{ vars = Vars }) ->
     1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]).
 
 bind_var(Name, Var, Env = #env{ vars = Vars }) ->
+    proplists:get_value(debug_info, Env#env.options, false) andalso add_variables_register(Env, Name, Var),
     Env#env{ vars = [{Name, Var} | Vars] }.
 
 bind_local(Name, Env) ->
@@ -211,7 +234,7 @@ serialize_contract_code(Env, C) ->
             Options = Env#env.options,
             SavedFreshNames = Env#env.saved_fresh_names,
             FCode = maps:get(C, Env#env.child_contracts),
-            FateCode = compile(Env#env.child_contracts, FCode, SavedFreshNames, Options),
+            {FateCode, _} = compile1(Env#env.child_contracts, FCode, SavedFreshNames, Options),
             ByteCode = aeb_fate_code:serialize(FateCode, []),
             {ok, Version} = aeso_compiler:version(),
             OriginalSourceCode = proplists:get_value(original_src, Options, ""),
@@ -245,44 +268,44 @@ lit_to_fate(Env, L) ->
 term_to_fate(E) -> term_to_fate(#env{}, #{}, E).
 term_to_fate(GlobEnv, E) -> term_to_fate(GlobEnv, #{}, E).
 
-term_to_fate(GlobEnv, _Env, {lit, _, L}) ->
+term_to_fate(GlobEnv, _Env, {lit, L}) ->
     lit_to_fate(GlobEnv, L);
 %% negative literals are parsed as 0 - N
-term_to_fate(_GlobEnv, _Env, {op, _, '-', [{lit, _, {int, 0}}, {lit, _, {int, N}}]}) ->
+term_to_fate(_GlobEnv, _Env, {op, '-', [{lit, {int, 0}}, {lit, {int, N}}]}) ->
     aeb_fate_data:make_integer(-N);
-term_to_fate(_GlobEnv, _Env, {nil, _}) ->
+term_to_fate(_GlobEnv, _Env, nil) ->
     aeb_fate_data:make_list([]);
-term_to_fate(GlobEnv, Env, {op, _, '::', [Hd, Tl]}) ->
+term_to_fate(GlobEnv, Env, {op, '::', [Hd, Tl]}) ->
     %% The Tl will translate into a list, because FATE lists are just lists
     [term_to_fate(GlobEnv, Env, Hd) | term_to_fate(GlobEnv, Env, Tl)];
-term_to_fate(GlobEnv, Env, {tuple, _, As}) ->
+term_to_fate(GlobEnv, Env, {tuple, As}) ->
     aeb_fate_data:make_tuple(list_to_tuple([ term_to_fate(GlobEnv, Env, A) || A<-As]));
-term_to_fate(GlobEnv, Env, {con, _, Ar, I, As}) ->
+term_to_fate(GlobEnv, Env, {con, Ar, I, As}) ->
     FateAs = [ term_to_fate(GlobEnv, Env, A) || A <- As ],
     aeb_fate_data:make_variant(Ar, I, list_to_tuple(FateAs));
-term_to_fate(_GlobEnv, _Env, {builtin, _, bits_all, []}) ->
+term_to_fate(_GlobEnv, _Env, {builtin, bits_all, []}) ->
     aeb_fate_data:make_bits(-1);
-term_to_fate(_GlobEnv, _Env, {builtin, _, bits_none, []}) ->
+term_to_fate(_GlobEnv, _Env, {builtin, bits_none, []}) ->
     aeb_fate_data:make_bits(0);
-term_to_fate(GlobEnv, _Env, {op, _, bits_set, [B, I]}) ->
+term_to_fate(GlobEnv, _Env, {op, bits_set, [B, I]}) ->
     {bits, N} = term_to_fate(GlobEnv, B),
     J         = term_to_fate(GlobEnv, I),
     {bits, N bor (1 bsl J)};
-term_to_fate(GlobEnv, _Env, {op, _, bits_clear, [B, I]}) ->
+term_to_fate(GlobEnv, _Env, {op, bits_clear, [B, I]}) ->
     {bits, N} = term_to_fate(GlobEnv, B),
     J         = term_to_fate(GlobEnv, I),
     {bits, N band bnot (1 bsl J)};
-term_to_fate(GlobEnv, Env, {'let', _, X, E, Body}) ->
+term_to_fate(GlobEnv, Env, {'let', X, E, Body}) ->
     Env1 = Env#{ X => term_to_fate(GlobEnv, Env, E) },
     term_to_fate(GlobEnv, Env1, Body);
-term_to_fate(_GlobEnv, Env, {var, _, X}) ->
+term_to_fate(_GlobEnv, Env, {var, X}) ->
     case maps:get(X, Env, undefined) of
         undefined -> throw(not_a_fate_value);
         V         -> V
     end;
-term_to_fate(_GlobEnv, _Env, {builtin, _, map_empty, []}) ->
+term_to_fate(_GlobEnv, _Env, {builtin, map_empty, []}) ->
     aeb_fate_data:make_map(#{});
-term_to_fate(GlobEnv, Env, {op, _, map_set, [M, K, V]}) ->
+term_to_fate(GlobEnv, Env, {op, map_set, [M, K, V]}) ->
     Map = term_to_fate(GlobEnv, Env, M),
     Map#{term_to_fate(GlobEnv, Env, K) => term_to_fate(GlobEnv, Env, V)};
 term_to_fate(_GlobEnv, _Env, _) ->
@@ -290,59 +313,52 @@ term_to_fate(_GlobEnv, _Env, _) ->
 
 to_scode(Env, T) ->
     try term_to_fate(Env, T) of
-        V ->
+        V -> [push(?i(V))]
-            FAnn = element(2, T),
-            [dbg_loc(Env, FAnn), push(?i(V))]
     catch throw:not_a_fate_value ->
         to_scode1(Env, T)
     end.
 
-to_scode1(Env, {lit, Ann, L}) ->
+to_scode1(Env, {lit, L}) ->
-    [ dbg_loc(Env, Ann), push(?i(lit_to_fate(Env, L))) ];
+    [push(?i(lit_to_fate(Env, L)))];
 
-to_scode1(Env, {nil, Ann}) ->
+to_scode1(_Env, nil) ->
-    [ dbg_loc(Env, Ann), aeb_fate_ops:nil(?a) ];
+    [aeb_fate_ops:nil(?a)];
 
-to_scode1(Env, {var, Ann, X}) ->
+to_scode1(Env, {var, X}) ->
-    [ dbg_loc(Env, Ann), push(lookup_var(Env, X)) ];
+    [push(lookup_var(Env, X))];
 
-to_scode1(Env, {con, Ann, Ar, I, As}) ->
+to_scode1(Env, {con, Ar, I, As}) ->
     N = length(As),
-    [ dbg_loc(Env, Ann),
+    [[to_scode(notail(Env), A) || A <- As],
-      [to_scode(notail(Env), A) || A <- As],
      aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N))];
 
-to_scode1(Env, {tuple, Ann, As}) ->
+to_scode1(Env, {tuple, As}) ->
     N = length(As),
-    [ dbg_loc(Env, Ann),
+    [[ to_scode(notail(Env), A) || A <- As ],
-      [ to_scode(notail(Env), A) || A <- As ],
      tuple(N)];
 
-to_scode1(Env, {proj, Ann, E, I}) ->
+to_scode1(Env, {proj, E, I}) ->
-    [ dbg_loc(Env, Ann),
+    [to_scode(notail(Env), E),
-      to_scode(notail(Env), E),
      aeb_fate_ops:element_op(?a, ?i(I), ?a)];
 
-to_scode1(Env, {set_proj, Ann, R, I, E}) ->
+to_scode1(Env, {set_proj, R, I, E}) ->
-    [ dbg_loc(Env, Ann),
+    [to_scode(notail(Env), E),
-      to_scode(notail(Env), E),
      to_scode(notail(Env), R),
      aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a)];
 
-to_scode1(Env, {op, Ann, Op, Args}) ->
+to_scode1(Env, {op, Op, Args}) ->
-    [ dbg_loc(Env, Ann) | call_to_scode(Env, op_to_scode(Op), Args) ];
+    call_to_scode(Env, op_to_scode(Op), Args);
 
-to_scode1(Env, {'let', Ann, X, {var, _, Y}, Body}) ->
+to_scode1(Env, {'let', X, {var, Y}, Body}) ->
     Env1 = bind_var(X, lookup_var(Env, Y), Env),
-    [ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], to_scode(Env1, Body)) ];
+    to_scode(Env1, Body);
-to_scode1(Env, {'let', Ann, X, Expr, Body}) ->
+to_scode1(Env, {'let', X, Expr, Body}) ->
     {I, Env1} = bind_local(X, Env),
-    SCode = [ to_scode(notail(Env), Expr),
+    [ to_scode(notail(Env), Expr),
       aeb_fate_ops:store({var, I}, {stack, 0}),
-              to_scode(Env1, Body) ],
+      to_scode(Env1, Body) ];
-    [ dbg_loc(Env, Ann) | dbg_scoped_vars(Env1, [X], SCode) ];
 
-to_scode1(Env = #env{ current_function = Fun, tailpos = true, debug_info = false }, {def, Ann, Fun, Args}) ->
+to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) ->
     %% Tail-call to current function, f(e0..en). Compile to
     %%      [ let xi = ei ]
     %%      [ STORE argi xi ]
@@ -355,62 +371,61 @@ to_scode1(Env = #env{ current_function = Fun, tailpos = true, debug_info = false
                                 aeb_fate_ops:store({var, I}, ?a)],
                         {[I | Is], Acc1, Env2}
                     end, {[], [], Env}, Args),
-    [ dbg_loc(Env, Ann),
+    [ Code,
-      Code,
       [ aeb_fate_ops:store({arg, I}, {var, J})
         || {I, J} <- lists:zip(lists:seq(0, length(Vars) - 1),
                                lists:reverse(Vars)) ],
       loop ];
-to_scode1(Env, {def, Ann, Fun, Args}) ->
+to_scode1(Env, {def, Fun, Args}) ->
     FName = make_function_id(Fun),
     Lbl   = aeb_fate_data:make_string(FName),
-    [ dbg_loc(Env, Ann) | call_to_scode(Env, local_call(Env, ?i(Lbl)), Args) ];
+    call_to_scode(Env, local_call(Env, ?i(Lbl)), Args);
-to_scode1(Env, {funcall, Ann, Fun, Args}) ->
+to_scode1(Env, {funcall, Fun, Args}) ->
-    [ dbg_loc(Env, Ann) | call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args) ];
+    call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args);
 
-to_scode1(Env, {builtin, Ann, B, Args}) ->
+to_scode1(Env, {builtin, B, Args}) ->
-    [ dbg_loc(Env, Ann) | builtin_to_scode(Env, B, Args) ];
+    builtin_to_scode(Env, B, Args);
 
-to_scode1(Env, {remote, Ann, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) ->
+to_scode1(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value, Protected | Args]}) ->
     Lbl = make_function_id(Fun),
     {ArgTypes, RetType0} = typesig_to_scode([{"_", T} || T <- ArgsT], RetT),
     ArgType = ?i(aeb_fate_data:make_typerep({tuple, ArgTypes})),
     RetType = ?i(aeb_fate_data:make_typerep(RetType0)),
-    SCode = case Protected of
+    case Protected of
-        {lit, _, {bool, false}} ->
+        {lit, {bool, false}} ->
             case Gas of
-                {builtin, _, call_gas_left, _} ->
+                {builtin, call_gas_left, _} ->
                     Call = aeb_fate_ops:call_r(?a, Lbl, ArgType, RetType, ?a),
                     call_to_scode(Env, Call, [Ct, Value | Args]);
                 _ ->
                     Call = aeb_fate_ops:call_gr(?a, Lbl, ArgType, RetType, ?a, ?a),
                     call_to_scode(Env, Call, [Ct, Value, Gas | Args])
             end;
-        {lit, _, {bool, true}} ->
+        {lit, {bool, true}} ->
             Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?i(true)),
             call_to_scode(Env, Call, [Ct, Value, Gas | Args]);
         _ ->
             Call = aeb_fate_ops:call_pgr(?a, Lbl, ArgType, RetType, ?a, ?a, ?a),
             call_to_scode(Env, Call, [Ct, Value, Gas, Protected | Args])
-    end,
+    end;
-    [ dbg_loc(Env, Ann) | SCode ];
 
-to_scode1(Env, {get_state, Ann, Reg}) ->
+to_scode1(_Env, {get_state, Reg}) ->
-    [ dbg_loc(Env, Ann), push(?s(Reg)) ];
+    [push(?s(Reg))];
-to_scode1(Env, {set_state, Ann, Reg, Val}) ->
+to_scode1(Env, {set_state, Reg, Val}) ->
-    [ dbg_loc(Env, Ann) | call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, tuple(0)], [Val]) ];
+    call_to_scode(Env, [{'STORE', ?s(Reg), ?a},
+                        tuple(0)], [Val]);
 
-to_scode1(Env, {closure, Ann, Fun, FVs}) ->
+to_scode1(Env, {closure, Fun, FVs}) ->
-    [ to_scode(Env, {tuple, Ann, [{lit, Ann, {string, make_function_id(Fun)}}, FVs]}) ];
+    to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]});
 
-to_scode1(Env, {switch, Ann, Case}) ->
+to_scode1(Env, {switch, Case}) ->
-    [ dbg_loc(Env, Ann) | split_to_scode(Env, Case) ].
+    split_to_scode(Env, Case).
 
-local_call( Env = #env{debug_info = false}, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun);
+local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun);
 local_call(_Env, Fun)                      -> aeb_fate_ops:call(Fun).
 
-split_to_scode(Env, {nosplit, Renames, Expr}) ->
+split_to_scode(Env, {nosplit, Expr}) ->
-    [switch_body, dbg_scoped_vars(Env, Renames, to_scode(Env, Expr))];
+    [switch_body, to_scode(Env, Expr)];
 split_to_scode(Env, {split, {tuple, _}, X, Alts}) ->
     {Def, Alts1} = catchall_to_scode(Env, X, Alts),
     Arg = lookup_var(Env, X),
@@ -634,7 +649,7 @@ builtin_to_scode(Env, chain_bytecode_hash, [_Addr] = Args) ->
 builtin_to_scode(Env, chain_clone,
                  [InitArgsT, GasCap, Value, Prot, Contract | InitArgs]) ->
     case GasCap of
-        {builtin, _, call_gas_left, _} ->
+        {builtin, call_gas_left, _} ->
             call_to_scode(Env, aeb_fate_ops:clone(?a, ?a, ?a, ?a),
                           [Contract, InitArgsT, Value, Prot | InitArgs]
                          );
@@ -736,77 +751,6 @@ push(A) -> {'STORE', ?a, A}.
 tuple(0) -> push(?i({tuple, {}}));
 tuple(N) -> aeb_fate_ops:tuple(?a, N).
 
-%% -- Debug info functions --
-
-dbg_contract(#env{debug_info = false}) ->
-    [];
-dbg_contract(#env{contract = Contract}) ->
-    [{'DBG_CONTRACT', {immediate, Contract}}].
-
-dbg_loc(#env{debug_info = false}, _) ->
-    [];
-dbg_loc(_Env, Ann) ->
-    File = case proplists:get_value(file, Ann, no_file) of
-                no_file -> "";
-                F       -> F
-            end,
-    Line = proplists:get_value(line, Ann, undefined),
-    case Line of
-        undefined -> [];
-        _         -> [{'DBG_LOC', {immediate, File}, {immediate, Line}}]
-    end.
-
-dbg_scoped_vars(#env{debug_info = false}, _, SCode) ->
-    SCode;
-dbg_scoped_vars(_Env, [], SCode) ->
-    SCode;
-dbg_scoped_vars(Env, [{SavedVarName, Var} | Rest], SCode) ->
-    dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode));
-dbg_scoped_vars(Env = #env{saved_fresh_names = SavedFreshNames}, [Var | Rest], SCode) ->
-    SavedVarName = maps:get(Var, SavedFreshNames, Var),
-    dbg_scoped_vars(Env, Rest, dbg_scoped_var(Env, SavedVarName, Var, SCode)).
-
-dbg_scoped_var(Env, SavedVarName, Var, SCode) ->
-    case SavedVarName == "_" orelse is_fresh_name(SavedVarName) of
-        true ->
-            SCode;
-        false ->
-            Register = lookup_var(Env, Var),
-            Def      = [{'DBG_DEF',   {immediate, SavedVarName}, Register}],
-            Undef    = [{'DBG_UNDEF', {immediate, SavedVarName}, Register}],
-            Def ++ dbg_undef(Undef, SCode)
-    end.
-
-is_fresh_name([$% | _]) ->
-    true;
-is_fresh_name(_) ->
-    false.
-
-dbg_undef(_Undef, missing) ->
-    missing;
-dbg_undef(Undef, loop) ->
-    [Undef, loop];
-dbg_undef(Undef, switch_body) ->
-    [switch_body, Undef];
-dbg_undef(Undef, {switch, Arg, Type, Alts, Catch}) ->
-    NewAlts   = [ dbg_undef(Undef, Alt) || Alt <- Alts ],
-    NewCatch  = dbg_undef(Undef, Catch),
-    NewSwitch = {switch, Arg, Type, NewAlts, NewCatch},
-    NewSwitch;
-dbg_undef(Undef, SCode) when is_list(SCode) ->
-    lists:droplast(SCode) ++ [dbg_undef(Undef, lists:last(SCode))];
-dbg_undef(Undef, SCode) when is_tuple(SCode); is_atom(SCode) ->
-    [Mnemonic | _] =
-        case is_tuple(SCode) of
-            true  -> tuple_to_list(SCode);
-            false -> [SCode]
-        end,
-    Op = aeb_fate_opcodes:m_to_op(Mnemonic),
-    case aeb_fate_opcodes:end_bb(Op) of
-        true  -> [Undef, SCode];
-        false -> [SCode, Undef]
-    end.
-
 %% -- Phase II ---------------------------------------------------------------
 %%  Optimize
 
@@ -942,10 +886,6 @@ attributes(I) ->
         loop                                  -> Impure(pc, []);
         switch_body                           -> Pure(none, []);
         'RETURN'                              -> Impure(pc, []);
-        {'DBG_LOC', _, _}                     -> Impure(none, []);
-        {'DBG_DEF', _, _}                     -> Impure(none, []);
-        {'DBG_UNDEF', _, _}                   -> Impure(none, []);
-        {'DBG_CONTRACT', _}                   -> Impure(none, []);
         {'RETURNR', A}                        -> Impure(pc, A);
         {'CALL', A}                           -> Impure(?a, [A]);
         {'CALL_R', A, _, B, C, D}             -> Impure(?a, [A, B, C, D]);
@@ -1141,15 +1081,10 @@ independent({i, _, I}, {i, _, J}) ->
     StackI = lists:member(?a, [WI | RI]),
     StackJ = lists:member(?a, [WJ | RJ]),
 
-    ReadStoreI = [] /= [ x || {store, _} <- RI ],
-    ReadStoreJ = [] /= [ x || {store, _} <- RJ ],
-
     if  WI == pc; WJ == pc   -> false;     %% no jumps
         not (PureI or PureJ) -> false;     %% at least one is pure
         StackI and StackJ    -> false;     %% cannot both use the stack
         WI == WJ             -> false;     %% cannot write to the same register
-        ReadStoreI and not PureJ -> false;  %% can't read store/state if other is impure
-        ReadStoreJ and not PureI -> false;  %% can't read store/state if other is impure
         true                 ->
             %% and cannot write to each other's inputs
             not lists:member(WI, RJ) andalso
@@ -1670,23 +1605,7 @@ bb(_Name, Code) ->
     Blocks  = lists:flatmap(fun split_calls/1, Blocks1),
     Labels  = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]),
     BBs     = [ set_labels(Labels, B) || B <- Blocks ],
-    maps:from_list(dbg_loc_filter(BBs)).
+    maps:from_list(BBs).
-
-%% Filter DBG_LOC instructions to keep one instruction per line
-dbg_loc_filter(BBs) ->
-    dbg_loc_filter(BBs, [], [], sets:new()).
-
-dbg_loc_filter([], _, AllBlocks, _) ->
-    lists:reverse(AllBlocks);
-dbg_loc_filter([{I, []} | Rest], AllOps, AllBlocks, DbgLocs) ->
-    dbg_loc_filter(Rest, [], [{I, lists:reverse(AllOps)} | AllBlocks], DbgLocs);
-dbg_loc_filter([{I, [Op = {'DBG_LOC', _, _} | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) ->
-    case sets:is_element(Op, DbgLocs) of
-        true  -> dbg_loc_filter([{I, Ops} | Rest], AllOps, AllBlocks, DbgLocs);
-        false -> dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, sets:add_element(Op, DbgLocs))
-    end;
-dbg_loc_filter([{I, [Op | Ops]} | Rest], AllOps, AllBlocks, DbgLocs) ->
-    dbg_loc_filter([{I, Ops} | Rest], [Op | AllOps], AllBlocks, DbgLocs).
 
 %% -- Break up scode into basic blocks --
 

src/aeso_parser.erl

@@ -8,22 +8,17 @@
 -export([string/1,
          string/2,
          string/3,
-         auto_imports/1,
-         hash_include/2,
          decl/0,
          type/0,
          body/0,
          maybe_block/1,
-         run_parser/2,
+         run_parser/2]).
-         run_parser/3]).
 
 -include("aeso_parse_lib.hrl").
 -import(aeso_parse_lib, [current_file/0, set_current_file/1,
                          current_include_type/0, set_current_include_type/1]).
 
--type parse_result() :: aeso_syntax:ast() | {aeso_syntax:ast(), sets:set(include_hash())} | none().
+-type parse_result() :: aeso_syntax:ast() | none().
-
--type include_hash() :: {string(), binary()}.
 
 
 escape_errors({ok, Ok}) ->
@@ -31,32 +26,21 @@ escape_errors({ok, Ok}) ->
 escape_errors({error, Err}) ->
     parse_error(Err).
 
--spec string(string()) -> parse_result().
+-spec module(string()) -> parse_result().
-string(String) ->
+module(String) ->
-    string(String, sets:new(), []).
+    module(String, []).
 
--spec string(string(), aeso_compiler:options()) -> parse_result().
+-spec module(string(), aeso_compiler:options()) -> parse_result().
-string(String, Opts) ->
+module(String, Opts) ->
-    case lists:keyfind(src_file, 1, Opts) of
-        {src_file, File} -> string(String, sets:add_element(File, sets:new()), Opts);
-        false -> string(String, sets:new(), Opts)
-    end.
-
--spec string(string(), sets:set(include_hash()), aeso_compiler:options()) -> parse_result().
-string(String, Included, Opts) ->
     AST = run_parser(file(), String, Opts),
-    case expand_includes(AST, Included, Opts) of
+    add_auto_imports(AST).
-        {ok, AST1}   -> AST1;
-        {error, Err} -> parse_error(Err)
-    end.
-
 
 run_parser(P, Inp) ->
-    escape_errors(parse_and_scan(P, Inp, [])).
+    escape_errors(scan_and_parse(P, Inp, [])).
 run_parser(P, Inp, Opts) ->
-    escape_errors(parse_and_scan(P, Inp, Opts)).
+    escape_errors(scan_and_parse(P, Inp, Opts)).
 
-parse_and_scan(P, S, Opts) ->
+scan_and_parse(P, S, Opts) ->
     set_current_file(proplists:get_value(src_file, Opts, no_file)),
     set_current_include_type(proplists:get_value(include_type, Opts, none)),
     case aeso_scan:scan(S) of
@@ -560,6 +544,9 @@ pos_ann(Line, Col) ->
     , {line, Line}
     , {col, Col} ].
 
+top_ann() ->
+    pos_ann(0, 0).
+
 ann_pos(Ann) ->
     {proplists:get_value(file, Ann),
      proplists:get_value(line, Ann),
@@ -681,107 +668,13 @@ bad_expr_err(Reason, E) ->
 
 %% -- Helper functions -------------------------------------------------------
 
-expand_includes(AST, Included, Opts) ->
+add_auto_imports(AST) ->
     Ann  = [{origin, system}],
-    AST1 = [ {include, Ann, {string, Ann, File}}
+    [ {using, Ann, {con, Ann, Import}}
-             || File <- lists:usort(auto_imports(AST)) ] ++ AST,
+      || Import <- lists:usort(auto_imports(AST)) ] ++ AST.
-    expand_includes(AST1, Included, [], Opts).
 
-expand_includes([], Included, Acc, Opts) ->
+auto_imports({comprehension_bind, _, _}) -> ["ListInternal"];
-    case lists:member(keep_included, Opts) of
+auto_imports({'..', _})                  -> ["ListInternal"];
-        false ->
-            {ok, lists:reverse(Acc)};
-        true ->
-            {ok, {lists:reverse(Acc), Included}}
-    end;
-expand_includes([{include, Ann, {string, _SAnn, File}} | AST], Included, Acc, Opts) ->
-    case get_include_code(File, Ann, Opts) of
-        {ok, Code} ->
-            Hashed = hash_include(File, Code),
-            case sets:is_element(Hashed, Included) of
-                false ->
-                    SrcFile = proplists:get_value(src_file, Opts, no_file),
-                    IncludeType = case proplists:get_value(file, Ann) of
-                                      SrcFile -> direct;
-                                      _       -> indirect
-                                  end,
-                    Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}),
-                    Opts2 = lists:keystore(include_type, 1, Opts1, {include_type, IncludeType}),
-                    Included1 = sets:add_element(Hashed, Included),
-                    case parse_and_scan(file(), Code, Opts2) of
-                        {ok, AST1} ->
-                            expand_includes(AST1 ++ AST, Included1, Acc, Opts);
-                        Err = {error, _} ->
-                            Err
-                    end;
-                true ->
-                    expand_includes(AST, Included, Acc, Opts)
-            end;
-        Err = {error, _} ->
-            Err
-    end;
-expand_includes([E | AST], Included, Acc, Opts) ->
-    expand_includes(AST, Included, [E | Acc], Opts).
-
-read_file(File, Opts) ->
-    case proplists:get_value(include, Opts, {explicit_files, #{}}) of
-        {file_system, Paths} ->
-            CandidateNames = [ filename:join(Dir, File) || Dir <- Paths ],
-            lists:foldr(fun(F, {error, _}) -> file:read_file(F);
-                           (_F, OK) -> OK end, {error, not_found}, CandidateNames);
-        {explicit_files, Files} ->
-            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() ->
-    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
-        {{ok, Bin}, {ok, _}} ->
-            case filename:basename(File) == File of
-                true -> { error
-                        , fail( ann_pos(Ann)
-                              , "Illegal redefinition of standard library " ++ binary_to_list(File))};
-                %% If a path is provided then the stdlib takes lower priority
-                false -> {ok, binary_to_list(Bin)}
-            end;
-        {_, {ok, Bin}} ->
-            {ok, binary_to_list(Bin)};
-        {{ok, Bin}, _} ->
-            {ok, binary_to_list(Bin)};
-        {_, _} ->
-            {error, {ann_pos(Ann), include_error, File}}
-    end.
-
--spec hash_include(string() | binary(), string()) -> include_hash().
-hash_include(File, Code) when is_binary(File) ->
-    hash_include(binary_to_list(File), Code);
-hash_include(File, Code) when is_list(File) ->
-    {filename:basename(File), crypto:hash(sha256, Code)}.
-
-auto_imports({comprehension_bind, _, _}) -> [<<"ListInternal.aes">>];
-auto_imports({'..', _})                  -> [<<"ListInternal.aes">>];
 auto_imports(L) when is_list(L) ->
     lists:flatmap(fun auto_imports/1, L);
 auto_imports(T) when is_tuple(T) ->

src/aeso_pretty.erl

@@ -526,4 +526,3 @@ get_elifs(If = {'if', Ann, Cond, Then, Else}, Elifs) ->
         _    -> {lists:reverse(Elifs), If}
     end;
 get_elifs(Else, Elifs) -> {lists:reverse(Elifs), {else, Else}}.
-

src/aeso_syntax.erl

@@ -10,23 +10,23 @@
 
 -export([get_ann/1, get_ann/2, get_ann/3, set_ann/2, qualify/2]).
 
--export_type([ann_file/0, ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
+-export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
 -export_type([name/0, id/0, con/0, qid/0, qcon/0, tvar/0, op/0]).
 -export_type([bin_op/0, un_op/0]).
--export_type([decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
+-export_type([top_decl/0, decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
 -export_type([arg/0, field_t/0, constructor_t/0, named_arg_t/0]).
 -export_type([type/0, constant/0, expr/0, arg_expr/0, field/1, stmt/0, alt/0, lvalue/0, elim/0, pat/0]).
 -export_type([ast/0]).
 
--type ast() :: [decl()].
+-type ast() :: [top_decl()].
 
 -type ann_line()   :: integer().
 -type ann_col()    :: integer().
 -type ann_origin() :: system | user.
 -type ann_format() :: '?:' | hex | infix | prefix | elif.
--type ann_file()   :: string() | no_file.
 
--type ann() :: [ {file, ann_file()} | {line, ann_line()} | {col, ann_col()} | {format, ann_format()} | {origin, ann_origin()}
+-type ann() :: [ {line, ann_line()} | {col, ann_col()} | {file, ann_file()}
+               | {format, ann_format()} | {origin, ann_origin()}
                | stateful | private | payable | main | interface | entrypoint].
 
 -type name() :: string().
@@ -39,20 +39,31 @@
 -type namespace_alias() :: none | con().
 -type namespace_parts() :: none | {for, [id()]} | {hiding, [id()]}.
 
--type decl() :: {contract_main, ann(), con(), [con()], [decl()]}
+% Can't be toplevel
-              | {contract_child, ann(), con(), [con()], [decl()]}
+-type scoped_decl()
-              | {contract_interface, ann(), con(), [con()], [decl()]}
+ :: {contract_decl, ann(), con()}
-              | {namespace, ann(), con(), [decl()]}
+  | {namespace_decl, ann(), con()}
-              | {include, ann(), {string, ann(), string()}}
-              | {pragma, ann(), pragma()}
   | {type_decl, ann(), id(), [tvar()]} % Only for error msgs
   | {type_def, ann(), id(), [tvar()], typedef()}
   | {fun_clauses, ann(), id(), type(), [letfun() | fundecl()]}
-              | {block, ann(), [decl()]}
+  | {block, ann(), [scoped_decl()]}
-              | {using, ann(), con(), namespace_alias(), namespace_parts()}
   | fundecl()
   | letfun()
-              | letval(). % Only for error msgs
+  | letval() % Only for error msgs
+  | decl().
+
+% Toplevel, can be nested
+-type decl()
+:: {contract_main, ann(), con(), [con()], [scoped_decl()]}
+ | {contract_child, ann(), con(), [con()], [scoped_decl()]}
+ | {contract_interface, ann(), con(), [con()], [scoped_decl()]}
+ | {namespace, ann(), con(), [scoped_decl()]}
+ | {using, ann(), con(), namespace_alias(), namespace_parts()}.
+
+% Toplevel only
+-type top_decl()
+ :: {pragma, ann(), pragma()}
+  | decl().
 
 -type compiler_version() :: [non_neg_integer()].
 

src/aeso_syntax_utils.erl

@@ -31,13 +31,11 @@
             | aeso_syntax:field(aeso_syntax:expr())
             | aeso_syntax:stmt().
 fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
-    ExprKind = if K == bind_expr -> bind_expr; true -> expr end,
-    TypeKind = if K == bind_type -> bind_type; true -> type end,
     Sum  = fun(Xs) -> lists:foldl(Plus, Zero, Xs) end,
     Same = fun(A) -> fold(Alg, Fun, K, A) end,
     Decl = fun(D) -> fold(Alg, Fun, decl, D) end,
-    Type = fun(T) -> fold(Alg, Fun, TypeKind, T) end,
+    Type = fun(T) -> fold(Alg, Fun, type, T) end,
-    Expr = fun(E) -> fold(Alg, Fun, ExprKind, E) end,
+    Expr = fun(E) -> fold(Alg, Fun, expr, E) end,
     BindExpr = fun(P) -> fold(Alg, Fun, bind_expr, P) end,
     BindType = fun(T) -> fold(Alg, Fun, bind_type, T) end,
     Top = Fun(K, X),
@@ -157,3 +155,4 @@ used(D) ->
                (_, _)             -> #{}
             end, decl, D)),
     lists:filter(NotBound, Xs).
+

src/aesophia.app.src

@@ -1,6 +1,6 @@
 {application, aesophia,
  [{description, "Compiler for Aeternity Sophia language"},
-  {vsn, "7.3.0"},
+  {vsn, "7.1.0"},
   {registered, []},
   {applications,
    [kernel,

test/aeso_compiler_tests.erl

@@ -222,7 +222,6 @@ compilable_contracts() ->
      "unapplied_contract_call",
      "unapplied_named_arg_builtin",
      "resolve_field_constraint_by_arity",
-     "toplevel_constants",
      "test" % Custom general-purpose test file. Keep it last on the list.
     ].
 
@@ -287,11 +286,7 @@ warnings() ->
       <<?PosW(48, 5)
         "Unused return value.">>,
       <<?PosW(60, 5)
-        "The function `dec` is defined but never used.">>,
+        "The function `dec` is defined but never used.">>
-      <<?PosW(73, 9)
-        "The definition of `const` shadows an older definition at line 70, column 3.">>,
-      <<?PosW(84, 7)
-        "The constant `c` is defined but never used.">>
      ]).
 
 failing_contracts() ->
@@ -663,6 +658,10 @@ 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(toplevel_let,
+                  [<<?Pos(2, 7)
+                     "Toplevel \"let\" definitions are not supported. "
+                     "Value `this_is_illegal` could be replaced by 0-argument function.">>])
     , ?TYPE_ERROR(empty_typedecl,
                   [<<?Pos(2, 8)
                      "Empty type declarations are not supported. "
@@ -860,21 +859,17 @@ failing_contracts() ->
                    <<?Pos(48, 5)
                      "Unused return value.">>,
                    <<?Pos(60, 5)
-                     "The function `dec` is defined but never used.">>,
+                     "The function `dec` is defined but never used.">>
-                   <<?Pos(73, 9)
-                     "The definition of `const` shadows an older definition at line 70, column 3.">>,
-                   <<?Pos(84, 7)
-                     "The constant `c` is defined but never used.">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_interface_recursive,
                   [<<?Pos(1,24)
                      "Trying to implement or extend an undefined interface `Z`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_interface_same_name_different_type,
-                  [<<?Pos(5,5)
+                  [<<?Pos(9,5)
-                     "Cannot unify `char` and `int`\n"
+                     "Duplicate definitions of `f` at\n"
-                     "when implementing the entrypoint `f` from the interface `I1`">>
+                     "  - line 8, column 5\n"
-                  ])
+                     "  - line 9, column 5">>])
     , ?TYPE_ERROR(polymorphism_contract_missing_implementation,
                   [<<?Pos(4,20)
                      "Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">>
@@ -1198,74 +1193,6 @@ failing_contracts() ->
                    <<?Pos(13,20)
                      "Found a hole of type `'a`">>
                   ])
-    , ?TYPE_ERROR(toplevel_constants_contract_as_namespace,
-                  [<<?Pos(5,13)
-                     "Invalid use of the contract constant `G.const`.\n"
-                     "Toplevel contract constants can only be used in the contracts where they are defined.">>,
-                   <<?Pos(10,11)
-                     "Record type `G` does not have field `const`">>,
-                   <<?Pos(10,11)
-                     "Unbound field const">>,
-                   <<?Pos(11,11)
-                     "Record type `G` does not have field `const`">>,
-                   <<?Pos(11,11)
-                     "Unbound field const">>
-                  ])
-    , ?TYPE_ERROR(toplevel_constants_cycles,
-                  [<<?Pos(2,21)
-                     "Unbound variable `selfcycle`">>,
-                   <<?Pos(4,5)
-                     "Mutual recursion detected between the constants\n"
-                     "  - `cycle1` at line 4, column 5\n"
-                     "  - `cycle2` at line 5, column 5\n"
-                     "  - `cycle3` at line 6, column 5">>
-                  ])
-    , ?TYPE_ERROR(toplevel_constants_in_interface,
-                  [<<?Pos(2,10)
-                     "The name of the compile-time constant cannot have pattern matching">>,
-                   <<?Pos(3,5)
-                     "Cannot define toplevel constants inside a contract interface">>,
-                   <<?Pos(4,5)
-                     "Cannot define toplevel constants inside a contract interface">>
-                  ])
-    , ?TYPE_ERROR(toplevel_constants_invalid_expr,
-                  [<<?Pos(10,9)
-                     "Invalid expression in the definition of the constant `c01`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(11,9)
-                     "Invalid expression in the definition of the constant `c02`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(12,9)
-                     "Invalid expression in the definition of the constant `c03`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(13,9)
-                     "Invalid expression in the definition of the constant `c04`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(14,9)
-                     "Invalid expression in the definition of the constant `c05`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(17,9)
-                     "Invalid expression in the definition of the constant `c07`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(18,9)
-                     "Invalid expression in the definition of the constant `c08`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(19,9)
-                     "Invalid expression in the definition of the constant `c09`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(20,9)
-                     "Invalid expression in the definition of the constant `c10`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>,
-                   <<?Pos(21,9)
-                     "Invalid expression in the definition of the constant `c11`\n"
-                     "You can only use the following expressions as constants: literals, lists, tuples, maps, and other constants">>
-                  ])
-    , ?TYPE_ERROR(toplevel_constants_invalid_id,
-                  [<<?Pos(2,9)
-                     "The name of the compile-time constant cannot have pattern matching">>,
-                   <<?Pos(3,9)
-                     "The name of the compile-time constant cannot have pattern matching">>
-                  ])
     ].
 
 validation_test_() ->
@@ -1313,9 +1240,7 @@ validate(Contract1, Contract2) ->
                   true  -> [debug_mode];
                   false -> []
               end ++
-                  [ {src_file, lists:concat([Contract2, ".aes"])}
+                  [{include, {file_system, [aeso_test_utils:contract_path()]}}]);
-                  , {include, {file_system, [aeso_test_utils:contract_path()]}}
-                  ]);
         Error -> print_and_throw(Error)
     end.
 

test/contracts/all_syntax.aes

@@ -6,7 +6,6 @@
 namespace Ns =
   datatype d('a) = D | S(int) | M('a, list('a), int)
   private function fff() = 123
-  let const = 1
 
   stateful entrypoint
     f (1, x) = (_) => x
@@ -34,8 +33,6 @@ contract AllSyntax =
 
   type state = shakespeare(int)
 
-  let cc = "str"
-
   entrypoint init() = {
     johann = 1000,
     wolfgang = -10,

test/contracts/toplevel_constants.aes

@@ -1,64 +0,0 @@
-namespace N0 =
-    let nsconst = 1
-
-namespace N =
-    let nsconst = N0.nsconst
-
-contract C =
-    datatype event = EventX(int, string)
-
-    record account = { name    : string,
-                       balance : int }
-
-    let c01 = 2425
-    let c02 = -5
-    let c03 = ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt
-    let c04 = true
-    let c05 = Bits.none
-    let c06 = #fedcba9876543210
-    let c07 = "str"
-    let c08 = [1, 2, 3]
-    let c09 = [(true, 24), (false, 19), (false, -42)]
-    let c10 = (42, "Foo", true)
-    let c11 = { name = "str", balance = 100000000 }
-    let c12 = {["foo"] = 19, ["bar"] = 42}
-    let c13 = Some(42)
-    let c14 = 11 : int
-    let c15 = EventX(0, "Hello")
-    let c16 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f
-    let c17 = #000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f000102030405060708090a0b0c0d0e0f
-    let c18 = RelativeTTL(50)
-    let c19 = ok_2YNyxd6TRJPNrTcEDCe9ra59SVUdp9FR9qWC5msKZWYD9bP9z5
-    let c20 = oq_2oRvyowJuJnEkxy58Ckkw77XfWJrmRgmGaLzhdqb67SKEL1gPY
-    let c21 = ct_Ez6MyeTMm17YnTnDdHTSrzMEBKmy7Uz2sXu347bTDPgVH2ifJ : C
-    let c22 = N.nsconst
-    let c23 = c01
-    let c24 = c11.name
-    let c25 : int = 1
-
-    entrypoint f01() = c01
-    entrypoint f02() = c02
-    entrypoint f03() = c03
-    entrypoint f04() = c04
-    entrypoint f05() = c05
-    entrypoint f06() = c06
-    entrypoint f07() = c07
-    entrypoint f08() = c08
-    entrypoint f09() = c09
-    entrypoint f10() = c10
-    entrypoint f11() = c11
-    entrypoint f12() = c12
-    entrypoint f13() = c13
-    entrypoint f14() = c14
-    entrypoint f15() = c15
-    entrypoint f16() = c16
-    entrypoint f17() = c17
-    entrypoint f18() = c18
-    entrypoint f19() = c19
-    entrypoint f20() = c20
-    entrypoint f21() = c21
-    entrypoint f22() = c22
-    entrypoint f23() = c23
-    entrypoint f24() = c24
-    entrypoint f25() = c25
-    entrypoint fqual() = C.c01

test/contracts/toplevel_constants_contract_as_namespace.aes

@@ -1,11 +0,0 @@
-contract G =
-    let const = 1
-
-main contract C =
-    let c = G.const
-
-    stateful entrypoint f() =
-        let g = Chain.create() : G
-
-        g.const
-        g.const()

test/contracts/toplevel_constants_cycles.aes

@@ -1,6 +0,0 @@
-contract C =
-    let selfcycle = selfcycle
-
-    let cycle1 = cycle2
-    let cycle2 = cycle3
-    let cycle3 = cycle1

test/contracts/toplevel_constants_in_interface.aes

@@ -1,7 +0,0 @@
-contract interface I =
-    let (x::y::_) = [1,2,3]
-    let c = 10
-    let d = 10
-
-contract C =
-    entrypoint init() = ()

test/contracts/toplevel_constants_invalid_expr.aes

@@ -1,21 +0,0 @@
-main contract C =
-    record account = { name    : string,
-                       balance : int }
-
-    let one = 1
-    let opt = Some(5)
-    let acc = { name = "str", balance = 100000 }
-    let mpp = {["foo"] = 19, ["bar"] = 42}
-
-    let c01 = [x | x <- [1,2,3,4,5]]
-    let c02 = [x + k | x <- [1,2,3,4,5], let k = x*x]
-    let c03 = [x + y | x <- [1,2,3,4,5], let k = x*x, if (k > 5), y <- [k, k+1, k+2]]
-    let c04 = if (one > 2) 3 else 4
-    let c05 = switch (opt)
-                 Some(x) => x
-                 None => 2
-    let c07 = acc{ balance = one }
-    let c08 = mpp["foo"]
-    let c09 = mpp["non" = 10]
-    let c10 = mpp{["foo"] = 20}
-    let c11 = (x) => x + 1

test/contracts/toplevel_constants_invalid_id.aes

@@ -1,3 +0,0 @@
-contract C =
-    let x::_ = [1,2,3,4]
-    let y::(p = z::_) = [1,2,3,4]

test/contracts/toplevel_let.aes

@@ -0,0 +1,3 @@
+contract C =
+  let this_is_illegal = 2/0
+  entrypoint this_is_legal() = 2/0

test/contracts/warnings.aes

@@ -65,24 +65,3 @@ contract Remote =
 contract C = 
   payable stateful entrypoint
     call_missing_con() : int = (ct_1111111111111111111111111111112JF6Dz72 : Remote).id(value = 1, 0)
-
-namespace ShadowingConst =
-  let const = 1
-
-  function f() =
-    let const = 2
-    const
-
-namespace UnusedConstNamespace =
-  // No warnings should be shown even though const is not used
-  let const = 1
-
-contract UnusedConstContract =
-  // Only `c` should show a warning because it is never used in the contract
-  let a = 1
-  let b = 2
-  let c = 3
-
-  entrypoint f() =
-    // Both normal access and qualified access should prevent the unused const warning
-    a + UnusedConstContract.b