Prepare release v7.4.0 (#487)

* Name lambdas by their locations

* changelog

CHANGELOG.md

@@ -10,6 +10,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Removed
 ### Fixed
 
+## [7.4.0]
+### Changed
+- Names of lifted lambdas now consist of parent function's name and their
+  position in the source code.
+### Fixed
+- Lifted lambdas get their names assigned deterministically.
+
+## [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
@@ -399,7 +411,9 @@ 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.2.1...HEAD
+[Unreleased]: https://github.com/aeternity/aesophia/compare/v7.4.0...HEAD
+[7.4.0]: https://github.com/aeternity/aesophia/compare/v7.3.0...v7.4.0
+[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

rebar.config

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

src/aeso_ast_infer_types.erl

@@ -154,7 +154,6 @@
     , in_pattern       = false              :: boolean()
     , in_guard         = false              :: boolean()
     , stateful         = false              :: boolean()
-    , unify_throws     = true               :: boolean()
     , current_const    = none               :: none | aeso_syntax:id()
     , current_function = none               :: none | aeso_syntax:id()
     , what             = top                :: top | namespace | contract | contract_interface
@@ -1582,7 +1581,7 @@ check_reserved_entrypoints(Funs) ->
 check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type = {fun_t, _, _, _, _}}) ->
     Type1 = {fun_t, _, Named, Args, Ret} = check_type(Env, Type),
     TypeSig = {type_sig, Ann, none, Named, Args, Ret},
-    register_implementation(Id, TypeSig),
+    register_implementation(Env, Id, TypeSig),
     {{Name, TypeSig}, {fun_decl, Ann, Id, Type1}};
 check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) ->
     type_error({fundecl_must_have_funtype, Ann, Id, Type}),
@@ -1590,13 +1589,16 @@ check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) ->
 
 %% Register the function FunId as implemented by deleting it from the functions
 %% to be implemented table if it is included there, or return true otherwise.
--spec register_implementation(FunId, FunSig) -> true | no_return() when
+-spec register_implementation(env(), FunId, FunSig) -> true | no_return() when
       FunId :: aeso_syntax:id(),
       FunSig :: typesig().
-register_implementation(Id, Sig) ->
+register_implementation(Env, Id, Sig) ->
     Name = name(Id),
     case ets_lookup(functions_to_implement, Name) of
-        [{Name, Interface, Decl = {fun_decl, _, DeclId, _}}] ->
+        [{Name, Interface, Decl = {fun_decl, _, DeclId, FunT}}] ->
+            When = {implement_interface_fun, aeso_syntax:get_ann(Sig), Name, name(Interface)},
+            unify(Env, typesig_to_fun_t(Sig), FunT, When),
+
             DeclStateful   = aeso_syntax:get_ann(stateful,   Decl, false),
             DeclPayable    = aeso_syntax:get_ann(payable,    Decl, false),
 
@@ -1624,7 +1626,7 @@ infer_nonrec(Env, LetFun) ->
     create_constraints(),
     NewLetFun = {{_, Sig}, _} = infer_letfun(Env, LetFun),
     check_special_funs(Env, NewLetFun),
-    register_implementation(get_letfun_id(LetFun), Sig),
+    register_implementation(Env, get_letfun_id(LetFun), Sig),
     solve_then_destroy_and_report_unsolved_constraints(Env),
     Result = {TypeSig, _} = instantiate(NewLetFun),
     print_typesig(TypeSig),
@@ -1654,11 +1656,11 @@ infer_letrec(Env, Defs) ->
     Inferred =
         [ begin
             Res    = {{Name, TypeSig}, LetFun} = infer_letfun(ExtendEnv, LF),
-            register_implementation(get_letfun_id(LetFun), TypeSig),
+            register_implementation(Env, get_letfun_id(LetFun), TypeSig),
             Got    = proplists:get_value(Name, Funs),
             Expect = typesig_to_fun_t(TypeSig),
             unify(Env, Got, Expect, {check_typesig, Name, Got, Expect}),
-            solve_constraints(Env),
+            solve_all_constraints(Env),
             ?PRINT_TYPES("Checked ~s : ~s\n",
                          [Name, pp(dereference_deep(Got))]),
             Res
@@ -2573,61 +2575,118 @@ get_constraints() ->
 destroy_constraints() ->
     ets_delete(constraints).
 
--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()),
+%% Solve all constraints by iterating until no-progress
 
