src/aeso_ast_infer_types.erl

@@ -87,7 +87,11 @@
 -type byte_constraint() :: {is_bytes, utype()}
                          | {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}.
 
--type constraint() :: named_argument_constraint() | field_constraint() | byte_constraint().
+-type aens_resolve_constraint() :: {aens_resolve_type, utype()}.
+-type oracle_type_constraint() :: {oracle_type, aeso_syntax:ann(), utype()}.
+
+-type constraint() :: named_argument_constraint() | field_constraint() | byte_constraint()
+                    | aens_resolve_constraint() | oracle_type_constraint().
 
 -record(field_info,
     { ann      :: aeso_syntax:ann()
@@ -1013,6 +1017,9 @@ infer_contract(Env0, What, Defs0, Options) ->
             contract           -> bind_state(Env1)   %% bind state and put
         end,
     {ProtoSigs, Decls} = lists:unzip([ check_fundecl(Env1, Decl) || Decl <- Get(prototype, Defs) ]),
+    [ type_error({missing_definition, Id}) || {fun_decl, _, Id, _} <- Decls,
+                                              What =:= contract,
+                                              get_option(no_code, false) =:= false ],
     Env3      = bind_funs(ProtoSigs, Env2),
     Functions = Get(function, Defs),
     %% Check for duplicates in Functions (we turn it into a map below)
@@ -1027,8 +1034,10 @@ infer_contract(Env0, What, Defs0, Options) ->
     {Env4, Defs1} = check_sccs(Env3, FunMap, SCCs, []),
     %% Remove namespaces used in the current namespace
     Env5 = Env4#env{ used_namespaces = OldUsedNamespaces },
-    %% Check that `init` doesn't read or write the state
-    check_state_dependencies(Env4, Defs1),
+    %% Check that `init` doesn't read or write the state and that `init` is not missing
+    check_state(Env4, Defs1),
+    %% Check that entrypoints have first-order arg types and return types
+    check_entrypoints(Defs1),
     destroy_and_report_type_errors(Env4),
     %% Add inferred types of definitions
     {Env5, TypeDefs ++ Decls ++ Defs1}.
@@ -1095,6 +1104,7 @@ check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs], Acc) ->
     case maps:get(Name, TypeMap, undefined) of
         undefined -> check_typedef_sccs(Env, TypeMap, SCCs, Acc);    %% Builtin type
         {type_def, Ann, D, Xs, Def0} ->
+            check_parameterizable(D, Xs),
             Def  = check_event(Env, Name, Ann, check_typedef(bind_tvars(Xs, Env), Def0)),
             Acc1 = [{type_def, Ann, D, Xs, Def} | Acc],
             Env1 = bind_type(Name, Ann, {Xs, Def}, Env),
