Fix constraints ordering

Properly handle type errors during desugar

src/aeso_aci.erl

@@ -69,7 +69,7 @@ do_contract_interface(Type, ContractString, Options) ->
     try
         Ast = aeso_compiler:parse(ContractString, Options),
         %% io:format("~p\n", [Ast]),
-        {TypedAst, _} = aeso_ast_infer_types:infer(Ast, [dont_unfold]),
+        {TypedAst, _} = aeso_ast_infer_types:infer(Ast, [dont_unfold | Options]),
         %% io:format("~p\n", [TypedAst]),
         from_typed_ast(Type, TypedAst)
     catch

src/aeso_ast_infer_types.erl

@@ -557,7 +557,7 @@ map_t(As, K, V) -> {app_t, As, {id, As, "map"}, [K, V]}.
 infer(Contracts) ->
     infer(Contracts, []).
 
--type option() :: return_env | dont_unfold | no_code | term().
+-type option() :: return_env | dont_unfold | no_code | debug_mode | term().
 
 -spec init_env(list(option())) -> env().
 init_env(_Options) -> global_env().
@@ -622,16 +622,22 @@ check_scope_name_clash(Env, Kind, Name) ->
 
 -spec infer_contract_top(env(), main_contract | contract | namespace, [aeso_syntax:decl()], list(option())) ->
     {env(), [aeso_syntax:decl()]}.
-infer_contract_top(Env, Kind, Defs0, _Options) ->
+infer_contract_top(Env, Kind, Defs0, Options) ->
+    create_type_errors(),
     Defs = desugar(Defs0),
-    infer_contract(Env, Kind, Defs).
+    destroy_and_report_type_errors(Env),
+    infer_contract(Env, Kind, Defs, Options).
 
 %% infer_contract takes a proplist mapping global names to types, and
 %% a list of definitions.
--spec infer_contract(env(), main_contract | contract | namespace, [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}.
+-spec infer_contract(env(), main_contract | contract | namespace, [aeso_syntax:decl()], list(option())) -> {env(), [aeso_syntax:decl()]}.
-infer_contract(Env0, What, Defs0) ->
+infer_contract(Env0, What, Defs0, Options) ->
     create_type_errors(),
-    Defs = process_blocks(Defs0),
+    Defs01 = process_blocks(Defs0),
+    Defs = case lists:member(debug_mode, Options) of
+               true  -> expose_internals(Defs01, What);
+               false -> Defs01
+           end,
     destroy_and_report_type_errors(Env0),
     Env  = Env0#env{ what = What },
     Kind = fun({type_def, _, _, _, _})    -> type;
@@ -679,7 +685,7 @@ process_blocks(Decls) ->
 -spec process_block(aeso_syntax:ann(), [aeso_syntax:decl()]) -> [aeso_syntax:decl()].
 process_block(_, []) -> [];
 process_block(_, [Decl]) -> [Decl];
-process_block(Ann, [Decl | Decls]) ->
+process_block(_Ann, [Decl | Decls]) ->
     IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _}) -> Name == Name1;
                              (_) -> false end end,
     case Decl of
@@ -693,6 +699,25 @@ process_block(Ann, [Decl | Decls]) ->
             [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses}]
     end.
 