-    % The two passes on AmbiguousConstraints are needed
-    solve_ambiguous_constraints(Env, AmbiguousConstraints ++ AmbiguousConstraints).
+-spec solve_all_constraints(env()) -> ok.
+solve_all_constraints(Env) ->
+    Constraints = [C || C <- get_constraints(), not one_shot_field_constraint(Env, C) ],
+    solve_constraints_top(Env, Constraints).
 
--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);
+solve_constraints_top(Env, Constraints) ->
+    UnsolvedCs = solve_constraints(Env, Constraints),
+    Progress   = solve_unknown_record_constraints(Env, UnsolvedCs),
+
+    if length(UnsolvedCs) < length(Constraints) orelse Progress == true ->
+        solve_constraints_top(Env, UnsolvedCs);
        true ->
-            case solve_unknown_record_types(Env, Unknown) of
-                true -> %% Progress!
-                    solve_ambiguous_constraints(Env, Unknown);
-                _ -> ok %% No progress. Report errors later.
-            end
+        ok
     end.
 
+-spec solve_constraints(env(), [constraint()]) -> [constraint()].
+solve_constraints(Env, Constraints) ->
+    [ C1 || C <- Constraints, C1 <- [dereference_deep(C)], not solve_constraint(Env, C1) ].
+
+solve_unknown_record_constraints(Env, Constraints) ->
+    FieldCs      = lists:filter(fun(#field_constraint{record_t = {uvar, _, _}}) -> true; (_) -> false end, Constraints),
+    FieldCsUVars = lists:usort([UVar || #field_constraint{record_t = UVar = {uvar, _, _}} <- FieldCs]),
+
+    FieldConstraint = fun(#field_constraint{ field = F, kind = K, context = Ctx }) -> {K, Ctx, F} end,
+    FieldsForUVar = fun(UVar) ->
+                        [ FieldConstraint(FC) || FC = #field_constraint{record_t = U} <- FieldCs, U == UVar ]
+                    end,
+
+
+    Solutions = [ solve_for_uvar(Env, UVar, FieldsForUVar(UVar)) || UVar <- FieldCsUVars ],
+    case lists:member(true, Solutions) of
+        true  -> true;
+        false -> Solutions
+    end.
+
+%% -- Simple constraints --
+%% Returns true if solved (unified or type error)
+solve_constraint(_Env, #field_constraint{record_t = {uvar, _, _}}) ->
+    false;
+solve_constraint(Env, #field_constraint{record_t = RecordType,
+                                              field    = Field = {id, _As, FieldName},
+                                              field_t  = FieldType,
+                                              context  = When}) ->
+    RecId = record_type_name(RecordType),
+    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],
+            case proplists:get_value(FieldName, FieldTypes) of
+                undefined ->
+                    type_error({missing_field, Field, RecId});
+                FldType ->
+                    solve_field_constraint(Env, FieldType, FldType, RecordType, app_t(Attrs, RecId, Formals), When)
+            end;
+        _ ->
+            type_error({not_a_record_type, instantiate(RecordType), When})
+    end,
+    true;
+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, _}) -> false;
+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});
+        _ -> false
+    end;
+solve_constraint(_, _) -> false.
+
+one_shot_field_constraint(Env, #field_constraint{record_t = RecordType,
+                                                 field    = Field = {id, _As, 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}),
+            true;
+        [#field_info{field_t = FldType, record_t = RecType}] ->
+            solve_field_constraint(Env, FieldType, FldType, RecordType, RecType, When),
+            true;
+        _ ->
+            false
+    end;
+one_shot_field_constraint(_Env, _Constraint) ->
+    false.
+
+
+solve_field_constraint(Env, FieldType, FldType, RecordType, RecType, When) ->
+    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}).
+
 solve_then_destroy_and_report_unsolved_constraints(Env) ->