@@ -1350,6 +1360,13 @@ check_fields(Env, TypeMap, RecTy, [{field_t, Ann, Id, Type} | Fields]) ->
     Env1 = bind_field(name(Id), #field_info{ ann = Ann, kind = record, field_t = Type, record_t = RecTy }, Env),
     check_fields(Env1, TypeMap, RecTy, Fields).
 
+check_parameterizable({id, Ann, "event"}, [_ | _]) ->
+    type_error({parameterized_event, Ann});
+check_parameterizable({id, Ann, "state"}, [_ | _]) ->
+    type_error({parameterized_state, Ann});
+check_parameterizable(_Name, _Xs) ->
+    ok.
+
 check_event(Env, "event", Ann, Def) ->
     case Def of
         {variant_t, Cons} ->
@@ -1612,8 +1629,51 @@ check_stateful_named_arg(#env{ stateful = false, current_function = Fun }, {id,
     end;
 check_stateful_named_arg(_, _, _) -> ok.
 
-%% Check that `init` doesn't read or write the state
-check_state_dependencies(Env, Defs) ->
+check_entrypoints(Defs) ->
+    [ ensure_first_order_entrypoint(LetFun)
+      || LetFun <- Defs,
+         aeso_syntax:get_ann(entrypoint, LetFun, false) ].
+
+ensure_first_order_entrypoint({letfun, Ann, Id = {id, _, Name}, Args, Ret, _}) ->
+    [ ensure_first_order(ArgType, {higher_order_entrypoint, AnnArg, Id, {argument, ArgId, ArgType}})
+      || {typed, AnnArg, ArgId, ArgType} <- Args ],
+    [ ensure_first_order(Ret, {higher_order_entrypoint, Ann, Id, {result, Ret}})
+      || Name /= "init" ],  %% init can return higher-order values, since they're written to the store
+                            %% rather than being returned.
+    ok.
+
+ensure_first_order(Type, Err) ->
+    is_first_order(Type) orelse type_error(Err).
+
+is_first_order({fun_t, _, _, _, _})    -> false;
+is_first_order(Ts) when is_list(Ts)    -> lists:all(fun is_first_order/1, Ts);
+is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
+is_first_order(_)                      -> true.
+
+ensure_monomorphic(Type, Err) ->
+    is_monomorphic(Type) orelse type_error(Err).
+
+is_monomorphic({tvar, _, _})           -> false;
+is_monomorphic(Ts) when is_list(Ts)    -> lists:all(fun is_monomorphic/1, Ts);
+is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
+is_monomorphic(_)                      -> true.
+
+check_state_init(Env) ->
+    Top = Env#env.namespace,
+    StateType = lookup_type(Env, {id, [{origin, system}], "state"}),
+    case unfold_types_in_type(Env, StateType) of
+        false  ->
+            ok;
+        {_, {_, {_, {alias_t, {tuple_t, _, []}}}}} ->  %% type state = ()
+            ok;
+        _ ->
+            #scope{ ann = AnnCon } = get_scope(Env, Top),
+            type_error({missing_init_function, {con, AnnCon, lists:last(Top)}})
+    end.
+
+%% Check that `init` doesn't read or write the state and that `init` is defined
+%% when the state type is not unit
+check_state(Env, Defs) ->
     Top       = Env#env.namespace,
     GetState  = Top ++ ["state"],
     SetState  = Top ++ ["put"],
@@ -1622,7 +1682,7 @@ check_state_dependencies(Env, Defs) ->
     Funs      = [ {Top ++ [Name], Fun} || Fun = {letfun, _, {id, _, Name}, _Args, _Type, _GuardedBodies} <- Defs ],
     Deps      = maps:from_list([{Name, UsedNames(Def)} || {Name, Def} <- Funs]),
     case maps:get(Init, Deps, false) of
-        false -> ok;    %% No init, so nothing to check
+        false -> get_option(no_code, false) orelse check_state_init(Env);
         _     ->
             [ type_error({init_depends_on_state, state, Chain})
               || Chain <- get_call_chains(Deps, Init, GetState) ],
@@ -1764,12 +1824,17 @@ infer_expr(Env, {app, Ann, Fun, Args0} = App) ->
             NewFun0 = infer_expr(Env, Fun),
             NewArgs = [infer_expr(Env, A) || A <- Args],
             ArgTypes = [T || {typed, _, _, T} <- NewArgs],
-            NewFun1 = {typed, _, _, FunType} = infer_var_args_fun(Env, NewFun0, NamedArgs1, ArgTypes),
+            NewFun1 = {typed, _, FunName, FunType} = infer_var_args_fun(Env, NewFun0, NamedArgs1, ArgTypes),
             When = {infer_app, Fun, NamedArgs1, Args, FunType, ArgTypes},
             GeneralResultType = fresh_uvar(Ann),
             ResultType = fresh_uvar(Ann),
             unify(Env, FunType, {fun_t, [], NamedArgsVar, ArgTypes, GeneralResultType}, When),
             when_warning(warn_negative_spend, fun() -> warn_potential_negative_spend(Ann, NewFun1, NewArgs) end),
+            [ add_constraint({aens_resolve_type, GeneralResultType})
+              || element(3, FunName) =:= ["AENS", "resolve"] ],
+            [ add_constraint({oracle_type, Ann, OType})
+              || OType <- [get_oracle_type(FunName, ArgTypes, GeneralResultType)],
+                 OType =/= false ],
             add_constraint(
               #dependent_type_constraint{ named_args_t = NamedArgsVar,
                                           named_args   = NamedArgs1,
@@ -2290,11 +2355,19 @@ destroy_and_report_unsolved_constraints(Env) ->
                            (#named_argument_constraint{}) -> true;
                            (_)                            -> false
                         end, OtherCs2),
-    {BytesCs, []} =
+    {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 ],
@@ -2312,9 +2385,20 @@ destroy_and_report_unsolved_constraints(Env) ->
     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().
 
+get_oracle_type({qid, _, ["Oracle", "register"]},      _        , OType) -> OType;
+get_oracle_type({qid, _, ["Oracle", "query"]},        [OType| _], _    ) -> OType;
+get_oracle_type({qid, _, ["Oracle", "get_question"]}, [OType| _], _    ) -> OType;
+get_oracle_type({qid, _, ["Oracle", "get_answer"]},   [OType| _], _    ) -> OType;
+get_oracle_type({qid, _, ["Oracle", "check"]},        [OType| _], _    ) -> OType;
+get_oracle_type({qid, _, ["Oracle", "check_query"]},  [OType| _], _    ) -> OType;
+get_oracle_type({qid, _, ["Oracle", "respond"]},      [OType| _], _    ) -> OType;
+get_oracle_type(_Fun, _Args, _Ret) -> false.
+
 %% -- Named argument constraints --
 
 %% If false, a type error has been emitted, so it's safe to drop the constraint.
@@ -2441,6 +2525,32 @@ check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) ->
         _ -> 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;
@@ -3484,6 +3594,44 @@ mk_error({unimplemented_interface_function, ConId, InterfaceName, FunName}) ->
 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(Err) ->
     Msg = io_lib:format("Unknown error: ~p", [Err]),
     mk_t_err(pos(0, 0), Msg).

src/aeso_ast_to_fcode.erl

@@ -326,7 +326,7 @@ get_option(Opt, Env, Default) ->
 %% -- Compilation ------------------------------------------------------------
 
 -spec to_fcode(env(), aeso_syntax:ast()) -> {env(), fcode()}.
-to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, _Impls, Decls}|Rest])
+to_fcode(Env, [{Contract, Attrs, {con, _, Name}, _Impls, Decls}|Rest])
   when ?IS_CONTRACT_HEAD(Contract) ->
     case Contract =:= contract_interface of
         false ->