+%% Turns private stuff into public stuff
+expose_internals(Defs, What) ->
+    [ begin
+          Ann = element(2, Def),
+          NewAnn = case What of
+                       namespace -> [A ||A <- Ann, A /= {private, true}, A /= private];
+                       main_contract -> [{entrypoint, true}|Ann];  % minor duplication
+                       contract -> Ann
+                   end,
+          Def1 = setelement(2, Def, NewAnn),
+          case Def1 of  % fix inner clauses
+              {fun_clauses, Ans, Id, T, Clauses} ->
+                  {fun_clauses, Ans, Id, T, expose_internals(Clauses, What)};
+              _ -> Def1
+          end
+      end
+     || Def <- Defs
+    ].
+
 -spec check_typedefs(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}.
 check_typedefs(Env = #env{ namespace = Ns }, Defs) ->
     create_type_errors(),
@@ -1532,6 +1557,15 @@ free_vars(L) when is_list(L) ->
     [V || Elem <- L,
           V <- free_vars(Elem)].
 
+next_count() ->
+    V = case get(counter) of
+            undefined ->
+                0;
+            X -> X
+        end,
+    put(counter, V + 1),
+    V.
+
 %% Clean up all the ets tables (in case of an exception)
 
 ets_tables() ->
@@ -1577,6 +1611,18 @@ ets_tab2list(Name) ->
     TabId = ets_tabid(Name),
     ets:tab2list(TabId).
 
+ets_insert_ordered(_, []) -> true;
+ets_insert_ordered(Name, [H|T]) ->
+    ets_insert_ordered(Name, H),
+    ets_insert_ordered(Name, T);
+ets_insert_ordered(Name, Object) ->
+    Count = next_count(),
+    TabId = ets_tabid(Name),
+    ets:insert(TabId, {Count, Object}).
+
+ets_tab2list_ordered(Name) ->
+    [E || {_, E} <- ets_tab2list(Name)].
+
 %% Options
 
 create_options(Options) ->
@@ -1612,17 +1658,17 @@ destroy_and_report_unsolved_constraints(Env) ->
 %% -- Named argument constraints --
 
 create_named_argument_constraints() ->
-    ets_new(named_argument_constraints, [bag]).
+    ets_new(named_argument_constraints, [ordered_set]).
 
 destroy_named_argument_constraints() ->
     ets_delete(named_argument_constraints).
 
 get_named_argument_constraints() ->
-    ets_tab2list(named_argument_constraints).
+    ets_tab2list_ordered(named_argument_constraints).
 
 -spec add_named_argument_constraint(named_argument_constraint()) -> ok.
 add_named_argument_constraint(Constraint) ->
-    ets_insert(named_argument_constraints, Constraint),
+    ets_insert_ordered(named_argument_constraints, Constraint),
     ok.
 
 solve_named_argument_constraints(Env) ->
@@ -1661,14 +1707,14 @@ destroy_and_report_unsolved_named_argument_constraints(Env) ->
                          | {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}.
 
 create_bytes_constraints() ->
-    ets_new(bytes_constraints, [bag]).
+    ets_new(bytes_constraints, [ordered_set]).
 
 get_bytes_constraints() ->
-    ets_tab2list(bytes_constraints).
+    ets_tab2list_ordered(bytes_constraints).
 
 -spec add_bytes_constraint(byte_constraint()) -> true.
 add_bytes_constraint(Constraint) ->
-    ets_insert(bytes_constraints, Constraint).
+    ets_insert_ordered(bytes_constraints, Constraint).
 
 solve_bytes_constraints(Env) ->
     [ solve_bytes_constraint(Env, C) || C <- get_bytes_constraints() ],
@@ -1722,18 +1768,18 @@ check_bytes_constraint(Env, {add_bytes, Ann, Fun, A0, B0, C0}) ->
 
 create_field_constraints() ->
     %% A relation from uvars to constraints
-    ets_new(field_constraints, [bag]).
+    ets_new(field_constraints, [ordered_set]).
 
 destroy_field_constraints() ->
     ets_delete(field_constraints).
 
 -spec constrain([field_constraint()]) -> true.
 constrain(FieldConstraints) ->
-    ets_insert(field_constraints, FieldConstraints).
+    ets_insert_ordered(field_constraints, FieldConstraints).
 
 -spec get_field_constraints() -> [field_constraint()].
 get_field_constraints() ->
-    ets_tab2list(field_constraints).
+    ets_tab2list_ordered(field_constraints).
 
 solve_field_constraints(Env) ->
     FieldCs =
@@ -2563,6 +2609,9 @@ mk_error({mixed_record_and_map, Expr}) ->
     Msg = io_lib:format("Mixed record fields and map keys in\n~s",
                         [pp_expr("  ", Expr)]),
     mk_t_err(pos(Expr), Msg);
+mk_error({conflicting_updates_for_field, Upd, Key}) ->
+    Msg = io_lib:format("Conflicting updates for field '~s'\n", [Key]),
+    mk_t_err(pos(Upd), Msg);
 mk_error(Err) ->
     Msg = io_lib:format("Unknown error: ~p\n", [Err]),
     mk_t_err(pos(0, 0), Msg).
@@ -2785,7 +2834,7 @@ desugar_updates([Upd | Updates]) ->
     {More, Updates1}       = updates_key(Key, Updates),
     %% Check conflicts
     case length([ [] || [] <- [Rest | More] ]) of
-        N when N > 1 -> error({conflicting_updates_for_field, Upd, Key});
+        N when N > 1 -> type_error({conflicting_updates_for_field, Upd, Key});
         _ -> ok
     end,
     [MakeField(lists:append([Rest | More])) | desugar_updates(Updates1)].

src/aeso_compiler.erl

@@ -39,6 +39,7 @@
                 | pp_bytecode
                 | no_code
                 | keep_included
+                | debug_mode
                 | {backend, aevm | fate}
                 | {include, {file_system, [string()]} |
                             {explicit_files, #{string() => binary()}}}

test/aeso_aci_tests.erl

@@ -97,7 +97,10 @@ all_contracts() -> aeso_compiler_tests:compilable_contracts().
 
 aci_test_contract(Name) ->
     String = aeso_test_utils:read_contract(Name),
-    Opts   = [{include, {file_system, [aeso_test_utils:contract_path()]}}],
+    Opts   = case lists:member(Name, aeso_compiler_tests:debug_mode_contracts()) of
+                 true  -> [debug_mode];
+                 false -> []
+             end ++ [{include, {file_system, [aeso_test_utils:contract_path()]}}],
     {ok, JSON} = aeso_aci:contract_interface(json, String, Opts),
     {ok, #{aci := JSON1}} = aeso_compiler:from_string(String, [{aci, json}, {backend, fate} | Opts]),
     ?assertEqual(JSON, JSON1),

test/aeso_compiler_tests.erl

@@ -110,7 +110,15 @@ compile(Backend, Name) ->
 
 compile(Backend, Name, Options) ->
     String = aeso_test_utils:read_contract(Name),
-    case aeso_compiler:from_string(String, [{src_file, Name ++ ".aes"}, {backend, Backend} | Options]) of
+    Options1 =
+        case lists:member(Name, debug_mode_contracts()) of
+            true  -> [debug_mode];
+            false -> []
+        end ++
+        [ {src_file, Name ++ ".aes"}, {backend, Backend}
+        , {include, {file_system, [aeso_test_utils:contract_path()]}}
+        ] ++ Options,
+    case aeso_compiler:from_string(String, Options1) of
         {ok, Map}                                        -> Map;
         {error, ErrorString} when is_binary(ErrorString) -> ErrorString;
         {error, Errors}                                  -> Errors
@@ -165,15 +173,20 @@ compilable_contracts() ->
      "underscore_number_literals",
      "qualified_constructor",
      "let_patterns",
-     "lhs_matching"
+     "lhs_matching",
+     "hermetization_turnoff"
     ].
 
 not_compilable_on(fate) -> [];
 not_compilable_on(aevm) ->
     ["stdlib_include",
-     "manual_stdlib_include"
+     "manual_stdlib_include",
+     "hermetization_turnoff"
     ].
 
+debug_mode_contracts() ->
+    ["hermetization_turnoff"].
+
 %% Contracts that should produce type errors
 
 -define(Pos(Kind, File, Line, Col), (list_to_binary(Kind))/binary, " error in '",
@@ -700,6 +713,9 @@ failing_contracts() ->
                      "  g : (int, string) => 'c\nto arguments\n"
                      "  \"Litwo, ojczyzno moja\" : string">>
                   ])
+    , ?TYPE_ERROR(bad_state,
+                  [<<?Pos(4, 16)
+                     "Conflicting updates for field 'foo'">>])
     ].
 
 -define(Path(File), "code_errors/" ??File).
@@ -853,6 +869,11 @@ validate(Contract1, Contract2) ->
     ByteCode = #{ fate_code := FCode } = compile(fate, Contract1),
     FCode1   = aeb_fate_code:serialize(aeb_fate_code:strip_init_function(FCode)),
     Source   = aeso_test_utils:read_contract(Contract2),
-    aeso_compiler:validate_byte_code(ByteCode#{ byte_code := FCode1 }, Source,
+    aeso_compiler:validate_byte_code(
+      ByteCode#{ byte_code := FCode1 }, Source,
+      case lists:member(Contract2, debug_mode_contracts()) of
+          true  -> [debug_mode];
+          false -> []
+      end ++
       [{backend, fate}, {include, {file_system, [aeso_test_utils:contract_path()]}}]).
 

test/contracts/bad_state.aes

@@ -0,0 +1,5 @@
+contract C =
+  record state = { foo : int }
+  entrypoint init(i : int) =
+    state{ foo = i,
+           foo = 42 }

test/contracts/hermetization_turnoff.aes

@@ -0,0 +1,11 @@
+namespace M =
+  function mf() = mg()
+  function mg() = mf()
+
+namespace N =
+  function nf() = ng() + M.mf() + M.mg()
+  private function ng() = nf() + M.mf() + M.mg()
+
+contract C =
+  entrypoint f() = N.ng() + N.nf() + g()
+  function g() = N.ng() + N.nf() + f()