-    solve_constraints(Env),
+    solve_all_constraints(Env),
     destroy_and_report_unsolved_constraints(Env).
 
 destroy_and_report_unsolved_constraints(Env) ->
@@ -2658,21 +2717,10 @@ destroy_and_report_unsolved_constraints(Env) ->
                            (_)                   -> 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_field_constraints(Env, FieldCs),
     check_record_create_constraints(Env, CreateCs),
     check_is_contract_constraints(Env, ContractCs),
+    check_named_args_constraints(Env, NamedArgCs),
     check_bytes_constraints(Env, BytesCs),
     check_aens_resolve_constraints(Env, AensResolveCs),
     check_oracle_type_constraints(Env, OracleTypeCs),
@@ -2690,20 +2738,21 @@ 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.
--spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false | unsolved.
+%% True if solved (unified or type error), false otherwise
+-spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false.
 check_named_argument_constraint(_Env, #named_argument_constraint{ args = {uvar, _, _} }) ->
-    unsolved;
+    false;
 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;
+            type_error({bad_named_argument, Args, Id});
+        [T] ->
+            unify(Env, T, Type, {check_named_arg_constraint, C})
+    end,
+    true;
 check_named_argument_constraint(Env,
         #dependent_type_constraint{ named_args_t = NamedArgsT0,
                                     named_args = NamedArgs,
@@ -2720,10 +2769,11 @@ check_named_argument_constraint(Env,
             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.
+            unify(Env, GenType1, SpecType, {check_expr, App, GenType1, SpecType});
+        _ ->
+            unify(Env, GenType, SpecType, {check_expr, App, GenType, SpecType})
+    end,
+    true.
 
 specialize_dependent_type(Env, Type) ->
     case dereference(Type) of
@@ -2739,53 +2789,16 @@ specialize_dependent_type(Env, Type) ->
         _ -> Type   %% Currently no deep dependent types
     end.
 
-%% -- Bytes constraints --
+check_field_constraints(Env, Constraints) ->
+    UnsolvedFieldCs = solve_constraints(Env, Constraints),
+    case solve_unknown_record_constraints(Env, UnsolvedFieldCs) of
+        true   -> ok;
+        Errors -> [ type_error(Err) || Err <- Errors ]
+    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_named_args_constraints(Env, Constraints) ->
+    UnsolvedNamedArgCs = solve_constraints(Env, Constraints),
+    [ type_error({unsolved_named_argument_constraint, C}) || C <- UnsolvedNamedArgCs ].
 
 check_bytes_constraints(Env, Constraints) ->
     InAddConstraint = [ T || {add_bytes, _, _, A, B, C} <- Constraints,
@@ -2882,30 +2895,6 @@ check_is_contract_constraints(Env, [C | Cs]) ->
     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).
-
 record_type_name({app_t, _Attrs, RecId, _Args}) when ?is_type_id(RecId) ->
     RecId;
 record_type_name(RecId) when ?is_type_id(RecId) ->
@@ -3084,16 +3073,12 @@ unify0(Env, A, B, Variance, When) ->
 unify1(_Env, {uvar, _, R}, {uvar, _, R}, _Variance, _When) ->
     true;
 unify1(_Env, {uvar, _, _}, {fun_t, _, _, var_args, _}, _Variance, When) ->
-    type_error({unify_varargs, When});
-unify1(Env, {uvar, A, R}, T, _Variance, When) ->
+    type_error({unify_varargs, When}),
+    false;
+unify1(_Env, {uvar, A, R}, T, _Variance, When) ->
     case occurs_check(R, T) of
         true ->
-            if
-                Env#env.unify_throws ->
-                    cannot_unify({uvar, A, R}, T, none, When);
-                true ->
-                    ok
-            end,
+            cannot_unify({uvar, A, R}, T, none, When),
             false;
         false ->
             ets_insert(type_vars, {R, T}),
@@ -3120,18 +3105,13 @@ unify1(Env, A = {con, _, NameA}, B = {con, _, NameB}, Variance, When) ->
     case is_subtype(Env, NameA, NameB, Variance) of
         true -> true;
         false ->
-            if
-                Env#env.unify_throws ->
-                    IsSubtype = is_subtype(Env, NameA, NameB, contravariant) orelse
-                                is_subtype(Env, NameA, NameB, covariant),
-                    Cxt = case IsSubtype of
-                              true  -> Variance;
-                              false -> none
-                          end,
-                    cannot_unify(A, B, Cxt, When);
-                true ->
-                    ok
-            end,
+            IsSubtype = is_subtype(Env, NameA, NameB, contravariant) orelse
+                        is_subtype(Env, NameA, NameB, covariant),
+            Cxt = case IsSubtype of
+                      true  -> Variance;
+                      false -> none
+                  end,
+            cannot_unify(A, B, Cxt, When),
             false
     end;
 unify1(_Env, {qid, _, Name}, {qid, _, Name}, _Variance, _When) ->
@@ -3145,9 +3125,11 @@ unify1(Env, {if_t, _, {id, _, Id}, Then1, Else1}, {if_t, _, {id, _, Id}, Then2,
     unify0(Env, Else1, Else2, Variance, When);
 
 unify1(_Env, {fun_t, _, _, _, _}, {fun_t, _, _, var_args, _}, _Variance, When) ->
-    type_error({unify_varargs, When});
+    type_error({unify_varargs, When}),
+    false;
 unify1(_Env, {fun_t, _, _, var_args, _}, {fun_t, _, _, _, _}, _Variance, When) ->
-    type_error({unify_varargs, When});
+    type_error({unify_varargs, When}),
+    false;
 unify1(Env, {fun_t, _, Named1, Args1, Result1}, {fun_t, _, Named2, Args2, Result2}, Variance, When)
   when length(Args1) == length(Args2) ->
     unify0(Env, Named1, Named2, opposite_variance(Variance), When) andalso
@@ -3169,7 +3151,7 @@ unify1(Env, {tuple_t, _, As}, {tuple_t, _, Bs}, Variance, When)
   when length(As) == length(Bs) ->
     unify0(Env, As, Bs, Variance, When);
 unify1(Env, {named_arg_t, _, Id1, Type1, _}, {named_arg_t, _, Id2, Type2, _}, Variance, When) ->
-    unify1(Env, Id1, Id2, Variance, {arg_name, Id1, Id2, When}),
+    unify1(Env, Id1, Id2, Variance, {arg_name, Id1, Id2, When}) andalso
     unify1(Env, Type1, Type2, Variance, When);
 %% The grammar is a bit inconsistent about whether types without
 %% arguments are represented as applications to an empty list of
@@ -3178,13 +3160,8 @@ unify1(Env, {app_t, _, T, []}, B, Variance, When) ->
     unify0(Env, T, B, Variance, When);
 unify1(Env, A, {app_t, _, T, []}, Variance, When) ->
     unify0(Env, A, T, Variance, When);
-unify1(Env, A, B, _Variance, When) ->
-    if
-        Env#env.unify_throws ->
-            cannot_unify(A, B, none, When);
-        true ->
-            ok
-    end,
+unify1(_Env, A, B, _Variance, When) ->
+    cannot_unify(A, B, none, When),
     false.
 
 is_subtype(_Env, NameA, NameB, invariant) ->
@@ -4117,8 +4094,8 @@ pp_when({if_branches, Then, ThenType0, Else, 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 ] ])};
+                   "~s", [string:join([ io_lib:format("~s (at ~s)", [pp_typed("  - ", B, BType), pp_loc(B)])
+                                       || {B, BType} <- Branches ], "\n")])};
 pp_when({case_pat, Pat, PatType0, ExprType0}) ->
     {PatType, ExprType} = instantiate({PatType0, ExprType0}),
     {pos(Pat),
@@ -4165,6 +4142,10 @@ pp_when({var_args, Ann, Fun}) ->
     {pos(Ann)
     , io_lib:format("when resolving arguments of variadic function `~s`", [pp_expr(Fun)])
     };
+pp_when({implement_interface_fun, Ann, Entrypoint, Interface}) ->
+    { pos(Ann)
+    , io_lib:format("when implementing the entrypoint `~s` from the interface `~s`", [Entrypoint, Interface])
+    };
 pp_when(unknown) -> {pos(0,0), ""}.
 
 -spec pp_why_record(why_record()) -> {pos(), iolist()}.

src/aeso_ast_to_fcode.erl

@@ -58,7 +58,10 @@
               | {contract_code, string()} %% for CREATE, by name
               | {typerep, ftype()}.
 
--type fann() :: [ {file, aeso_syntax:ann_file()} | {line, aeso_syntax:ann_line()} ].
+-type fann() :: [ {file, aeso_syntax:ann_file()} |
+                  {line, aeso_syntax:ann_line()} |
+                  {col, aeso_syntax:ann_col()}
+                ].
 
 -type fexpr() :: {lit, fann(), flit()}
                | {nil, fann()}
@@ -387,11 +390,23 @@ to_fcode(Env, [{namespace, _, {con, _, Con}, Decls} | Code]) ->
     Env1 = decls_to_fcode(Env#{ context => {namespace, Con} }, Decls),
     to_fcode(Env1, Code).
 
+-spec ann_loc(aeso_syntax:ann() | fann()) -> {File, Line, Column} when
+      File   :: string() | none,
+      Line   :: non_neg_integer() | none,
+      Column :: non_neg_integer() | none.
+ann_loc(Ann) ->
+    File = proplists:get_value(file, Ann, none),
+    Line = proplists:get_value(line, Ann, none),
+    Col  = proplists:get_value(col, Ann, none),
+    {File, Line, Col}.
+
 -spec to_fann(aeso_syntax:ann()) -> fann().
 to_fann(Ann) ->
-    File = proplists:lookup(file, Ann),
-    Line = proplists:lookup(line, Ann),
-    [ X || X <- [File, Line], X =/= none ].
+    {File, Line, Col} = ann_loc(Ann),
+    [ {Tag, X} ||
+        {Tag, X} <- [{file, File}, {line, Line}, {col, Col}],
+        X =/= none, X =/= no_file
+    ].
 
 -spec get_fann(fexpr()) -> fann().
 get_fann(FExpr) -> element(2, FExpr).
@@ -1276,10 +1291,13 @@ event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {vari
 
 -spec lambda_lift(fcode()) -> fcode().
 lambda_lift(FCode = #{ functions := Funs, state_layout := StateLayout }) ->
-    init_lambda_funs(),
-    Funs1   = maps:map(fun(_, Body) -> lambda_lift_fun(StateLayout, Body) end, Funs),
-    NewFuns = get_lambda_funs(),
-    FCode#{ functions := maps:merge(Funs1, NewFuns) }.
+    NewFuns =
+        [ {FunName, FunDef}
+          || {ParentName, ParentDef} <- maps:to_list(Funs),
+             {NewParentDef, Lambdas} <- [lambda_lift_fun(StateLayout, ParentName, ParentDef)],
+             {FunName, FunDef} <- [{ParentName, NewParentDef} | maps:to_list(Lambdas)]
+        ],
+    FCode#{ functions := maps:from_list(NewFuns) }.
 
 -define(lambda_key, '%lambdalifted').
 
@@ -1289,16 +1307,35 @@ init_lambda_funs() -> put(?lambda_key, #{}).
 -spec get_lambda_funs() -> term().
 get_lambda_funs()  -> erase(?lambda_key).
 
--spec add_lambda_fun(fun_def()) -> fun_name().
-add_lambda_fun(Def) ->
-    Name = fresh_fun(),
+-spec add_lambda_fun(fun_name(), fann(), fun_def()) -> fun_name().
+add_lambda_fun(Parent, FAnn, Def) ->
     Funs = get(?lambda_key),
-    put(?lambda_key, Funs#{ Name => Def }),
+    LambdaId = maps:get({fresh, Parent}, Funs, 0),
+    Name = lambda_name(FAnn, LambdaId, Parent),
+    put(?lambda_key, Funs#{ Name => Def, {fresh, Parent} => LambdaId + 1}),
     Name.
 
--spec lambda_lift_fun(state_layout(), fun_def()) -> fun_def().
-lambda_lift_fun(Layout, Def = #{ body := Body }) ->
-    Def#{ body := lambda_lift_expr(Layout, Body) }.
+-spec lambda_name(fann(), non_neg_integer(), fun_name()) -> fun_name().
+lambda_name(FAnn, Id, PName) ->
+    PSName = case PName of
+                 {entrypoint, N} -> [binary_to_list(N)];
+                 {local_fun, Ns} -> Ns
+             end,
+    {_File, Line, Col} = ann_loc(FAnn),
+    Name = PSName ++
+           [ "%lambda"
+           , if is_integer(Line) -> integer_to_list(Line); true -> "" end
+           , if is_integer(Col) -> integer_to_list(Col); true -> "" end
+           , integer_to_list(Id)],
+    {local_fun, Name}.
+
+-spec lambda_lift_fun(state_layout(), fun_name(), fun_def()) -> {fun_def(), #{var_name() => term()}}.
+lambda_lift_fun(Layout, Name, Def = #{ body := Body }) ->
+    %% Not thread safe! We initialize state per functions not to depend on the order in which
+    %% functions are processed.
+    init_lambda_funs(),
+    NewDef = Def#{ body := lambda_lift_expr(Layout, Name, Body) },
+    {NewDef, get_lambda_funs()}.
 
 -spec lifted_fun([var_name()], [var_name()], fexpr()) -> fun_def().
 lifted_fun([Z], Xs, Body) ->
@@ -1316,21 +1353,20 @@ lifted_fun(FVs, Xs, Body) ->
        body   => lists:foldr(Proj, Body, indexed(FVs))
      }.
 
--spec make_closure([var_name()], [var_name()], fexpr()) -> Closure when
+-spec make_closure(fun_name(), fann(), [var_name()], [var_name()], fexpr()) -> Closure when
       Closure :: fexpr().
-make_closure(FVs, Xs, Body) ->
-    Fun   = add_lambda_fun(lifted_fun(FVs, Xs, Body)),
-    FAnn  = get_fann(Body),
+make_closure(ParentName, FAnn, FVs, Xs, Body) ->
+    Name  = add_lambda_fun(ParentName, FAnn, lifted_fun(FVs, Xs, Body)),
     Tup = fun([Y]) -> Y; (Ys) -> {tuple, FAnn, Ys} end,
-    {closure, FAnn, Fun, Tup([{var, FAnn, Y} || Y <- FVs])}.
+    {closure, FAnn, Name, Tup([{var, FAnn, Y} || Y <- FVs])}.
 
--spec lambda_lift_expr(state_layout(), fexpr()) -> Closure when
+-spec lambda_lift_expr(state_layout(), fun_name(), fexpr()) -> Closure when
       Closure :: fexpr().
-lambda_lift_expr(Layout, L = {lam, _, Xs, Body}) ->
+lambda_lift_expr(Layout, Name, L = {lam, FAnn, Xs, Body}) ->
     FVs   = free_vars(L),
-    make_closure(FVs, Xs, lambda_lift_expr(Layout, Body));
-lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u ->
-    [Tag, _, F, Ar | _] = tuple_to_list(UExpr),
+    make_closure(Name, FAnn, FVs, Xs, lambda_lift_expr(Layout, Name, Body));
+lambda_lift_expr(Layout, Name, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u ->
+    [Tag, FAnn, F, Ar | _] = tuple_to_list(UExpr),
     ExtraArgs = case UExpr of
                     {builtin_u, _, _, _, TypeArgs} -> TypeArgs;
                     _                              -> []
@@ -1341,41 +1377,41 @@ lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExp
                builtin_u -> builtin_to_fcode(Layout, get_fann(UExpr), F, Args);
                def_u     -> {def, get_fann(UExpr), F, Args}
            end,
-    make_closure([], Xs, Body);
-lambda_lift_expr(Layout, {remote_u, FAnn, ArgsT, RetT, Ct, F}) ->
+    make_closure(Name, FAnn, [], Xs, Body);
+lambda_lift_expr(Layout, Name, {remote_u, FAnn, ArgsT, RetT, Ct, F}) ->
     FVs  = free_vars(Ct),
-    Ct1  = lambda_lift_expr(Layout, Ct),
+    Ct1  = lambda_lift_expr(Layout, Name, Ct),
     NamedArgCount = 3,
     Xs   = [ lists:concat(["arg", I]) || I <- lists:seq(1, length(ArgsT) + NamedArgCount) ],
     Args = [{var, [], X} || X <- Xs],
-    make_closure(FVs, Xs, {remote, FAnn, ArgsT, RetT, Ct1, F, Args});
-lambda_lift_expr(Layout, Expr) ->
+    make_closure(Name, FAnn, FVs, Xs, {remote, FAnn, ArgsT, RetT, Ct1, F, Args});
+lambda_lift_expr(Layout, Name, Expr) ->
     case Expr of
         {lit, _, _}               -> Expr;
         {nil, _}                  -> Expr;
         {var, _, _}               -> Expr;
         {closure, _, _, _}        -> Expr;
-        {def, FAnn, D, As}        -> {def, FAnn, D, lambda_lift_exprs(Layout, As)};
-        {builtin, FAnn, B, As}    -> {builtin, FAnn, B, lambda_lift_exprs(Layout, As)};
-        {remote, FAnn, ArgsT, RetT, Ct, F, As} -> {remote, FAnn, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)};
-        {con, FAnn, Ar, C, As}    -> {con, FAnn, Ar, C, lambda_lift_exprs(Layout, As)};
-        {tuple, FAnn, As}         -> {tuple, FAnn, lambda_lift_exprs(Layout, As)};
-        {proj, FAnn, A, I}        -> {proj, FAnn, lambda_lift_expr(Layout, A), I};
-        {set_proj, FAnn, A, I, B} -> {set_proj, FAnn, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)};
-        {op, FAnn, Op, As}        -> {op, FAnn, Op, lambda_lift_exprs(Layout, As)};
-        {'let', FAnn, X, A, B}    -> {'let', FAnn, X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)};
-        {funcall, FAnn, A, Bs}    -> {funcall, FAnn, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)};
-        {set_state, FAnn, R, A}   -> {set_state, FAnn, R, lambda_lift_expr(Layout, A)};
+        {def, FAnn, D, As}        -> {def, FAnn, D, lambda_lift_exprs(Layout, Name, As)};
+        {builtin, FAnn, B, As}    -> {builtin, FAnn, B, lambda_lift_exprs(Layout, Name, As)};
+        {remote, FAnn, ArgsT, RetT, Ct, F, As} -> {remote, FAnn, ArgsT, RetT, lambda_lift_expr(Layout, Name, Ct), F, lambda_lift_exprs(Layout, Name, As)};
+        {con, FAnn, Ar, C, As}    -> {con, FAnn, Ar, C, lambda_lift_exprs(Layout, Name, As)};
+        {tuple, FAnn, As}         -> {tuple, FAnn, lambda_lift_exprs(Layout, Name, As)};
+        {proj, FAnn, A, I}        -> {proj, FAnn, lambda_lift_expr(Layout, Name, A), I};
+        {set_proj, FAnn, A, I, B} -> {set_proj, FAnn, lambda_lift_expr(Layout, Name, A), I, lambda_lift_expr(Layout, Name, B)};
+        {op, FAnn, Op, As}        -> {op, FAnn, Op, lambda_lift_exprs(Layout, Name, As)};
+        {'let', FAnn, X, A, B}    -> {'let', FAnn, X, lambda_lift_expr(Layout, Name, A), lambda_lift_expr(Layout, Name, B)};
+        {funcall, FAnn, A, Bs}    -> {funcall, FAnn, lambda_lift_expr(Layout, Name, A), lambda_lift_exprs(Layout, Name, Bs)};
+        {set_state, FAnn, R, A}   -> {set_state, FAnn, R, lambda_lift_expr(Layout, Name, A)};
         {get_state, _, _}         -> Expr;
-        {switch, FAnn, S}         -> {switch, FAnn, lambda_lift_expr(Layout, S)};
-        {split, Type, X, Alts}    -> {split, Type, X, lambda_lift_exprs(Layout, Alts)};
-        {nosplit, Rens, A}        -> {nosplit, Rens, lambda_lift_expr(Layout, A)};
-        {'case', P, S}            -> {'case', P, lambda_lift_expr(Layout, S)}
+        {switch, FAnn, S}         -> {switch, FAnn, lambda_lift_expr(Layout, Name, S)};
+        {split, Type, X, Alts}    -> {split, Type, X, lambda_lift_exprs(Layout, Name, Alts)};
+        {nosplit, Rens, A}        -> {nosplit, Rens, lambda_lift_expr(Layout, Name, A)};
+        {'case', P, S}            -> {'case', P, lambda_lift_expr(Layout, Name, S)}
     end.
 
--spec lambda_lift_exprs(state_layout(), [fexpr()]) -> [Closure] when
+-spec lambda_lift_exprs(state_layout(), fun_name(), [fexpr()]) -> [Closure] when
       Closure :: fexpr().
-lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As].
+lambda_lift_exprs(Layout, Name, As) -> [lambda_lift_expr(Layout, Name, A) || A <- As].
 
 %% -- Optimisations ----------------------------------------------------------
 
@@ -1900,9 +1936,6 @@ fresh_name_save(Name) ->
 -spec fresh_name() -> var_name().
 fresh_name() -> fresh_name("%").
 
--spec fresh_fun() -> fun_name().
-fresh_fun() -> {local_fun, [fresh_name("^")]}.
-
 -spec fresh_name(string()) -> var_name().
 fresh_name(Prefix) ->
     N = get('%fresh'),

src/aeso_fcode_to_fate.erl

@@ -1141,11 +1141,16 @@ independent({i, _, I}, {i, _, J}) ->
     StackI = lists:member(?a, [WI | RI]),
     StackJ = lists:member(?a, [WJ | 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
-        true                 ->
+    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
             not lists:member(WJ, RI)

src/aesophia.app.src

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

test/aeso_compiler_tests.erl

@@ -871,10 +871,10 @@ failing_contracts() ->
                      "Trying to implement or extend an undefined interface `Z`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_interface_same_name_different_type,
-                  [<<?Pos(9,5)
-                     "Duplicate definitions of `f` at\n"
-                     "  - line 8, column 5\n"
-                     "  - line 9, column 5">>])
+                  [<<?Pos(5,5)
+                     "Cannot unify `char` and `int`\n"
+                     "when implementing the entrypoint `f` from the interface `I1`">>
+                  ])
     , ?TYPE_ERROR(polymorphism_contract_missing_implementation,
                   [<<?Pos(4,20)
                      "Unimplemented entrypoint `f` from the interface `I1` in the contract `I2`">>
@@ -1313,7 +1313,9 @@ validate(Contract1, Contract2) ->
                   true  -> [debug_mode];
                   false -> []
               end ++
-                  [{include, {file_system, [aeso_test_utils:contract_path()]}}]);
+                  [ {src_file, lists:concat([Contract2, ".aes"])}
+                  , {include, {file_system, [aeso_test_utils:contract_path()]}}
+                  ]);
         Error -> print_and_throw(Error)
     end.