@@ -349,7 +349,7 @@ to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, _Impls, Decls}|Rest])
                           event_type    => EventType,
                           payable       => Payable,
                           functions     => add_init_function(
-                                             Env1, Con, StateType,
+                                             Env1,
                                              add_event_function(Env1, EventType, Funs)) },
             case Contract of
                 contract_main -> [] = Rest, {Env1, ConFcode};
@@ -362,8 +362,6 @@ to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, _Impls, Decls}|Rest])
             Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Name} }, Decls),
             to_fcode(Env1, Rest)
     end;
-to_fcode(_Env, [NotMain = {NotMainHead, _ ,_ , _}]) when NotMainHead =/= contract_def ->
-    fcode_error({last_declaration_must_be_main_contract, NotMain});
 to_fcode(Env, [{namespace, _, {con, _, Con}, Decls} | Code]) ->
     Env1 = decls_to_fcode(Env#{ context => {namespace, Con} }, Decls),
     to_fcode(Env1, Code).
@@ -377,22 +375,15 @@ decls_to_fcode(Env, Decls) ->
                 end, Env1, Decls).
 
 -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env().
-decl_to_fcode(Env = #{context := {contract_def, _}}, {fun_decl, _, Id, _}) ->
-    case is_no_code(Env) of
-        false -> fcode_error({missing_definition, Id});
-        true  -> Env
-    end;
 decl_to_fcode(Env, {fun_decl, _, _, _})  -> Env;
 decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) ->
     typedef_to_fcode(Env, Name, Args, Def);
-decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) ->
+decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) ->
     Attrs = get_attributes(Ann),
     FName = lookup_fun(Env, qname(Env, Name)),
     FArgs = args_to_fcode(Env, Args),
     FRet  = type_to_fcode(Env, Ret),
     FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body),
-    [ ensure_first_order_entrypoint(Ann, Id, Args, Ret, FArgs, FRet)
-      || aeso_syntax:get_ann(entrypoint, Ann, false) ],
     Def   = #{ attrs  => Attrs,
                args   => FArgs,
                return => FRet,
@@ -401,8 +392,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Ar
     Env#{ functions := NewFuns }.
 
 -spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> env().
-typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) ->
-    check_state_and_event_types(Env, Id, Xs),
+typedef_to_fcode(Env, {id, _, Name}, Xs, Def) ->
     Q = qname(Env, Name),
     FDef = fun(Args) when length(Args) == length(Xs) ->
                 Sub = maps:from_list(lists:zip([X || {tvar, _, X} <- Xs], Args)),
@@ -466,14 +456,6 @@ compute_state_layout(R, [H | T]) ->
 compute_state_layout(R, _) ->
     {R + 1, {reg, R}}.
 
-check_state_and_event_types(#{ context := {contract_def, _} }, Id, [_ | _]) ->
-    case Id of
-        {id, _, "state"} -> fcode_error({parameterized_state, Id});
-        {id, _, "event"} -> fcode_error({parameterized_event, Id});
-        _                -> ok
-    end;
-check_state_and_event_types(_, _, _) -> ok.
-
 -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype().
 type_to_fcode(Env, Type) ->
     type_to_fcode(Env, #{}, Type).
@@ -491,8 +473,6 @@ type_to_fcode(Env, Sub, {record_t, Fields}) ->
     type_to_fcode(Env, Sub, {tuple_t, [], lists:map(FieldType, Fields)});
 type_to_fcode(_Env, _Sub, {bytes_t, _, N}) ->
     {bytes, N};
-type_to_fcode(_Env, _Sub, {tvar, Ann, "void"}) ->
-    fcode_error({found_void, Ann});
 type_to_fcode(_Env, Sub, {tvar, _, X}) ->
     maps:get(X, Sub, {tvar, X});
 type_to_fcode(_Env, _Sub, {fun_t, Ann, _, var_args, _}) ->
@@ -554,7 +534,7 @@ expr_to_fcode(_Env, _Type, {bytes,           _, B}) -> {lit, {bytes, B}};
 
 %% Variables
 expr_to_fcode(Env, _Type, {id, _, X})  -> resolve_var(Env, [X]);
-expr_to_fcode(Env, Type, {qid, Ann, X}) ->
+expr_to_fcode(Env, Type, {qid, _, X}) ->
     case resolve_var(Env, X) of
         {builtin_u, B, Ar} when B =:= oracle_query;
                                 B =:= oracle_get_question;
@@ -565,13 +545,11 @@ expr_to_fcode(Env, Type, {qid, Ann, X}) ->
                                 B =:= oracle_check_query ->
             OType = get_oracle_type(B, Type),
             {oracle, QType, RType} = type_to_fcode(Env, OType),
-            validate_oracle_type(Ann, OType, QType, RType),
             TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
             {builtin_u, B, Ar, TypeArgs};
         {builtin_u, B = aens_resolve, Ar} ->
             {fun_t, _, _, _, ResType} = Type,
             AensType = type_to_fcode(Env, ResType),
-            validate_aens_resolve_type(Ann, ResType, AensType),
             TypeArgs = [{lit, {typerep, AensType}}],
             {builtin_u, B, Ar, TypeArgs};
         {builtin_u, B = bytes_split, Ar} ->
@@ -824,53 +802,6 @@ get_oracle_type(oracle_check,        {fun_t, _, _, [OType | _], _}) -> OType;
 get_oracle_type(oracle_check_query,  {fun_t, _, _, [OType | _], _}) -> OType;
 get_oracle_type(oracle_respond,      {fun_t, _, _, [OType | _], _}) -> OType.
 
-validate_oracle_type(Ann, Type, QType, RType) ->
-    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}),
-    ok.
-
-validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]}) ->
-    case FType of
-        string         -> ok;
-        address        -> ok;
-        contract       -> ok;
-        {oracle, _, _} -> ok;
-        oracle_query   -> ok;
-        _              -> fcode_error({invalid_aens_resolve_type, Ann, Type})
-    end.
-
-ensure_first_order_entrypoint(Ann, Id = {id, _, Name}, Args, Ret, FArgs, FRet) ->
-    [ ensure_first_order(FT, {invalid_entrypoint, higher_order, Ann1, Id, {argument, X, T}})
-      || {{typed, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ],
-    [ ensure_first_order(FRet, {invalid_entrypoint, higher_order, Ann, Id, {result, Ret}})
-      || Name /= "init" ],  %% init can return higher-order values, since they're written to the store
-                            %% rather than being returned.
-    ok.
-
-ensure_monomorphic(Type, Err) ->
-    case is_monomorphic(Type) of
-        true  -> ok;
-        false -> fcode_error(Err)
-    end.
-
-ensure_first_order(Type, Err) ->
-    case is_first_order(Type) of
-        true  -> ok;
-        false -> fcode_error(Err)
-    end.
-
-is_monomorphic({tvar, _})              -> false;
-is_monomorphic(Ts) when is_list(Ts)    -> lists:all(fun is_monomorphic/1, Ts);
-is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
-is_monomorphic(_)                      -> true.
-
-is_first_order({function, _, _})       -> false;
-is_first_order(Ts) when is_list(Ts)    -> lists:all(fun is_first_order/1, Ts);
-is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
-is_first_order(_)                      -> true.
-
 %% -- Pattern matching --
 
 -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()], aeso_syntax:expr()) -> fsplit().
@@ -1203,11 +1134,11 @@ builtin_to_fcode(_Layout, Builtin, Args) ->
 
 %% -- Init function --
 
-add_init_function(Env, Main, StateType, Funs0) ->
+add_init_function(Env, Funs0) ->
     case is_no_code(Env) of
         true  -> Funs0;
         false ->
-            Funs     = add_default_init_function(Env, Main, StateType, Funs0),
+            Funs     = add_default_init_function(Env, Funs0),
             InitName = {entrypoint, <<"init">>},
             InitFun  = #{ body := InitBody} = maps:get(InitName, Funs),
             Funs1 = Funs#{ InitName => InitFun#{ return => {tuple, []},
@@ -1215,16 +1146,14 @@ add_init_function(Env, Main, StateType, Funs0) ->
             Funs1
     end.
 
-add_default_init_function(_Env, Main, StateType, Funs) ->
+add_default_init_function(_Env, Funs) ->
     InitName = {entrypoint, <<"init">>},
     case maps:get(InitName, Funs, none) of
-        %% Only add default init function if state is unit.
-        none when StateType == {tuple, []} ->
+        none ->
             Funs#{ InitName => #{attrs  => [],
                                  args   => [],
                                  return => {tuple, []},
                                  body   => {tuple, []}} };
-        none -> fcode_error({missing_init_function, Main});
         _    -> Funs
     end.
 
@@ -2090,7 +2019,9 @@ setnth(I, X, Xs) ->
 -dialyzer({nowarn_function, [fcode_error/1, internal_error/1]}).
 
 fcode_error(Error) ->
-    aeso_errors:throw(aeso_code_errors:format(Error)).
+    Pos = aeso_errors:pos(0, 0),
+    Msg = lists:flatten(io_lib:format("Unknown error: ~p\n", [Error])),
+    aeso_errors:throw(aeso_errors:new(code_error, Pos, Msg)).
 
 internal_error(Error) ->
     Msg = lists:flatten(io_lib:format("~p\n", [Error])),

src/aeso_code_errors.erl

@@ -1,94 +0,0 @@
-%%%-------------------------------------------------------------------
-%%% @author Ulf Norell
-%%% @copyright (C) 2019, Aeternity Anstalt
-%%% @doc
-%%%     Formatting of code generation errors.
-%%% @end
-%%%
-%%%-------------------------------------------------------------------
--module(aeso_code_errors).
-
--export([format/1, pos/1]).
-
-format({last_declaration_must_be_main_contract, Decl = {Kind, _, {con, _, C}, _}}) ->
-    Msg = io_lib:format("Expected a main contract as the last declaration instead of the ~p '~s'",
-                        [Kind, C]),
-    mk_err(pos(Decl), Msg);
-format({missing_init_function, Con}) ->
-    Msg = io_lib:format("Missing init function for the contract '~s'.", [pp_expr(Con)]),
-    Cxt = "The 'init' function can only be omitted if the state type is 'unit'.",
-    mk_err(pos(Con), Msg, Cxt);
-format({missing_definition, Id}) ->
-    Msg = io_lib:format("Missing definition of function '~s'.", [pp_expr(Id)]),
-    mk_err(pos(Id), Msg);
-format({parameterized_state, Decl}) ->
-    Msg = "The state type cannot be parameterized.",
-    mk_err(pos(Decl), Msg);
-format({parameterized_event, Decl}) ->
-    Msg = "The event type cannot be parameterized.",
-    mk_err(pos(Decl), Msg);
-format({invalid_entrypoint, Why, Ann, {id, _, Name}, Thing}) ->
-    What = case Why of higher_order -> "higher-order (contains function types)";
-                       polymorphic  -> "polymorphic (contains type variables)" end,
-    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(2, 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]),
-    case Why of
-        higher_order -> mk_err(pos(Ann), Msg)
-    end;
-format({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(2, T)]),
-    mk_err(pos(Ann), Msg);
-format({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(2, Type)]),
-    Cxt = io_lib:format("The ~s type must not be ~s.", [What, WhyS]),
-    mk_err(pos(Ann), Msg, Cxt);
-format({var_args_not_set, Expr}) ->
-    mk_err( pos(Expr), "Could not deduce type of variable arguments list"
-          , "When compiling " ++ pp_expr(Expr)
-          );
-format({found_void, Ann}) ->
-    mk_err(pos(Ann), "Found a void-typed value.", "`void` is a restricted, uninhabited type. Did you mean `unit`?");
-
-format(Err) ->
-    mk_err(aeso_errors:pos(0, 0), io_lib:format("Unknown error: ~p\n", [Err])).
-
-pos(Ann) ->
-    File = aeso_syntax:get_ann(file, Ann, no_file),
-    Line = aeso_syntax:get_ann(line, Ann, 0),
-    Col  = aeso_syntax:get_ann(col, Ann, 0),
-    aeso_errors:pos(File, Line, Col).
-
-pp_typed(E, T) ->
-    prettypr:format(prettypr:nest(2,
-    lists:foldr(fun prettypr:beside/2, prettypr:empty(),
-                [aeso_pretty:expr(E), prettypr:text(" : "),
-                 aeso_pretty:type(T)]))).
-
-pp_expr(E) ->
-    pp_expr(0, E).
-
-pp_expr(N, E) ->
-    prettypr:format(prettypr:nest(N, aeso_pretty:expr(E))).
-
-pp_type(N, T) ->
-    prettypr:format(prettypr:nest(N, aeso_pretty:type(T))).
-
-mk_err(Pos, Msg) ->
-    aeso_errors:new(code_error, Pos, lists:flatten(Msg)).
-
-mk_err(Pos, Msg, Cxt) ->
-    aeso_errors:new(code_error, Pos, lists:flatten(Msg), lists:flatten(Cxt)).
-

src/aeso_compiler.erl

@@ -349,7 +349,7 @@ get_decode_type(FunName, [{Contract, Ann, _, _, Defs}]) when ?IS_CONTRACT_HEAD(C
                 "init" -> {ok, [], {tuple_t, [], []}};
                  _ ->
                     Msg = io_lib:format("Function '~s' is missing in contract", [FunName]),
-                    Pos = aeso_code_errors:pos(Ann),
+                    Pos = aeso_errors:pos(Ann),
                     aeso_errors:throw(aeso_errors:new(data_error, Pos, Msg))
             end
     end;

src/aeso_errors.erl

@@ -34,6 +34,7 @@
         , new/2
         , new/3
         , new/4
+        , pos/1
         , pos/2
         , pos/3
         , pp/1
@@ -53,6 +54,12 @@ new(Type, Pos, Msg) ->
 new(Type, Pos, Msg, Ctxt) ->
     #err{ type = Type, pos = Pos, message = Msg, context = Ctxt }.
 
+pos(Ann) ->
+    File = aeso_syntax:get_ann(file, Ann, no_file),
+    Line = aeso_syntax:get_ann(line, Ann, 0),
+    Col  = aeso_syntax:get_ann(col, Ann, 0),
+    pos(File, Line, Col).
+
 pos(Line, Col) ->
     #pos{ line = Line, col = Col }.
 

src/aeso_fcode_to_fate.erl

@@ -64,7 +64,9 @@ debug(Tag, Options, Fun) ->
 
 -dialyzer({nowarn_function, [code_error/1]}).
 code_error(Err) ->
-    aeso_errors:throw(aeso_code_errors:format(Err)).
+    Pos = aeso_errors:pos(0, 0),
+    Msg = lists:flatten(io_lib:format("Unknown error: ~p\n", [Err])),
+    aeso_errors:throw(aeso_errors:new(code_error, Pos, Msg)).
 
 %% -- Main -------------------------------------------------------------------
 

test/aeso_aci_tests.erl

@@ -127,7 +127,7 @@ check_stub(Stub, Options) ->
         Ast ->
             try
                 %% io:format("AST: ~120p\n", [Ast]),
-                aeso_ast_infer_types:infer(Ast, [])
+                aeso_ast_infer_types:infer(Ast, [no_code])
             catch throw:{type_errors, TE} ->
                 io:format("Type error:\n~s\n", [TE]),
                 error(TE);

test/aeso_calldata_tests.erl

@@ -29,7 +29,7 @@ calldata_aci_test_() ->
      [ {"Testing " ++ ContractName ++ " contract calling " ++ Fun,
         fun() ->
            ContractString       = aeso_test_utils:read_contract(ContractName),
-           {ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString),
+           {ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString, [no_code]),
            ContractACI = binary_to_list(ContractACIBin),
            io:format("ACI:\n~s\n", [ContractACIBin]),
            FateExprs = ast_exprs(ContractACI, Fun, Args),

test/aeso_compiler_tests.erl

@@ -45,12 +45,6 @@ simple_compile_test_() ->
            check_errors(ExpectedErrors, Errors)
        end} ||
            {ContractName, ExpectedErrors} <- failing_contracts() ] ++
-    [ {"Testing code generation error messages of " ++ ContractName,
-       fun() ->
-               Errors = compile(ContractName),
-               check_errors([ExpectedError], Errors)
-       end} ||
-           {ContractName, ExpectedError} <- failing_code_gen_contracts()] ++
     [ {"Testing include with explicit files",
        fun() ->
            FileSystem = maps:from_list(
@@ -208,6 +202,18 @@ compilable_contracts() ->
      "polymorphism_contract_interface_extensions",
      "polymorphism_contract_interface_same_decl_multi_interface",
      "polymorphism_contract_interface_same_name_same_type",
+     "missing_init_fun_state_unit",
+     "complex_compare_leq",
+     "complex_compare",
+     "higher_order_compare",
+     "higher_order_map_keys",
+     "higher_order_state",
+     "polymorphic_compare",
+     "polymorphic_entrypoint",
+     "polymorphic_entrypoint_return",
+     "polymorphic_map_keys",
+     "unapplied_contract_call",
+     "unapplied_named_arg_builtin",
      "test" % Custom general-purpose test file. Keep it last on the list.
     ].
 
@@ -289,34 +295,26 @@ failing_contracts() ->
 
     %% Type errors
     , ?TYPE_ERROR(name_clash,
-       [<<?Pos(14, 3)
+       [<<?Pos(4, 3)
+          "Duplicate definitions of `double_def` at\n"
+          "  - line 3, column 3\n"
+          "  - line 4, column 3">>,
+        <<?Pos(7, 3)
           "Duplicate definitions of `abort` at\n"
           "  - (builtin location)\n"
-          "  - line 14, column 3">>,
-        <<?Pos(15, 3)
+          "  - line 7, column 3">>,
+        <<?Pos(8, 3)
           "Duplicate definitions of `require` at\n"
           "  - (builtin location)\n"
-          "  - line 15, column 3">>,
-        <<?Pos(11, 3)
-          "Duplicate definitions of `double_def` at\n"
-          "  - line 10, column 3\n"
-          "  - line 11, column 3">>,
-        <<?Pos(5, 3)
-          "Duplicate definitions of `double_proto` at\n"
-          "  - line 4, column 3\n"
-          "  - line 5, column 3">>,
-        <<?Pos(8, 3)
-          "Duplicate definitions of `proto_and_def` at\n"
-          "  - line 7, column 3\n"
           "  - line 8, column 3">>,
-        <<?Pos(16, 3)
+        <<?Pos(9, 3)
           "Duplicate definitions of `put` at\n"
           "  - (builtin location)\n"
-          "  - line 16, column 3">>,
-        <<?Pos(17, 3)
+          "  - line 9, column 3">>,
+        <<?Pos(10, 3)
           "Duplicate definitions of `state` at\n"
           "  - (builtin location)\n"
-          "  - line 17, column 3">>])
+          "  - line 10, column 3">>])
     , ?TYPE_ERROR(type_errors,
        [<<?Pos(17, 23)
           "Unbound variable `zz`">>,
@@ -981,7 +979,8 @@ failing_contracts() ->
                      "when checking the type of the pattern `r10 : rec_inv(Animal)` against the expected type `Main.rec_inv(Cat)`">>,
                    <<?Pos(41,13)
                      "Cannot unify `Animal` and `Cat` in a invariant context\n"
-                     "when checking the type of the pattern `r11 : rec_inv(Cat)` against the expected type `Main.rec_inv(Animal)`">>])
+                     "when checking the type of the pattern `r11 : rec_inv(Cat)` against the expected type `Main.rec_inv(Animal)`">>
+                  ])
     , ?TYPE_ERROR(polymorphism_variance_switching_oracles,
                   [<<?Pos(15,13)
                      "Cannot unify `Cat` and `Animal` in a contravariant context\n"
@@ -1024,58 +1023,92 @@ failing_contracts() ->
                      "when checking the type of the pattern `q14 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Animal, Cat)`">>,
                    <<?Pos(44,13)
                      "Cannot unify `Animal` and `Cat` in a covariant context\n"
-                     "when checking the type of the pattern `q15 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Cat, Animal)`">>])
-    ].
-
--define(Path(File), "code_errors/" ??File).
--define(Msg(File, Line, Col, Err), <<?Pos("Code generation", ?Path(File), Line, Col) Err>>).
-
--define(FATE_ERR(File, Line, Col, Err), {?Path(File), ?Msg(File, Line, Col, Err)}).
-
-failing_code_gen_contracts() ->
-    [ ?FATE_ERR(missing_definition, 2, 14,
-            "Missing definition of function 'foo'.")
-    , ?FATE_ERR(higher_order_entrypoint, 2, 20,
-            "The argument\n"
-            "  f : (int) => int\n"
-            "of entrypoint 'apply' has a higher-order (contains function types) type.")
-    , ?FATE_ERR(higher_order_entrypoint_return, 2, 3,
-            "The return type\n"
-            "  (int) => int\n"
-            "of entrypoint 'add' is higher-order (contains function types).")
-    , ?FATE_ERR(missing_init_function, 1, 10,
-            "Missing init function for the contract 'MissingInitFunction'.\n"
-            "The 'init' function can only be omitted if the state type is 'unit'.")
-    , ?FATE_ERR(parameterised_state, 3, 8,
-            "The state type cannot be parameterized.")
-    , ?FATE_ERR(parameterised_event, 3, 12,
-            "The event type cannot be parameterized.")
-    , ?FATE_ERR(polymorphic_aens_resolve, 4, 5,
-            "Invalid return type of AENS.resolve:\n"
-            "  'a\n"
-            "It must be a string or a pubkey type (address, oracle, etc).")
-    , ?FATE_ERR(bad_aens_resolve, 6, 5,
-            "Invalid return type of AENS.resolve:\n"
-            "  list(int)\n"
-            "It must be a string or a pubkey type (address, oracle, etc).")
-    , ?FATE_ERR(polymorphic_query_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle('a, 'b)\n"
-            "The query type must not be polymorphic (contain type variables).")
-    , ?FATE_ERR(polymorphic_response_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle(string, 'r)\n"
-            "The response type must not be polymorphic (contain type variables).")
-    , ?FATE_ERR(higher_order_query_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle((int) => int, string)\n"
-            "The query type must not be higher-order (contain function types).")
-    , ?FATE_ERR(higher_order_response_type, 3, 5,
-            "Invalid oracle type\n"
-            "  oracle(string, (int) => int)\n"
-            "The response type must not be higher-order (contain function types).")
-    , ?FATE_ERR(child_with_decls, 2, 14,
-            "Missing definition of function 'f'.")
+                     "when checking the type of the pattern `q15 : oracle_query(Cat, Cat)` against the expected type `oracle_query(Cat, Animal)`">>
+                  ])
+    , ?TYPE_ERROR(missing_definition,
+                  [<<?Pos(2,14)
+                     "Missing definition of function `foo`">>
+                  ])
+    , ?TYPE_ERROR(child_with_decls,
+                  [<<?Pos(2,14)
+                     "Missing definition of function `f`">>
+                  ])
+    , ?TYPE_ERROR(parameterised_state,
+                  [<<?Pos(3,8)
+                     "The state type cannot be parameterized">>
+                  ])
+    , ?TYPE_ERROR(parameterised_event,
+                  [<<?Pos(3,12)
+                     "The event type cannot be parameterized">>
+                  ])
+    , ?TYPE_ERROR(missing_init_fun_alias_to_type,
+                  [<<?Pos(1,10)
+                     "Missing `init` function for the contract `AliasToType`.\n"
+                     "The `init` function can only be omitted if the state type is `unit`">>
+                  ])
+    , ?TYPE_ERROR(missing_init_fun_alias_to_alias_to_type,
+                  [<<?Pos(1,10)
+                     "Missing `init` function for the contract `AliasToAliasToType`.\n"
+                     "The `init` function can only be omitted if the state type is `unit`">>
+                  ])
+    , ?TYPE_ERROR(higher_order_entrypoint,
+                  [<<?Pos(2,20)
+                     "The argument\n"
+                     "  `f : (int) => int`\n"
+                     "of entrypoint `apply` has a higher-order (contains function types) type">>
+                  ])
+    , ?TYPE_ERROR(higher_order_entrypoint_return,
+                  [<<?Pos(2,3)
+                     "The return type\n"
+                     "  `(int) => int`\n"
+                     "of entrypoint `add` is higher-order (contains function types)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_aens_resolve,
+                  [<<?Pos(4,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `'a`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(bad_aens_resolve,
+                  [<<?Pos(6,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `list(int)`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(bad_aens_resolve_using,
+                  [<<?Pos(7,5)
+                     "Invalid return type of `AENS.resolve`:\n"
+                     "  `list(int)`\n"
+                     "It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_query_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle('a, 'b)`\n"
+                     "The query type must not be polymorphic (contain type variables)">>,
+                   <<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle('a, 'b)`\n"
+                     "The response type must not be polymorphic (contain type variables)">>
+                  ])
+    , ?TYPE_ERROR(polymorphic_response_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle(string, 'r)`\n"
+                     "The response type must not be polymorphic (contain type variables)">>
+                  ])
+    , ?TYPE_ERROR(higher_order_query_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle((int) => int, string)`\n"
+                     "The query type must not be higher-order (contain function types)">>
+                  ])
+    , ?TYPE_ERROR(higher_order_response_type,
+                  [<<?Pos(3,5)
+                     "Invalid oracle type\n"
+                     "  `oracle(string, (int) => int)`\n"
+                     "The response type must not be higher-order (contain function types)">>
+                  ])
     ].
 
 validation_test_() ->

test/contracts/aens.aes

@@ -1,5 +1,7 @@
+contract C = entrypoint init() = ()
+
 // AENS tests
-contract AENSTest =
+main contract AENSTest =
 
   // Name resolution
 
@@ -9,10 +11,19 @@ contract AENSTest =
   stateful entrypoint resolve_string(name : string, key : string) : option(string) =
     AENS.resolve(name, key)
 
+  stateful entrypoint resolve_contract(name : string, key : string) : option(C) =
+    AENS.resolve(name, key)
+
+  stateful entrypoint resolve_oracle(name : string, key : string) : option(oracle(int, int)) =
+    AENS.resolve(name, key)
+
+  stateful entrypoint resolve_oracle_query(name : string, key : string) : option(oracle_query(int, int)) =
+    AENS.resolve(name, key)
+
   // Transactions
 
   stateful entrypoint preclaim(addr  : address,     // Claim on behalf of this account (can be Contract.address)
-                             chash : hash) : unit = // Commitment hash
+                               chash : hash) : unit = // Commitment hash
     AENS.preclaim(addr, chash)
 
   stateful entrypoint signedPreclaim(addr  : address, // Claim on behalf of this account (can be Contract.address)

test/contracts/bad_aens_resolve_using.aes

@@ -0,0 +1,9 @@
+contract BadAENSresolve =
+  using AENS
+
+  type t('a) = option(list('a))
+
+  function fail() : t(int) =
+    resolve("foo.aet", "whatever")
+
+  entrypoint main_fun() = ()

test/contracts/code_errors/missing_init_function.aes

@@ -1,3 +0,0 @@
-contract MissingInitFunction =
-  type state = int * int
-

test/contracts/missing_init_fun_alias_to_alias_to_type.aes

@@ -0,0 +1,3 @@
+contract AliasToAliasToType =
+  type alias = int * int
+  type state = alias

test/contracts/missing_init_fun_alias_to_type.aes

@@ -0,0 +1,2 @@
+contract AliasToType =
+  type state = int * int

test/contracts/missing_init_fun_state_unit.aes

@@ -0,0 +1,9 @@
+contract AliasToAliasToUnit =
+  type alias = unit
+  type state = alias
+
+contract AliasToUnit =
+  type state = unit
+
+main contract ImplicitState =
+    type sometype = int

test/contracts/name_clash.aes

@@ -1,12 +1,5 @@
-
 contract NameClash =
 
-  entrypoint double_proto : () => int
-  entrypoint double_proto : () => int
-
-  entrypoint proto_and_def : int => int
-  entrypoint proto_and_def(n) = n + 1
-
   entrypoint double_def(x) = x
   entrypoint double_def(y) = 0
 
@@ -14,4 +7,4 @@ contract NameClash =
   entrypoint abort() : int = 0
   entrypoint require(b, err) = if(b) abort(err)
   entrypoint put(x) = x
-  entrypoint state(x, y) = x + y
+  entrypoint state(x, y) = x + y