From 0af45dfd19f52047b93741b7aa475a4d2704a647 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rados=C5=82aw=20Rowicki?= <35342116+radrow@users.noreply.github.com> Date: Tue, 10 May 2022 15:33:59 +0200 Subject: [PATCH] Deprecate AEVM (#375) * Deprecate AEVM * Fix test, changelog * Restore old rebar * rebar lock fix * undo export Co-authored-by: Gaith Hallak * undo export Co-authored-by: Gaith Hallak * Solve GH suggestions * Fix the docs * update docs * Remove unused tests * undo weird change Co-authored-by: Gaith Hallak --- CHANGELOG.md | 1 + docs/aeso_compiler.md | 13 - docs/sophia_features.md | 19 +- docs/sophia_stdlib.md | 2 +- src/aeso_ast_infer_types.erl | 2 +- src/aeso_ast_to_fcode.erl | 2 +- src/aeso_ast_to_icode.erl | 1049 ----------------- src/aeso_builtins.erl | 684 ----------- src/aeso_code_errors.erl | 32 - src/aeso_compiler.erl | 444 ++----- src/aeso_icode.erl | 153 --- src/aeso_icode.hrl | 59 - src/aeso_icode_to_asm.erl | 983 --------------- src/aeso_vm_decode.erl | 64 +- test/aeso_abi_tests.erl | 141 +-- test/aeso_aci_tests.erl | 2 +- test/aeso_calldata_tests.erl | 35 +- test/aeso_compiler_tests.erl | 160 +-- test/contracts/Makefile | 15 - test/contracts/abort_test.aes | 31 - test/contracts/abort_test_int.aes | 27 - test/contracts/channel_env.aes | 8 - ...nnel_on_chain_contract_name_resolution.aes | 7 - .../channel_on_chain_contract_oracle.aes | 51 - ...mote_on_chain_contract_name_resolution.aes | 9 - test/contracts/chess.aes | 51 - .../unapplied_named_arg_builtin.aes | 1 - test/contracts/contract_types.aes | 20 - test/contracts/erc20_token.aes | 87 -- test/contracts/exploits.aes | 6 - test/contracts/init_error.aes | 9 - test/contracts/local_poly_fail.aes | 7 - test/contracts/map_of_maps.aes | 36 - test/contracts/maps_benchmark.aes | 29 - test/contracts/minimal_init.aes | 6 - test/contracts/multiplication_server.aes | 7 - test/contracts/oracles_err.aes | 11 - test/contracts/oracles_gas.aes | 22 - test/contracts/oracles_no_vm.aes | 35 - test/contracts/polymorphism_test.aes | 16 - test/contracts/primitive_map.aes | 57 - test/contracts/remote_gas_test.aes | 20 - test/contracts/remote_state.aes | 23 - test/contracts/remote_type_check.aes | 22 - test/contracts/remote_value_on_err.aes | 21 - test/contracts/test.aes | 16 +- test/contracts/unapplied_builtins.aes | 2 +- test/contracts/upfront_charges.aes | 6 - test/contracts/value_on_err.aes | 7 - 49 files changed, 219 insertions(+), 4291 deletions(-) delete mode 100644 src/aeso_ast_to_icode.erl delete mode 100644 src/aeso_builtins.erl delete mode 100644 src/aeso_icode.erl delete mode 100644 src/aeso_icode.hrl delete mode 100644 src/aeso_icode_to_asm.erl delete mode 100644 test/contracts/Makefile delete mode 100644 test/contracts/abort_test.aes delete mode 100644 test/contracts/abort_test_int.aes delete mode 100644 test/contracts/channel_env.aes delete mode 100644 test/contracts/channel_on_chain_contract_name_resolution.aes delete mode 100644 test/contracts/channel_on_chain_contract_oracle.aes delete mode 100644 test/contracts/channel_remote_on_chain_contract_name_resolution.aes delete mode 100644 test/contracts/chess.aes delete mode 100644 test/contracts/contract_types.aes delete mode 100644 test/contracts/erc20_token.aes delete mode 100644 test/contracts/exploits.aes delete mode 100644 test/contracts/init_error.aes delete mode 100644 test/contracts/local_poly_fail.aes delete mode 100644 test/contracts/map_of_maps.aes delete mode 100644 test/contracts/maps_benchmark.aes delete mode 100644 test/contracts/minimal_init.aes delete mode 100644 test/contracts/multiplication_server.aes delete mode 100644 test/contracts/oracles_err.aes delete mode 100644 test/contracts/oracles_gas.aes delete mode 100644 test/contracts/oracles_no_vm.aes delete mode 100644 test/contracts/polymorphism_test.aes delete mode 100644 test/contracts/primitive_map.aes delete mode 100644 test/contracts/remote_gas_test.aes delete mode 100644 test/contracts/remote_state.aes delete mode 100644 test/contracts/remote_type_check.aes delete mode 100644 test/contracts/remote_value_on_err.aes delete mode 100644 test/contracts/upfront_charges.aes delete mode 100644 test/contracts/value_on_err.aes diff --git a/CHANGELOG.md b/CHANGELOG.md index 13a2b52..925053c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Error messages have been restructured (less newlines) to provide more unified errors. Also `pp_oneline/1` has been added. ### Removed +- Support for AEVM has been entirely wiped ## [6.1.0] - 2021-10-20 ### Added diff --git a/docs/aeso_compiler.md b/docs/aeso_compiler.md index 5d2e88b..1fd6f94 100644 --- a/docs/aeso_compiler.md +++ b/docs/aeso_compiler.md @@ -49,12 +49,8 @@ The **pp_** options all print to standard output the following: `pp_typed_ast` - print the AST with type information at each node -`pp_icode` - print the internal code structure - `pp_assembler` - print the generated assembler code -`pp_bytecode` - print the bytecode instructions - #### check_call(ContractString, Options) -> CheckRet Types @@ -66,15 +62,6 @@ Type = term() ``` Check a call in contract through the `__call` function. -#### sophia_type_to_typerep(String) -> TypeRep - -Types -``` erlang - {ok,TypeRep} | {error, badtype} -``` - -Get the type representation of a type declaration. - #### version() -> {ok, Version} | {error, term()} Types diff --git a/docs/sophia_features.md b/docs/sophia_features.md index 8ef1481..aa9e229 100644 --- a/docs/sophia_features.md +++ b/docs/sophia_features.md @@ -225,9 +225,6 @@ payable stateful entrypoint buy(to : address) = abort("Value too low") ``` -Note: In the æternity VM (AEVM) contracts and entrypoints were by default -payable until the Lima release. - ## Namespaces Code can be split into libraries using the `namespace` construct. Namespaces @@ -405,7 +402,7 @@ Sophia has the following types: ## Arithmetic -Sophia integers (`int`) are represented by 256-bit (AEVM) or arbitrary-sized (FATE) signed words and supports the following +Sophia integers (`int`) are represented by arbitrary-sized signed words and support the following arithmetic operations: - addition (`x + y`) - subtraction (`x - y`) @@ -414,22 +411,16 @@ arithmetic operations: - remainder (`x mod y`), satisfying `y * (x / y) + x mod y == x` for non-zero `y` - exponentiation (`x ^ y`) -All operations are *safe* with respect to overflow and underflow. On AEVM they behave as the corresponding -operations on arbitrary-size integers and fail with `arithmetic_error` if the -result cannot be represented by a 256-bit signed word. For example, `2 ^ 255` -fails rather than wrapping around to -2²⁵⁵. - -The division and modulo operations also throw an arithmetic error if the -second argument is zero. +All operations are *safe* with respect to overflow and underflow. +The division and modulo operations throw an arithmetic error if the +right-hand operand is zero. ## Bit fields Sophia integers do not support bit arithmetic. Instead there is a separate type `bits`. See the standard library [documentation](sophia_stdlib.md#bits). -On the AEVM a bit field is represented by a 256-bit word and reading or writing -a bit outside the 0..255 range fails with an `arithmetic_error`. On FATE a bit -field can be of arbitrary size (but it is still represented by the +A bit field can be of arbitrary size (but it is still represented by the corresponding integer, so setting very high bits can be expensive). ## Type aliases diff --git a/docs/sophia_stdlib.md b/docs/sophia_stdlib.md index d0c5de3..fdc94a5 100644 --- a/docs/sophia_stdlib.md +++ b/docs/sophia_stdlib.md @@ -457,7 +457,7 @@ Chain.block_hash(h : int) : option(bytes(32)) The hash of the block at height `h`. `h` has to be within 256 blocks from the current height of the chain or else the function will return `None`. -NOTE: In AEVM and FATE VM version 1 `Chain.block_height` was not considered an +NOTE: In FATE VM version 1 `Chain.block_height` was not considered an allowed height. From FATE VM version 2 (IRIS) it will return the block hash of the current generation. diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 4ef4403..837e677 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1928,7 +1928,7 @@ infer_infix({RelOp, As}) when RelOp == '=='; RelOp == '!='; RelOp == '<'; RelOp == '>'; RelOp == '<='; RelOp == '=<'; RelOp == '>=' -> - T = fresh_uvar(As), %% allow any type here, check in ast_to_icode that we have comparison for it + T = fresh_uvar(As), %% allow any type here, check in the backend that we have comparison for it Bool = {id, As, "bool"}, {fun_t, As, [], [T, T], Bool}; infer_infix({'..', As}) -> diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 5194340..25802e0 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -363,7 +363,7 @@ to_fcode(Env, [{Contract, Attrs, Con = {con, _, Name}, Decls}|Rest]) to_fcode(Env1, Rest) end; to_fcode(_Env, [NotMain = {NotMainHead, _ ,_ , _}]) when NotMainHead =/= contract_def -> - fcode_error({last_declaration_must_be_contract_def, NotMain}); + 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). diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl deleted file mode 100644 index c2bbd50..0000000 --- a/src/aeso_ast_to_icode.erl +++ /dev/null @@ -1,1049 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author Happi (Erik Stenman) -%%% @copyright (C) 2017, Aeternity Anstalt -%%% @doc -%%% Compiler from Aeterinty Sophia language to the Aeternity VM, aevm. -%%% @end -%%% Created : 21 Dec 2017 -%%% -%%%------------------------------------------------------------------- --module(aeso_ast_to_icode). - --export([ast_typerep/1, ast_typerep/2, type_value/1, - convert_typed/2, prim_call/5]). - --include_lib("aebytecode/include/aeb_opcodes.hrl"). --include("aeso_icode.hrl"). --include("aeso_utils.hrl"). - --spec convert_typed(aeso_syntax:ast(), list()) -> aeso_icode:icode(). -convert_typed(TypedTree, Options) -> - {Payable, Name} = - case lists:last(TypedTree) of - {Contr, Attrs, {con, _, Con}, _} when ?IS_CONTRACT_HEAD(Contr) -> - {proplists:get_value(payable, Attrs, false), Con}; - Decl -> - gen_error({last_declaration_must_be_contract, Decl}) - end, - NewIcode = aeso_icode:set_payable(Payable, - aeso_icode:set_name(Name, aeso_icode:new(Options))), - Icode = code(TypedTree, NewIcode, Options), - deadcode_elimination(Icode). - -code([{Contract, _Attribs, Con, Code}|Rest], Icode, Options) - when ?IS_CONTRACT_HEAD(Contract) -> - NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Con, Icode)), - code(Rest, NewIcode, Options); -code([{namespace, _Ann, Name, Code}|Rest], Icode, Options) -> - %% TODO: nested namespaces - NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Name, Icode)), - code(Rest, NewIcode, Options); -code([], Icode, Options) -> - add_default_init_function(add_builtins(Icode), Options). - -%% Generate error on correct format. - --dialyzer({nowarn_function, gen_error/1}). -gen_error(Error) -> - aeso_errors:throw(aeso_code_errors:format(Error)). - -%% Create default init function (only if state is unit). -add_default_init_function(Icode = #{namespace := NS, functions := Funs, state_type := State}, Options) -> - NoCode = proplists:get_value(no_code, Options, false), - {_, _, QInit} = aeso_icode:qualify({id, [], "init"}, Icode), - case lists:keymember(QInit, 1, Funs) of - true -> Icode; - false when NoCode -> Icode; - false when State /= {tuple, []} -> - gen_error({missing_init_function, NS}); - false -> - Type = {tuple, [typerep, {tuple, []}]}, - Value = #tuple{ cpts = [type_value({tuple, []}), {tuple, []}] }, - DefaultInit = {QInit, [], [], Value, Type}, - Icode#{ functions => [DefaultInit | Funs] } - end. - --spec contract_to_icode(aeso_syntax:ast(), aeso_icode:icode()) -> - aeso_icode:icode(). -contract_to_icode([{namespace, _, Name, Defs} | Rest], Icode) -> - NS = aeso_icode:get_namespace(Icode), - Icode1 = contract_to_icode(Defs, aeso_icode:enter_namespace(Name, Icode)), - contract_to_icode(Rest, aeso_icode:set_namespace(NS, Icode1)); -contract_to_icode([Decl = {type_def, _Attrib, Id = {id, _, Name}, Args, Def} | Rest], - Icode = #{ types := Types, constructors := Constructors }) -> - TypeDef = make_type_def(Args, Def, Icode), - NewConstructors = - case Def of - {variant_t, Cons} -> - Tags = lists:seq(0, length(Cons) - 1), - GetName = fun({constr_t, _, C, _}) -> C end, - QName = fun(Con) -> {_, _, Xs} = aeso_icode:qualify(GetName(Con), Icode), Xs end, - maps:from_list([ {QName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]); - _ -> #{} - end, - {_, _, TName} = aeso_icode:qualify(Id, Icode), - Icode1 = Icode#{ types := Types#{ TName => TypeDef }, - constructors := maps:merge(Constructors, NewConstructors) }, - Icode2 = case Name of - "state" when Args == [] -> - case is_first_order_type(Def) of - true -> Icode1#{ state_type => ast_typerep(Def, Icode) }; - false -> gen_error({higher_order_state, Decl}) - end; - "state" -> gen_error({parameterized_state, Id}); - "event" when Args == [] -> Icode1#{ event_type => Def }; - "event" -> gen_error({parameterized_event, Id}); - _ -> Icode1 - end, - contract_to_icode(Rest, Icode2); -contract_to_icode([{letfun, Attrib, Name, Args, _What, [{guarded, _, [], Body={typed,_,_,T}}]}|Rest], Icode) -> - FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++ - [ payable || proplists:get_value(payable, Attrib, false) ] ++ - [ private || is_private(Attrib, Icode) ], - [ check_entrypoint_type(Attrib, Name, Args, T) - || aeso_syntax:get_ann(entrypoint, Attrib, false) ], - %% TODO: Handle types - FunName = ast_id(Name), - %% TODO: push funname to env - FunArgs = ast_args(Args, [], Icode), - %% TODO: push args to env - {FunBody, TypeRep} = - case FunName of - "init" -> - %% Pair the initial state with a typerep for the state (TODO: until we have the state type in some contract metadata) - #{ state_type := StateType } = Icode, - {#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] }, - {tuple, [typerep, ast_typerep(T, Icode)]}}; - _ -> {ast_body(Body, Icode), ast_typerep1(T, Icode)} - end, - QName = aeso_icode:qualify(Name, Icode), - NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode), - contract_to_icode(Rest, NewIcode); -contract_to_icode([], Icode) -> Icode; -contract_to_icode([{fun_decl, _, Id, _} | Code], Icode = #{ options := Options }) -> - NoCode = proplists:get_value(no_code, Options, false), - case aeso_icode:in_main_contract(Icode) andalso not NoCode of - true -> gen_error({missing_definition, Id}); - false -> contract_to_icode(Code, Icode) - end; -contract_to_icode([Decl | Code], Icode) -> - io:format("Unhandled declaration: ~p\n", [Decl]), - contract_to_icode(Code, Icode). - -ast_id({id, _, Id}) -> Id; -ast_id({qid, _, Id}) -> Id. - -ast_args([{typed, _, Name, Type}|Rest], Acc, Icode) -> - ast_args(Rest, [{ast_id(Name), ast_typerep1(Type, Icode)}| Acc], Icode); -ast_args([], Acc, _Icode) -> lists:reverse(Acc). - -ast_type(T, Icode) -> - ast_typerep(T, Icode). - --define(id_app(Fun, Args, ArgTypes, OutType), - {app, _, {typed, _, {id, _, Fun}, {fun_t, _, _, ArgTypes, OutType}}, Args}). - --define(qid_app(Fun, Args, ArgTypes, OutType), - {app, _, {typed, _, {qid, _, Fun}, {fun_t, _, _, ArgTypes, OutType}}, Args}). - --define(oracle_t(Q, R), {app_t, _, {id, _, "oracle"}, [Q, R]}). --define(query_t(Q, R), {app_t, _, {id, _, "oracle_query"}, [Q, R]}). --define(option_t(A), {app_t, _, {id, _, "option"}, [A]}). --define(map_t(K, V), {app_t, _, {id, _, "map"}, [K, V]}). - -%% Chain environment -ast_body({qid, _, ["Contract", "address"]}, _Icode) -> prim_contract_address; -ast_body({qid, _, ["Contract", "creator"]}, _Icode) -> prim_contract_creator; -ast_body({qid, _, ["Contract", "balance"]}, _Icode) -> #prim_balance{ address = prim_contract_address }; -ast_body({qid, _, ["Call", "origin"]}, _Icode) -> prim_call_origin; -ast_body({qid, _, ["Call", "caller"]}, _Icode) -> prim_caller; -ast_body({qid, _, ["Call", "value"]}, _Icode) -> prim_call_value; -ast_body({qid, _, ["Call", "gas_price"]}, _Icode) -> prim_gas_price; -ast_body({qid, _, ["Chain", "coinbase"]}, _Icode) -> prim_coinbase; -ast_body({qid, _, ["Chain", "timestamp"]}, _Icode) -> prim_timestamp; -ast_body({qid, _, ["Chain", "block_height"]}, _Icode) -> prim_block_height; -ast_body({qid, _, ["Chain", "difficulty"]}, _Icode) -> prim_difficulty; -ast_body({qid, _, ["Chain", "gas_limit"]}, _Icode) -> prim_gas_limit; - -%% State -ast_body({qid, _, [Con, "state"]}, #{ contract_name := Con }) -> prim_state; -ast_body(?qid_app([Con, "put"], [NewState], _, _), Icode = #{ contract_name := Con }) -> - #prim_put{ state = ast_body(NewState, Icode) }; -ast_body({typed, _, Id = {qid, _, [Con, "put"]}, Type}, Icode = #{ contract_name := Con }) -> - eta_expand(Id, Type, Icode); - -%% Authentication -ast_body({qid, _, ["Auth", "tx_hash"]}, _Icode) -> - prim_call(?PRIM_CALL_AUTH_TX_HASH, #integer{value = 0}, - [], [], aeso_icode:option_typerep(word)); - -%% Maps - -%% -- map lookup m[k] -ast_body({map_get, _, Map, Key}, Icode) -> - {_, ValType} = check_monomorphic_map(Map, Icode), - Fun = {map_get, ast_typerep(ValType, Icode)}, - builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode)]); -%% -- map lookup_default m[k = v] -ast_body({map_get, _, Map, Key, Val}, Icode) -> - {_, ValType} = check_monomorphic_map(Map, Icode), - Fun = {map_lookup_default, ast_typerep(ValType, Icode)}, - builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]); - -%% -- map construction { k1 = v1, k2 = v2 } -ast_body({typed, Ann, {map, _, KVs}, MapType}, Icode) -> - {KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode), - lists:foldr(fun({K, V}, Map) -> - builtin_call(map_put, [Map, ast_body(K, Icode), ast_body(V, Icode)]) - end, map_empty(KeyType, ValType, Icode), KVs); - -%% -- map update m { [k] = v } or m { [k] @ x = f(x) } or m { [k = v] @ x = f(x) } -ast_body({map, _, Map, []}, Icode) -> ast_body(Map, Icode); -ast_body({map, _, Map, [Upd]}, Icode) -> - case Upd of - {field, _, [{map_get, _, Key}], Val} -> - map_put(Key, Val, Map, Icode); - {field_upd, _, [{map_get, _, Key}], ValFun} -> - map_upd(Key, ValFun, Map, Icode); - {field_upd, _, [{map_get, _, Key, Val}], ValFun} -> - map_upd(Key, Val, ValFun, Map, Icode) - end; -ast_body({map, Ann, Map, [Upd | Upds]}, Icode) -> - ast_body({map, Ann, {map, Ann, Map, [Upd]}, Upds}, Icode); - -%% -- Bits -ast_body({qid, _, ["Bits", "none"]}, _Icode) -> - #integer{ value = 0 }; -ast_body({qid, _, ["Bits", "all"]}, _Icode) -> - #integer{ value = 1 bsl 256 - 1 }; - -%% -- Conversion - -%% Other terms -ast_body({id, _, Name}, _Icode) -> - #var_ref{name = Name}; -ast_body({typed, _, Id = {qid, _, _}, Type}, Icode) -> - case is_builtin_fun(Id, Icode) of - true -> eta_expand(Id, Type, Icode); - false -> ast_body(Id, Icode) - end; -ast_body({qid, _, Name}, _Icode) -> - #var_ref{name = Name}; -ast_body({bool, _, Bool}, _Icode) -> %BOOL as ints - Value = if Bool -> 1 ; true -> 0 end, - #integer{value = Value}; -ast_body({int, _, Value}, _Icode) -> - #integer{value = Value}; -ast_body({char, _, Value}, _Icode) -> - #integer{value = Value}; -ast_body({bytes, _, Bin}, _Icode) -> - case aeb_memory:binary_to_words(Bin) of - [Word] -> #integer{value = Word}; - Words -> #tuple{cpts = [#integer{value = W} || W <- Words]} - end; -ast_body({Key, _, Bin}, _Icode) when Key == account_pubkey; - Key == contract_pubkey; - Key == oracle_pubkey; - Key == oracle_query_id -> - <> = Bin, - #integer{value = Value}; -ast_body({string,_,Bin}, _Icode) -> - Cpts = [size(Bin) | aeb_memory:binary_to_words(Bin)], - #tuple{cpts = [#integer{value=X} || X <- Cpts]}; -ast_body({tuple,_,Args}, Icode) -> - #tuple{cpts = [ast_body(A, Icode) || A <- Args]}; -ast_body({list,_,Args}, Icode) -> - #list{elems = [ast_body(A, Icode) || A <- Args]}; -%% Typed contract calls -ast_body({proj, _, {typed, _, Addr, {con, _, _}}, {id, _, "address"}}, Icode) -> - ast_body(Addr, Icode); %% Values of contract types _are_ addresses. -ast_body({app, _, {typed, _, {proj, _, Addr, {id, _, FunName}}, - {fun_t, _, NamedT, ArgsT, OutT}}, Args0}, Icode) -> - NamedArgs = [Arg || Arg = {named_arg, _, _, _} <- Args0], - Args = Args0 -- NamedArgs, - ArgOpts = [ {Name, ast_body(Value, Icode)} || {named_arg, _, {id, _, Name}, Value} <- NamedArgs ], - Defaults = [ {Name, ast_body(Default, Icode)} || {named_arg_t, _, {id, _, Name}, _, Default} <- NamedT ], - ArgsI = [ ast_body(Arg, Icode) || Arg <- Args ], - ArgType = ast_typerep({tuple_t, [], ArgsT}), - Gas = proplists:get_value("gas", ArgOpts ++ Defaults), - Value = proplists:get_value("value", ArgOpts ++ Defaults), - OutType = ast_typerep(OutT, Icode), - <> = aeb_aevm_abi:function_type_hash(list_to_binary(FunName), ArgType, OutType), - %% The function is represented by its type hash (which includes the name) - Fun = #integer{value = TypeHash}, - #prim_call_contract{ - address = ast_body(Addr, Icode), - gas = Gas, - value = Value, - arg = #tuple{cpts = [Fun, #tuple{ cpts = ArgsI }]}, - %% The type check is implicitly done by using the type hash as the - %% entrypoint on the callee side. - type_hash= #integer{value = 0} - }; -ast_body({proj, _, Con = {typed, _, _, {con, _, _}}, _Fun}, _Icode) -> - gen_error({unapplied_contract_call, Con}); - -ast_body({con, _, Name}, Icode) -> - Tag = aeso_icode:get_constructor_tag([Name], Icode), - #tuple{cpts = [#integer{value = Tag}]}; -ast_body({qcon, _, Name}, Icode) -> - Tag = aeso_icode:get_constructor_tag(Name, Icode), - #tuple{cpts = [#integer{value = Tag}]}; -ast_body({app, _, {typed, _, {con, _, Name}, _}, Args}, Icode) -> - Tag = aeso_icode:get_constructor_tag([Name], Icode), - #tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]}; -ast_body({app, _, {typed, _, {qcon, _, Name}, _}, Args}, Icode) -> - Tag = aeso_icode:get_constructor_tag(Name, Icode), - #tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]}; -ast_body({app, _, {'..', _}, [A, B]}, Icode) -> - #funcall - { function = #var_ref{ name = ["ListInternal", "from_to"] } - , args = [ast_body(A, Icode), ast_body(B, Icode)] }; -ast_body({app, As, Fun, Args}, Icode) -> - case aeso_syntax:get_ann(format, As) of - infix -> - {Op, _} = Fun, - [A, B] = Args, - ast_binop(Op, As, A, B, Icode); - prefix -> - {Op, _} = Fun, - [A] = Args, - #unop{op = Op, rand = ast_body(A, Icode)}; - _ -> - {typed, _, Fun1, {fun_t, _, _, ArgsT, RetT}} = Fun, - case is_builtin_fun(Fun1, Icode) of - true -> builtin_code(As, Fun1, Args, ArgsT, RetT, Icode); - false -> - #funcall{function=ast_body(Fun, Icode), - args=[ast_body(A, Icode) || A <- Args]} - end - end; -ast_body({list_comp, _, Yield, []}, Icode) -> - #list{elems = [ast_body(Yield, Icode)]}; -ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, _, Pat, ArgType}, BindExpr}|Rest]}, Icode) -> - Arg = "%lc", - Body = {switch, As, {typed, As, {id, As, Arg}, ArgType}, - [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]}, - {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]}, - #funcall - { function = #var_ref{ name = ["ListInternal", "flat_map"] } - , args = - [ #lambda{ args=[#arg{name = Arg, type = ast_type(ArgType, Icode)}] - , body = ast_body(Body, Icode) - } - , ast_body(BindExpr, Icode) - ] - }; -ast_body({list_comp, As, Yield, [{comprehension_if, AsIF, Cond}|Rest]}, Icode) -> - ast_body({'if', AsIF, Cond, {list_comp, As, Yield, Rest}, {list, As, []}}, Icode); -ast_body({list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}, Icode) -> - ast_body({block, As, [LV, {list_comp, As, Yield, Rest}]}, Icode); -ast_body({list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}, Icode) -> - ast_body({block, As, [LF, {list_comp, As, Yield, Rest}]}, Icode); -ast_body({'if',_,Dec,Then,Else}, Icode) -> - #ifte{decision = ast_body(Dec, Icode) - ,then = ast_body(Then, Icode) - ,else = ast_body(Else, Icode)}; -ast_body({switch,_,A,Cases}, Icode) -> - %% let's assume the parser has already ensured that only valid - %% patterns appear in cases. - #switch{expr=ast_body(A, Icode), - cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)} - || {'case',_,Pat,[{guarded, _, [], Body}]} <- Cases]}; -ast_body({block, As, [{letval, _, Pat, E} | Rest]}, Icode) -> - E1 = ast_body(E, Icode), - Pat1 = ast_body(Pat, Icode), - Rest1 = ast_body({block, As, Rest}, Icode), - #switch{expr = E1, - cases = [{Pat1, Rest1}]}; -ast_body({block, As, [{letfun, Ann, F, Args, _Type, [{guarded, _, [], Expr}]} | Rest]}, Icode) -> - ToArg = fun({typed, Ann1, Id, T}) -> {arg, Ann1, Id, T} end, %% Pattern matching has been desugared - LamArgs = lists:map(ToArg, Args), - ast_body({block, As, [{letval, Ann, F, {lam, Ann, LamArgs, Expr}} | Rest]}, Icode); -ast_body({block,_,[]}, _Icode) -> - #tuple{cpts=[]}; -ast_body({block,_,[E]}, Icode) -> - ast_body(E, Icode); -ast_body({block,As,[E|Rest]}, Icode) -> - #switch{expr=ast_body(E, Icode), - cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]}; -ast_body({lam,_,Args,Body}, Icode) -> - #lambda{args=[#arg{name = ast_id(P), type = ast_typerep1(T, Icode)} || {arg,_,P,T} <- Args], - body=ast_body(Body, Icode)}; -ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) -> - %% Compile as a tuple with the fields in the order they appear in the definition. - NamedField = fun({field, _, [{proj, _, {id, _, Name}}], E}) -> {Name, E} end, - NamedFields = lists:map(NamedField, Fields), - #tuple{cpts = - [case proplists:get_value(Name, NamedFields) of - undefined -> - Line = aeso_syntax:get_ann(line, Attrs), - #missing_field{format = "Missing field in record: ~s (on line ~p)\n", - args = [Name,Line]}; - E -> - ast_body(E, Icode) - end - || {field_t,_,{id,_,Name},_} <- DefFields]}; -ast_body({proj,_,{typed,_,Record,{record_t,Fields}},{id,_,FieldName}}, Icode) -> - [Index] = [I - || {I,{field_t,_,{id,_,Name},_}} <- - lists:zip(lists:seq(1,length(Fields)),Fields), - Name==FieldName], - #binop{op = '!', left = #integer{value = 32*(Index-1)}, right = ast_body(Record, Icode)}; -ast_body({record, Attrs, {typed, _, Record, RecType={record_t, Fields}}, Update}, Icode) -> - UpdatedName = fun({field, _, [{proj, _, {id, _, Name}}], _}) -> Name; - ({field_upd, _, [{proj, _, {id, _, Name}}], _}) -> Name - end, - UpdatedNames = lists:map(UpdatedName, Update), - Rec = {typed, Attrs, {id, Attrs, "_record"}, RecType}, - CompileUpdate = - fun(Fld={field, _, _, _}) -> Fld; - ({field_upd, Ann, LV=[{proj, Ann1, P}], Fun}) -> - {field, Ann, LV, {app, Ann, Fun, [{proj, Ann1, Rec, P}]}} - end, - - #switch{expr=ast_body(Record, Icode), - cases=[{#var_ref{name = "_record"}, - ast_body({typed, Attrs, - {record, Attrs, - lists:map(CompileUpdate, Update) ++ - [{field, Attrs, [{proj, Attrs, {id, Attrs, Name}}], - {proj, Attrs, Rec, {id, Attrs, Name}}} - || {field_t, _, {id, _, Name}, _} <- Fields, - not lists:member(Name, UpdatedNames)]}, - RecType}, Icode)} - ]}; -ast_body({typed, _, Body, _}, Icode) -> - ast_body(Body, Icode). - -ast_binop(Op, Ann, {typed, _, A, Type}, B, Icode) - when Op == '=='; Op == '!='; - Op == '<'; Op == '>'; - Op == '<='; Op == '=<'; Op == '>=' -> - [ gen_error({cant_compare_type_aevm, Ann, Op, Type}) || not is_simple_type(Type) ], - case ast_typerep(Type, Icode) of - word -> #binop{op = Op, left = ast_body(A, Icode), right = ast_body(B, Icode)}; - OtherType -> - Neg = case Op of - '==' -> fun(X) -> X end; - '!=' -> fun(X) -> #unop{ op = '!', rand = X } end; - _ -> gen_error({cant_compare_type_aevm, Ann, Op, Type}) - end, - Args = [ast_body(A, Icode), ast_body(B, Icode)], - Builtin = - case OtherType of - string -> - builtin_call(str_equal, Args); - {tuple, Types} -> - case lists:usort(Types) of - [word] -> - builtin_call(str_equal_p, [ #integer{value = 32 * length(Types)} | Args]); - _ -> gen_error({cant_compare_type_aevm, Ann, Op, Type}) - end; - _ -> - gen_error({cant_compare_type_aevm, Ann, Op, Type}) - end, - Neg(Builtin) - end; -ast_binop('++', _, A, B, Icode) -> - builtin_call(list_concat, [ast_body(A, Icode), ast_body(B, Icode)]); -ast_binop(Op, _, A, B, Icode) -> - #binop{op = Op, left = ast_body(A, Icode), right = ast_body(B, Icode)}. - -is_builtin_fun({qid, _, ["Chain","spend"]}, _Icode) -> true; -is_builtin_fun({qid, _, [Con, "Chain", "event"]}, #{ contract_name := Con }) -> true; -is_builtin_fun({qid, _, ["Chain", "balance"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Chain", "block_hash"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Call", "gas_left"]}, _Icode) -> true; -is_builtin_fun({id, _, "abort"}, _Icode) -> true; -is_builtin_fun({id, _, "require"}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "register"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "query_fee"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "query"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "extend"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "respond"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "get_question"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "get_answer"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "check"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Oracle", "check_query"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "resolve"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "preclaim"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "claim"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "transfer"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "revoke"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["AENS", "update"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "lookup"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "lookup_default"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "member"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "size"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "delete"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "from_list"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Map", "to_list"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "verify_sig"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "verify_sig_secp256k1"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "ecverify_secp256k1"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "ecrecover_secp256k1"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "sha3"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "sha256"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Crypto", "blake2b"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["String", "sha256"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["String", "blake2b"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["String", "length"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["String", "concat"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["String", "sha3"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "test"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "set"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "clear"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "union"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "intersection"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "difference"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bits", "sum"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Int", "to_str"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Address", "to_str"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Address", "is_oracle"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Address", "is_contract"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Address", "is_payable"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Address", "to_contract"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bytes", "to_int"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bytes", "to_str"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bytes", "concat"]}, _Icode) -> true; -is_builtin_fun({qid, _, ["Bytes", "split"]}, _Icode) -> true; -is_builtin_fun(_, _) -> false. - -%% -- Code generation for builtin functions -- - -%% Chain operations -builtin_code(_, {qid, _, ["Chain","spend"]}, [To, Amount], _, _, Icode) -> - prim_call(?PRIM_CALL_SPEND, ast_body(Amount, Icode), [ast_body(To, Icode)], [word], {tuple, []}); - -builtin_code(_, {qid, _, [Con, "Chain", "event"]}, [Event], _, _, Icode = #{ contract_name := Con }) -> - aeso_builtins:check_event_type(Icode), - builtin_call({event, maps:get(event_type, Icode)}, [ast_body(Event, Icode)]); - -builtin_code(_, {qid, _, ["Chain", "balance"]}, [Address], _, _, Icode) -> - #prim_balance{ address = ast_body(Address, Icode) }; -builtin_code(_, {qid, _, ["Chain", "block_hash"]}, [Height], _, _, Icode) -> - builtin_call(block_hash, [ast_body(Height, Icode)]); -builtin_code(_, {qid, _, ["Call", "gas_left"]}, [], _, _, _Icode) -> - prim_gas_left; - -%% Abort -builtin_code(_, {id, _, "abort"}, [String], _, _, Icode) -> - builtin_call(abort, [ast_body(String, Icode)]); -builtin_code(_, {id, _, "require"}, [Bool, String], _, _, Icode) -> - builtin_call(require, [ast_body(Bool, Icode), ast_body(String, Icode)]); - -%% Oracles -builtin_code(_, {qid, Ann, ["Oracle", "register"]}, Args, _, OracleType = ?oracle_t(QType, RType), Icode) -> - check_oracle_type(Ann, OracleType), - {Sign, [Acct, QFee, TTL]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_ORACLE_REGISTER, #integer{value = 0}, - [ast_body(Acct, Icode), ast_body(Sign, Icode), ast_body(QFee, Icode), ast_body(TTL, Icode), - ast_type_value(QType, Icode), ast_type_value(RType, Icode)], - [word, sign_t(), word, ttl_t(Icode), typerep, typerep], word); - -builtin_code(_, {qid, _, ["Oracle", "query_fee"]}, [Oracle], [_], _, Icode) -> - prim_call(?PRIM_CALL_ORACLE_QUERY_FEE, #integer{value = 0}, - [ast_body(Oracle, Icode)], [word], word); - -builtin_code(_, {qid, Ann, ["Oracle", "query"]}, [Oracle, Q, QFee, QTTL, RTTL], [OracleType, QType, _, _, _], _, Icode) -> - check_oracle_type(Ann, OracleType), - prim_call(?PRIM_CALL_ORACLE_QUERY, ast_body(QFee, Icode), - [ast_body(Oracle, Icode), ast_body(Q, Icode), ast_body(QTTL, Icode), ast_body(RTTL, Icode)], - [word, ast_type(QType, Icode), ttl_t(Icode), ttl_t(Icode)], word); - -builtin_code(_, {qid, _, ["Oracle", "extend"]}, Args, [_, _], _, Icode) -> - {Sign, [Oracle, TTL]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_ORACLE_EXTEND, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_body(Sign, Icode), ast_body(TTL, Icode)], - [word, sign_t(), ttl_t(Icode)], {tuple, []}); - -builtin_code(_, {qid, Ann, ["Oracle", "respond"]}, Args, [OracleType, _, RType], _, Icode) -> - check_oracle_type(Ann, OracleType), - {Sign, [Oracle, Query, R]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_ORACLE_RESPOND, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_body(Query, Icode), ast_body(Sign, Icode), ast_body(R, Icode)], - [word, word, sign_t(), ast_type(RType, Icode)], {tuple, []}); - -builtin_code(_, {qid, Ann, ["Oracle", "get_question"]}, [Oracle, Q], [OracleType, ?query_t(QType, _)], _, Icode) -> - check_oracle_type(Ann, OracleType), - prim_call(?PRIM_CALL_ORACLE_GET_QUESTION, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], ast_type(QType, Icode)); - -builtin_code(_, {qid, Ann, ["Oracle", "get_answer"]}, [Oracle, Q], [OracleType, ?query_t(_, RType)], _, Icode) -> - check_oracle_type(Ann, OracleType), - prim_call(?PRIM_CALL_ORACLE_GET_ANSWER, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], aeso_icode:option_typerep(ast_type(RType, Icode))); - -builtin_code(_, {qid, Ann, ["Oracle", "check"]}, [Oracle], [OracleType = ?oracle_t(Q, R)], _, Icode) -> - check_oracle_type(Ann, OracleType), - prim_call(?PRIM_CALL_ORACLE_CHECK, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_type_value(Q, Icode), ast_type_value(R, Icode)], - [word, typerep, typerep], word); - -builtin_code(_, {qid, Ann, ["Oracle", "check_query"]}, [Oracle, Query], [OracleType, ?query_t(Q, R)], _, Icode) -> - check_oracle_type(Ann, OracleType), - prim_call(?PRIM_CALL_ORACLE_CHECK_QUERY, #integer{value = 0}, - [ast_body(Oracle, Icode), ast_body(Query, Icode), - ast_type_value(Q, Icode), ast_type_value(R, Icode)], - [word, typerep, typerep], word); - -%% Name service -builtin_code(_, {qid, Ann, ["AENS", "resolve"]}, [Name, Key], _, ?option_t(Type), Icode) -> - case is_monomorphic(Type) of - true -> - case ast_type(Type, Icode) of - T when T == word; T == string -> ok; - _ -> gen_error({invalid_aens_resolve_type, Ann, Type}) - end, - prim_call(?PRIM_CALL_AENS_RESOLVE, #integer{value = 0}, - [ast_body(Name, Icode), ast_body(Key, Icode), ast_type_value(Type, Icode)], - [string, string, typerep], aeso_icode:option_typerep(ast_type(Type, Icode))); - false -> - gen_error({invalid_aens_resolve_type, Ann, Type}) - end; - -builtin_code(_, {qid, _, ["AENS", "preclaim"]}, Args, _, _, Icode) -> - {Sign, [Addr, CHash]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_AENS_PRECLAIM, #integer{value = 0}, - [ast_body(Addr, Icode), ast_body(CHash, Icode), ast_body(Sign, Icode)], - [word, word, sign_t()], {tuple, []}); - -builtin_code(_, {qid, _, ["AENS", "claim"]}, Args, _, _, Icode) -> - {Sign, [Addr, Name, Salt, NameFee]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_AENS_CLAIM, #integer{value = 0}, - [ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Salt, Icode), ast_body(NameFee, Icode), ast_body(Sign, Icode)], - [word, string, word, word, sign_t()], {tuple, []}); - -builtin_code(_, {qid, _, ["AENS", "transfer"]}, Args, _, _, Icode) -> - {Sign, [FromAddr, ToAddr, Name]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_AENS_TRANSFER, #integer{value = 0}, - [ast_body(FromAddr, Icode), ast_body(ToAddr, Icode), ast_body(Name, Icode), ast_body(Sign, Icode)], - [word, word, word, sign_t()], {tuple, []}); - -builtin_code(_, {qid, _, ["AENS", "revoke"]}, Args, _, _, Icode) -> - {Sign, [Addr, Name]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_AENS_REVOKE, #integer{value = 0}, - [ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(Sign, Icode)], - [word, word, sign_t()], {tuple, []}); - -builtin_code(_, {qid, _, ["AENS", "update"]}, Args, _, _, Icode) -> - {Sign, [Addr, Name, TTL, ClientTTL, Pointers]} = get_signature_arg(Args), - prim_call(?PRIM_CALL_AENS_UPDATE, #integer{value = 0}, - [ast_body(Addr, Icode), ast_body(Name, Icode), ast_body(TTL, Icode), ast_body(ClientTTL, Icode), ast_body(Pointers, Icode), ast_body(Sign, Icode)], - [word, string, word, word, word, sign_t()], {tuple, []}); - -%% -- Maps -%% -- lookup functions -builtin_code(_, {qid, _, ["Map", "lookup"]}, [Key, Map], _, _, Icode) -> - map_get(Key, Map, Icode); -builtin_code(_, {qid, _, ["Map", "lookup_default"]}, [Key, Map, Val], _, _, Icode) -> - {_, ValType} = check_monomorphic_map(Map, Icode), - Fun = {map_lookup_default, ast_typerep(ValType, Icode)}, - builtin_call(Fun, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]); -builtin_code(_, {qid, _, ["Map", "member"]}, [Key, Map], _, _, Icode) -> - builtin_call(map_member, [ast_body(Map, Icode), ast_body(Key, Icode)]); -builtin_code(_, {qid, _, ["Map", "size"]}, [Map], _, _, Icode) -> - builtin_call(map_size, [ast_body(Map, Icode)]); -builtin_code(_, {qid, _, ["Map", "delete"]}, [Key, Map], _, _, Icode) -> - map_del(Key, Map, Icode); - -%% -- map conversion to/from list -builtin_code(_, {qid, Ann, ["Map", "from_list"]}, [List], _, MapType, Icode) -> - {KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode), - builtin_call(map_from_list, [ast_body(List, Icode), map_empty(KeyType, ValType, Icode)]); - -builtin_code(_, {qid, _, ["Map", "to_list"]}, [Map], _, _, Icode) -> - map_tolist(Map, Icode); - -%% Crypto -builtin_code(_, {qid, _, ["Crypto", "verify_sig"]}, [Msg, PK, Sig], _, _, Icode) -> - prim_call(?PRIM_CALL_CRYPTO_VERIFY_SIG, #integer{value = 0}, - [ast_body(Msg, Icode), ast_body(PK, Icode), ast_body(Sig, Icode)], - [word, word, sign_t()], word); - -builtin_code(_, {qid, _, ["Crypto", "verify_sig_secp256k1"]}, [Msg, PK, Sig], _, _, Icode) -> - prim_call(?PRIM_CALL_CRYPTO_VERIFY_SIG_SECP256K1, #integer{value = 0}, - [ast_body(Msg, Icode), ast_body(PK, Icode), ast_body(Sig, Icode)], - [bytes_t(32), bytes_t(64), bytes_t(64)], word); - -builtin_code(_, {qid, _, ["Crypto", "ecverify_secp256k1"]}, [Msg, Addr, Sig], _, _, Icode) -> - prim_call(?PRIM_CALL_CRYPTO_ECVERIFY_SECP256K1, #integer{value = 0}, - [ast_body(Msg, Icode), ast_body(Addr, Icode), ast_body(Sig, Icode)], - [word, bytes_t(20), bytes_t(65)], word); - -builtin_code(_, {qid, _, ["Crypto", "ecrecover_secp256k1"]}, [Msg, Sig], _, _, Icode) -> - prim_call(?PRIM_CALL_CRYPTO_ECRECOVER_SECP256K1, #integer{value = 0}, - [ast_body(Msg, Icode), ast_body(Sig, Icode)], - [word, bytes_t(65)], aeso_icode:option_typerep(bytes_t(20))); - -builtin_code(_, {qid, _, ["Crypto", Op]}, [Term], [Type], _, Icode) - when Op == "sha3"; Op == "sha256"; Op == "blake2b" -> - generic_hash_primop(list_to_atom(Op), ast_body(Term, Icode), Type, Icode); -builtin_code(_, {qid, _, ["String", Op]}, [String], _, _, Icode) - when Op == "sha3"; Op == "sha256"; Op == "blake2b" -> - string_hash_primop(list_to_atom(Op), ast_body(String, Icode)); - -%% Strings -%% -- String length -builtin_code(_, {qid, _, ["String", "length"]}, [String], _, _, Icode) -> - builtin_call(string_length, [ast_body(String, Icode)]); - -%% -- String concat -builtin_code(_, {qid, _, ["String", "concat"]}, [String1, String2], _, _, Icode) -> - builtin_call(string_concat, [ast_body(String1, Icode), ast_body(String2, Icode)]); - -builtin_code(_, {qid, _, ["Bits", Fun]}, Args, _, _, Icode) - when Fun == "test"; Fun == "set"; Fun == "clear"; - Fun == "union"; Fun == "intersection"; Fun == "difference" -> - C = fun(N) when is_integer(N) -> #integer{ value = N }; - (X) -> X end, - Bin = fun(O) -> fun(A, B) -> #binop{ op = O, left = C(A), right = C(B) } end end, - And = Bin('band'), - Or = Bin('bor'), - Bsl = fun(A, B) -> (Bin('bsl'))(B, A) end, %% flipped arguments - Bsr = fun(A, B) -> (Bin('bsr'))(B, A) end, - Neg = fun(A) -> #unop{ op = 'bnot', rand = C(A) } end, - case [Fun | [ ast_body(Arg, Icode) || Arg <- Args ]] of - ["test", Bits, Ix] -> And(Bsr(Bits, Ix), 1); - ["set", Bits, Ix] -> Or(Bits, Bsl(1, Ix)); - ["clear", Bits, Ix] -> And(Bits, Neg(Bsl(1, Ix))); - ["union", A, B] -> Or(A, B); - ["intersection", A, B] -> And(A, B); - ["difference", A, B] -> And(A, Neg(And(A, B))) - end; -builtin_code(_, {qid, _, ["Bits", "sum"]}, [Bits], _, _, Icode) -> - builtin_call(popcount, [ast_body(Bits, Icode), #integer{ value = 0 }]); - -builtin_code(_, {qid, _, ["Int", "to_str"]}, [Int], _, _, Icode) -> - builtin_call(int_to_str, [ast_body(Int, Icode)]); - -builtin_code(_, {qid, _, ["Address", "to_str"]}, [Addr], _, _, Icode) -> - builtin_call(addr_to_str, [ast_body(Addr, Icode)]); -builtin_code(_, {qid, _, ["Address", "is_oracle"]}, [Addr], _, _, Icode) -> - prim_call(?PRIM_CALL_ADDR_IS_ORACLE, #integer{value = 0}, - [ast_body(Addr, Icode)], [word], word); -builtin_code(_, {qid, _, ["Address", "is_contract"]}, [Addr], _, _, Icode) -> - prim_call(?PRIM_CALL_ADDR_IS_CONTRACT, #integer{value = 0}, - [ast_body(Addr, Icode)], [word], word); -builtin_code(_, {qid, _, ["Address", "is_payable"]}, [Addr], _, _, Icode) -> - prim_call(?PRIM_CALL_ADDR_IS_PAYABLE, #integer{value = 0}, - [ast_body(Addr, Icode)], [word], word); -builtin_code(_, {qid, _, ["Address", "to_contract"]}, [Addr], _, _, Icode) -> - ast_body(Addr, Icode); - -builtin_code(_, {qid, _, ["Bytes", "to_int"]}, [Bytes], _, _, Icode) -> - {typed, _, _, {bytes_t, _, N}} = Bytes, - builtin_call({bytes_to_int, N}, [ast_body(Bytes, Icode)]); -builtin_code(_, {qid, _, ["Bytes", "to_str"]}, [Bytes], _, _, Icode) -> - {typed, _, _, {bytes_t, _, N}} = Bytes, - builtin_call({bytes_to_str, N}, [ast_body(Bytes, Icode)]); -builtin_code(_, {qid, _, ["Bytes", "concat"]}, [A, B], [TypeA, TypeB], _, Icode) -> - {bytes_t, _, M} = TypeA, - {bytes_t, _, N} = TypeB, - builtin_call({bytes_concat, M, N}, [ast_body(A, Icode), ast_body(B, Icode)]); -builtin_code(_, {qid, _, ["Bytes", "split"]}, [A], _, ResType, Icode) -> - {tuple_t, _, [{bytes_t, _, M}, {bytes_t, _, N}]} = ResType, - builtin_call({bytes_split, M, N}, [ast_body(A, Icode)]); -builtin_code(_As, Fun, _Args, _ArgsT, _RetT, _Icode) -> - gen_error({missing_code_for, Fun}). - -eta_expand(Id = {_, Ann0, _}, Type = {fun_t, _, [], ArgsT, _}, Icode) -> - Ann = [{origin, system} | Ann0], - Xs = [ {arg, Ann, {id, Ann, "%" ++ integer_to_list(I)}, T} || - {I, T} <- lists:zip(lists:seq(1, length(ArgsT)), ArgsT) ], - Args = [ {typed, Ann, X, T} || {arg, _, X, T} <- Xs ], - ast_body({lam, Ann, Xs, {app, Ann, {typed, Ann, Id, Type}, Args}}, Icode); -eta_expand(Id, _Type, _Icode) -> - gen_error({unapplied_builtin, Id}). - -check_monomorphic_map({typed, Ann, _, MapType}, Icode) -> - check_monomorphic_map(Ann, MapType, Icode). - --dialyzer({nowarn_function, check_monomorphic_map/3}). -check_monomorphic_map(Ann, ?map_t(KeyType, ValType), _Icode) -> - Err = fun(Why) -> gen_error({invalid_map_key_type, Why, Ann, KeyType}) end, - [ Err(polymorphic) || not is_monomorphic(KeyType) ], - [ Err(function) || not is_first_order_type(KeyType) ], - {KeyType, ValType}. - -map_empty(KeyType, ValType, Icode) -> - prim_call(?PRIM_CALL_MAP_EMPTY, #integer{value = 0}, - [ast_type_value(KeyType, Icode), - ast_type_value(ValType, Icode)], - [typerep, typerep], word). - -map_get(Key, Map = {typed, _Ann, _, MapType}, Icode) -> - {_KeyType, ValType} = check_monomorphic_map(aeso_syntax:get_ann(Key), MapType, Icode), - builtin_call({map_lookup, ast_type(ValType, Icode)}, [ast_body(Map, Icode), ast_body(Key, Icode)]). - -map_put(Key, Val, Map, Icode) -> - builtin_call(map_put, [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Val, Icode)]). - -map_del(Key, Map, Icode) -> - prim_call(?PRIM_CALL_MAP_DELETE, #integer{value = 0}, - [ast_body(Map, Icode), ast_body(Key, Icode)], - [word, word], word). - -map_tolist(Map, Icode) -> - {KeyType, ValType} = check_monomorphic_map(Map, Icode), - prim_call(?PRIM_CALL_MAP_TOLIST, #integer{value = 0}, - [ast_body(Map, Icode)], - [word], {list, {tuple, [ast_type(KeyType, Icode), ast_type(ValType, Icode)]}}). - -map_upd(Key, ValFun, Map = {typed, Ann, _, MapType}, Icode) -> - {_, ValType} = check_monomorphic_map(Ann, MapType, Icode), - FunName = {map_upd, ast_type(ValType, Icode)}, - Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(ValFun, Icode)], - builtin_call(FunName, Args). - -map_upd(Key, Default, ValFun, Map = {typed, Ann, _, MapType}, Icode) -> - {_, ValType} = check_monomorphic_map(Ann, MapType, Icode), - FunName = {map_upd_default, ast_type(ValType, Icode)}, - Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)], - builtin_call(FunName, Args). - -check_entrypoint_type(Ann, Name, Args, Ret) -> - CheckFirstOrder = fun(T, Err) -> - case is_first_order_type(T) of - false -> gen_error(Err); - true -> ok - end end, - CheckMonomorphic = fun(T, Err) -> - case is_monomorphic(T) of - false -> gen_error(Err); - true -> ok - end end, - [ CheckFirstOrder(T, {invalid_entrypoint, higher_order, Ann1, Name, {argument, X, T}}) - || {typed, Ann1, X, T} <- Args ], - CheckFirstOrder(Ret, {invalid_entrypoint, higher_order, Ann, Name, {result, Ret}}), - [ CheckMonomorphic(T, {invalid_entrypoint, polymorphic, Ann1, Name, {argument, X, T}}) - || {typed, Ann1, X, T} <- Args ], - CheckMonomorphic(Ret, {invalid_entrypoint, polymorphic, Ann, Name, {result, Ret}}). - -check_oracle_type(Ann, Type = ?oracle_t(QType, RType)) -> - [ gen_error({invalid_oracle_type, Why, Which, Ann, Type}) - || {Why, Check} <- [{polymorphic, fun is_monomorphic/1}, - {higher_order, fun is_first_order_type/1}], - {Which, T} <- [{query, QType}, {response, RType}], - not Check(T) ]. - -is_simple_type({tvar, _, _}) -> false; -is_simple_type({fun_t, _, _, _, _}) -> false; -is_simple_type(Ts) when is_list(Ts) -> lists:all(fun is_simple_type/1, Ts); -is_simple_type(T) when is_tuple(T) -> is_simple_type(tuple_to_list(T)); -is_simple_type(_) -> true. - -is_first_order_type({fun_t, _, _, _, _}) -> false; -is_first_order_type(Ts) when is_list(Ts) -> lists:all(fun is_first_order_type/1, Ts); -is_first_order_type(T) when is_tuple(T) -> is_first_order_type(tuple_to_list(T)); -is_first_order_type(_) -> true. - -is_monomorphic({tvar, _, _}) -> false; -is_monomorphic([H|T]) -> - is_monomorphic(H) andalso is_monomorphic(T); -is_monomorphic(T) when is_tuple(T) -> - is_monomorphic(tuple_to_list(T)); -is_monomorphic(_) -> true. - -%% Implemented as a contract call to the contract with address 0. -prim_call(Prim, Amount, Args, ArgTypes, OutType) -> - TypeHash = - case aeb_primops:op_needs_type_check(Prim) of - true -> - PrimBin = binary:encode_unsigned(Prim), - ArgType = {tuple, ArgTypes}, - <> = aeb_aevm_abi:function_type_hash(PrimBin, ArgType, OutType), - TH; - false -> - 0 - end, - #prim_call_contract{ gas = prim_gas_left, - address = #integer{ value = ?PRIM_CALLS_CONTRACT }, - value = Amount, - arg = #tuple{cpts = [#integer{ value = Prim }| Args]}, - type_hash= #integer{value = TypeHash} - }. - -generic_hash_primop(Op, Arg, {bytes_t, _, N}, _Icode) -> - %% Compile hashing bytes to String.hash. Makes it easier for the user to - %% predict the result. - string_hash_primop(Op, aeso_builtins:bytes_to_raw_string(N, Arg)); -generic_hash_primop(Op, Arg, Type, Icode) -> - PrimOp = case Op of - sha3 -> ?PRIM_CALL_CRYPTO_SHA3; - sha256 -> ?PRIM_CALL_CRYPTO_SHA256; - blake2b -> ?PRIM_CALL_CRYPTO_BLAKE2B - end, - ArgType = ast_type(Type, Icode), - TypeValue = type_value(ArgType), - prim_call(PrimOp, #integer{value = 0}, - [TypeValue, Arg], [typerep, ArgType], word). - -string_hash_primop(sha3, String) -> - #unop{ op = 'sha3', rand = String }; -string_hash_primop(Op, String) -> - PrimOp = case Op of - sha256 -> ?PRIM_CALL_CRYPTO_SHA256_STRING; - blake2b -> ?PRIM_CALL_CRYPTO_BLAKE2B_STRING - end, - prim_call(PrimOp, #integer{value = 0}, [String], [string], word). - -make_type_def(Args, Def, Icode = #{ type_vars := TypeEnv }) -> - TVars = [ X || {tvar, _, X} <- Args ], - fun(Types) -> - TypeEnv1 = maps:from_list(lists:zip(TVars, Types)), - ast_typerep1(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) }) - end. - --spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type(). -ast_typerep(Type) -> - ast_typerep(Type, aeso_icode:new([])). - -ast_typerep(Type, Icode) -> - case is_simple_type(Type) of - false -> gen_error({not_a_simple_type, Type}); - true -> ast_typerep1(Type, Icode) - end. - -ast_typerep1({id, _, Name}, Icode) -> - lookup_type_id(Name, [], Icode); -ast_typerep1({qid, _, Name}, Icode) -> - lookup_type_id(Name, [], Icode); -ast_typerep1({con, _, _}, _) -> - word; %% Contract type -ast_typerep1({bytes_t, _, Len}, _) -> - bytes_t(Len); -ast_typerep1({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid -> - ArgReps = [ ast_typerep1(Arg, Icode) || Arg <- Args ], - lookup_type_id(Name, ArgReps, Icode); -ast_typerep1({tvar,_,A}, #{ type_vars := TypeVars }) -> - case maps:get(A, TypeVars, undefined) of - undefined -> word; %% We serialize type variables just as addresses in the originating VM. - Type -> Type - end; -ast_typerep1({tuple_t,_,Cpts}, Icode) -> - {tuple, [ast_typerep1(C, Icode) || C<-Cpts]}; -ast_typerep1({record_t,Fields}, Icode) -> - {tuple, [ begin - {field_t, _, _, T} = Field, - ast_typerep1(T, Icode) - end || Field <- Fields]}; -ast_typerep1({fun_t,_,_,_,_}, _Icode) -> - function; -ast_typerep1({alias_t, T}, Icode) -> ast_typerep1(T, Icode); -ast_typerep1({variant_t, Cons}, Icode) -> - {variant, [ begin - {constr_t, _, _, Args} = Con, - [ ast_typerep1(Arg, Icode) || Arg <- Args ] - end || Con <- Cons ]}; -ast_typerep1({if_t, _, _, _, Else}, Icode) -> - ast_typerep1(Else, Icode). %% protected remote calls are not in AEVM - -ttl_t(Icode) -> - ast_typerep({qid, [], ["Chain", "ttl"]}, Icode). - -%% pointee_t(Icode) -> -%% ast_typerep({qid, [], ["AENS", "pointee"]}, Icode). - -sign_t() -> bytes_t(64). -bytes_t(Len) when Len =< 32 -> word; -bytes_t(Len) -> {tuple, lists:duplicate((31 + Len) div 32, word)}. - -get_signature_arg(Args0) -> - NamedArgs = [Arg || Arg = {named_arg, _, _, _} <- Args0], - Args = Args0 -- NamedArgs, - - DefaultVal = {tuple, [], [{int, [], 0}, {int, [], 0}]}, - Sig = - case NamedArgs of - [] -> DefaultVal; - [{named_arg, _, _, Val}] -> Val - end, - {Sig, Args}. - -lookup_type_id(Name, Args, #{ types := Types }) -> - case maps:get(Name, Types, undefined) of - undefined -> gen_error({undefined_type, Name}); - TDef -> TDef(Args) - end. - -ast_type_value(T, Icode) -> - type_value(ast_type(T, Icode)). - -type_value(word) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_WORD_TAG }] }; -type_value(string) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_STRING_TAG }] }; -type_value(typerep) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_TYPEREP_TAG }] }; -type_value({list, A}) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_LIST_TAG }, type_value(A)] }; -type_value({tuple, As}) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_TUPLE_TAG }, - #list{ elems = [ type_value(A) || A <- As ] }] }; -type_value({variant, Cs}) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_VARIANT_TAG }, - #list{ elems = [ #list{ elems = [ type_value(A) || A <- As ] } || As <- Cs ] }] }; -type_value({map, K, V}) -> - #tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG }, - type_value(K), type_value(V)] }. - -ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) -> - NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs], - aeso_icode:set_functions(NewFuns, Icode). - -%% A function is private if not an 'entrypoint', or if it's not defined in the -%% main contract name space. (NOTE: changes when we introduce inheritance). -is_private(Ann, #{ contract_name := MainContract } = Icode) -> - {_, _, CurrentNamespace} = aeso_icode:get_namespace(Icode), - not proplists:get_value(entrypoint, Ann, false) orelse - MainContract /= CurrentNamespace. - -%% ------------------------------------------------------------------- -%% Builtins -%% ------------------------------------------------------------------- - -builtin_call(Builtin, Args) -> - #funcall{ function = #var_ref{ name = {builtin, Builtin} }, - args = Args }. - -add_builtins(Icode = #{functions := Funs}) -> - Builtins = aeso_builtins:used_builtins(Funs), - Icode#{functions := [ aeso_builtins:builtin_function(B) || B <- Builtins ] ++ Funs}. - - -%% ------------------------------------------------------------------- -%% Deadcode elimination -%% ------------------------------------------------------------------- - -deadcode_elimination(Icode = #{ functions := Funs }) -> - PublicNames = [ Name || {Name, Ann, _, _, _} <- Funs, not lists:member(private, Ann) ], - ArgsToPat = fun(Args) -> [ #var_ref{ name = X } || {X, _} <- Args ] end, - Defs = maps:from_list([ {Name, {binder, ArgsToPat(Args), Body}} || {Name, _, Args, Body, _} <- Funs ]), - UsedNames = chase_names(Defs, PublicNames, #{}), - UsedFuns = [ Def || Def = {Name, _, _, _, _} <- Funs, maps:is_key(Name, UsedNames) ], - Icode#{ functions := UsedFuns }. - -chase_names(_Defs, [], Used) -> Used; -chase_names(Defs, [X | Xs], Used) -> - %% can happen when compiling __call contracts - case maps:is_key(X, Used) orelse not maps:is_key(X, Defs) of - true -> chase_names(Defs, Xs, Used); %% already chased - false -> - Def = maps:get(X, Defs), - Vars = maps:keys(free_vars(Def)), - chase_names(Defs, Vars ++ Xs, Used#{ X => true }) - end. - -free_vars(#var_ref{ name = X }) -> #{ X => true }; -free_vars(#arg{ name = X }) -> #{ X => true }; -free_vars({binder, Pat, Body}) -> - maps:without(maps:keys(free_vars(Pat)), free_vars(Body)); -free_vars(#switch{ expr = E, cases = Cases }) -> - free_vars([E | [{binder, P, B} || {P, B} <- Cases]]); -free_vars(#lambda{ args = Xs, body = E }) -> - free_vars({binder, Xs, E}); -free_vars(T) when is_tuple(T) -> free_vars(tuple_to_list(T)); -free_vars([H | T]) -> maps:merge(free_vars(H), free_vars(T)); -free_vars(_) -> #{}. diff --git a/src/aeso_builtins.erl b/src/aeso_builtins.erl deleted file mode 100644 index 14761dd..0000000 --- a/src/aeso_builtins.erl +++ /dev/null @@ -1,684 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @copyright (C) 2018, Aeternity Anstalt -%%% @doc -%%% Compiler builtin functions for Aeterinty Sophia language. -%%% @end -%%% Created : 20 Dec 2018 -%%% -%%%------------------------------------------------------------------- - --module(aeso_builtins). - --export([ builtin_function/1 - , bytes_to_raw_string/2 - , check_event_type/1 - , used_builtins/1 ]). - --import(aeso_ast_to_icode, [prim_call/5]). - --include_lib("aebytecode/include/aeb_opcodes.hrl"). --include("aeso_icode.hrl"). - -used_builtins(#funcall{ function = #var_ref{ name = {builtin, Builtin} }, args = Args }) -> - lists:umerge(dep_closure([Builtin]), used_builtins(Args)); -used_builtins([H|T]) -> - lists:umerge(used_builtins(H), used_builtins(T)); -used_builtins(T) when is_tuple(T) -> - used_builtins(tuple_to_list(T)); -used_builtins(M) when is_map(M) -> - used_builtins(maps:to_list(M)); -used_builtins(_) -> []. - -builtin_deps(Builtin) -> - lists:usort(builtin_deps1(Builtin)). - -builtin_deps1({map_lookup_default, Type}) -> [{map_lookup, Type}]; -builtin_deps1({map_get, Type}) -> [{map_lookup, Type}]; -builtin_deps1(map_member) -> [{map_lookup, word}]; -builtin_deps1({map_upd, Type}) -> [{map_get, Type}, map_put]; -builtin_deps1({map_upd_default, Type}) -> [{map_lookup_default, Type}, map_put]; -builtin_deps1(map_from_list) -> [map_put]; -builtin_deps1(str_equal) -> [str_equal_p]; -builtin_deps1(string_concat) -> [string_concat_inner1, string_copy, string_shift_copy]; -builtin_deps1(int_to_str) -> [{baseX_int, 10}]; -builtin_deps1(addr_to_str) -> [{baseX_int, 58}]; -builtin_deps1({baseX_int, X}) -> [{baseX_int_pad, X}]; -builtin_deps1({baseX_int_pad, X}) -> [{baseX_int_encode, X}]; -builtin_deps1({baseX_int_encode, X}) -> [{baseX_int_encode_, X}, {baseX_tab, X}, {baseX_digits, X}]; -builtin_deps1({bytes_to_str, _}) -> [bytes_to_str_worker, bytes_to_str_worker_x]; -builtin_deps1(string_reverse) -> [string_reverse_]; -builtin_deps1(require) -> [abort]; -builtin_deps1(_) -> []. - -dep_closure(Deps) -> - case lists:umerge(lists:map(fun builtin_deps/1, Deps)) of - [] -> Deps; - Deps1 -> lists:umerge(Deps, dep_closure(Deps1)) - end. - -%% Helper functions/macros -v(X) when is_atom(X) -> v(atom_to_list(X)); -v(X) when is_list(X) -> #var_ref{name = X}. - -option_none() -> {tuple, [{integer, 0}]}. -option_some(X) -> {tuple, [{integer, 1}, X]}. - --define(HASH_BYTES, 32). - --define(call(Fun, Args), #funcall{ function = #var_ref{ name = {builtin, Fun} }, args = Args }). --define(I(X), {integer, X}). --define(V(X), v(X)). --define(A(Op), aeb_opcodes:mnemonic(Op)). --define(LET(Var, Expr, Body), {switch, Expr, [{v(Var), Body}]}). --define(DEREF(Var, Ptr, Body), {switch, operand(Ptr), [{{tuple, [v(Var)]}, Body}]}). --define(NXT(Ptr), op('+', Ptr, 32)). --define(NEG(A), op('/', A, {unop, '-', {integer, 1}})). --define(BYTE(Ix, Word), op('byte', Ix, Word)). - --define(EQ(A, B), op('==', A, B)). --define(LT(A, B), op('<', A, B)). --define(GT(A, B), op('>', A, B)). --define(ADD(A, B), op('+', A, B)). --define(SUB(A, B), op('-', A, B)). --define(MUL(A, B), op('*', A, B)). --define(DIV(A, B), op('div', A, B)). --define(MOD(A, B), op('mod', A, B)). --define(EXP(A, B), op('^', A, B)). --define(AND(A, B), op('&&', A, B)). - -%% Bit shift operations takes their arguments backwards!? --define(BSL(X, B), op('bsl', ?MUL(B, 8), X)). --define(BSR(X, B), op('bsr', ?MUL(B, 8), X)). - -op(Op, A, B) -> simpl({binop, Op, operand(A), operand(B)}). - -%% We generate a lot of B * 8 for integer B from BSL and BSR. -simpl({binop, '*', {integer, A}, {integer, B}}) when A >= 0, B >= 0, A * B < 1 bsl 256 -> - {integer, A * B}; -simpl(Op) -> Op. - - -operand(A) when is_atom(A) -> v(A); -operand(I) when is_integer(I) -> {integer, I}; -operand(T) -> T. - -check_event_type(Icode) -> - case maps:get(event_type, Icode) of - {variant_t, Cons} -> - check_event_type(Cons, Icode); - _ -> - error({event_should_be_variant_type}) - end. - -check_event_type(Evts, Icode) -> - [ check_event_type(Name, Ix, T, Icode) - || {constr_t, Ann, {con, _, Name}, Types} <- Evts, - {Ix, T} <- lists:zip(aeso_syntax:get_ann(indices, Ann), Types) ]. - -check_event_type(EvtName, Ix, Type, Icode) -> - VMType = - try - aeso_ast_to_icode:ast_typerep(Type, Icode) - catch _:_ -> - error({EvtName, could_not_resolve_type, Type}) - end, - case {Ix, VMType, Type} of - {indexed, word, _} -> ok; - {notindexed, string, _} -> ok; - {notindexed, _, {bytes_t, _, N}} when N > 32 -> ok; - {indexed, _, _} -> error({EvtName, indexed_field_should_be_word, is, VMType}); - {notindexed, _, _} -> error({EvtName, payload_should_be_string, is, VMType}) - end. - -bfun(B, {IArgs, IExpr, IRet}) -> - {{builtin, B}, [private], IArgs, IExpr, IRet}. - -builtin_function(BF) -> - case BF of - {event, EventT} -> bfun(BF, builtin_event(EventT)); - abort -> bfun(BF, builtin_abort()); - block_hash -> bfun(BF, builtin_block_hash()); - require -> bfun(BF, builtin_require()); - {map_lookup, Type} -> bfun(BF, builtin_map_lookup(Type)); - map_put -> bfun(BF, builtin_map_put()); - map_delete -> bfun(BF, builtin_map_delete()); - map_size -> bfun(BF, builtin_map_size()); - {map_get, Type} -> bfun(BF, builtin_map_get(Type)); - {map_lookup_default, Type} -> bfun(BF, builtin_map_lookup_default(Type)); - map_member -> bfun(BF, builtin_map_member()); - {map_upd, Type} -> bfun(BF, builtin_map_upd(Type)); - {map_upd_default, Type} -> bfun(BF, builtin_map_upd_default(Type)); - map_from_list -> bfun(BF, builtin_map_from_list()); - list_concat -> bfun(BF, builtin_list_concat()); - string_length -> bfun(BF, builtin_string_length()); - string_concat -> bfun(BF, builtin_string_concat()); - string_concat_inner1 -> bfun(BF, builtin_string_concat_inner1()); - string_copy -> bfun(BF, builtin_string_copy()); - string_shift_copy -> bfun(BF, builtin_string_shift_copy()); - str_equal_p -> bfun(BF, builtin_str_equal_p()); - str_equal -> bfun(BF, builtin_str_equal()); - popcount -> bfun(BF, builtin_popcount()); - int_to_str -> bfun(BF, builtin_int_to_str()); - addr_to_str -> bfun(BF, builtin_addr_to_str()); - {baseX_int, X} -> bfun(BF, builtin_baseX_int(X)); - {baseX_digits, X} -> bfun(BF, builtin_baseX_digits(X)); - {baseX_tab, X} -> bfun(BF, builtin_baseX_tab(X)); - {baseX_int_pad, X} -> bfun(BF, builtin_baseX_int_pad(X)); - {baseX_int_encode, X} -> bfun(BF, builtin_baseX_int_encode(X)); - {baseX_int_encode_, X} -> bfun(BF, builtin_baseX_int_encode_(X)); - {bytes_to_int, N} -> bfun(BF, builtin_bytes_to_int(N)); - {bytes_to_str, N} -> bfun(BF, builtin_bytes_to_str(N)); - {bytes_concat, A, B} -> bfun(BF, builtin_bytes_concat(A, B)); - {bytes_split, A, B} -> bfun(BF, builtin_bytes_split(A, B)); - bytes_to_str_worker -> bfun(BF, builtin_bytes_to_str_worker()); - bytes_to_str_worker_x -> bfun(BF, builtin_bytes_to_str_worker_x()); - string_reverse -> bfun(BF, builtin_string_reverse()); - string_reverse_ -> bfun(BF, builtin_string_reverse_()) - end. - -%% Event primitive (dependent on Event type) -%% -%% We need to switch on the event and prepare the correct #event for icode_to_asm -%% NOTE: we assume all errors are already checked! -builtin_event(EventT) -> - A = fun(X) -> aeb_opcodes:mnemonic(X) end, - VIx = fun(Ix) -> v(lists:concat(["v", Ix])) end, - ArgPats = fun(Ts) -> [ VIx(Ix) || Ix <- lists:seq(0, length(Ts) - 1) ] end, - Payload = %% Should put data ptr, length on stack. - fun([]) -> {inline_asm, [A(?PUSH1), 0, A(?PUSH1), 0]}; - ([{{id, _, "string"}, V}]) -> - {seq, [V, {inline_asm, [A(?DUP1), A(?MLOAD), %% length, ptr - A(?SWAP1), A(?PUSH1), 32, A(?ADD)]}]}; %% ptr+32, length - ([{{bytes_t, _, N}, V}]) -> {seq, [V, {integer, N}, {inline_asm, A(?SWAP1)}]} - end, - Ix = - fun({bytes_t, _, N}, V) when N < 32 -> ?BSR(V, 32 - N); - (_, V) -> V end, - Clause = - fun(_Tag, {con, _, Con}, IxTypes) -> - Types = [ T || {_Ix, T} <- IxTypes ], - Indexed = [ Ix(Type, Var) || {Var, {indexed, Type}} <- lists:zip(ArgPats(Types), IxTypes) ], - Data = [ {Type, Var} || {Var, {notindexed, Type}} <- lists:zip(ArgPats(Types), IxTypes) ], - {ok, <>} = eblake2:blake2b(?HASH_BYTES, list_to_binary(Con)), - EvtIndex = {integer, EvtIndexN}, - {event, lists:reverse(Indexed) ++ [EvtIndex], Payload(Data)} - end, - Pat = fun(Tag, Types) -> {tuple, [{integer, Tag} | ArgPats(Types)]} end, - - {variant_t, Cons} = EventT, - Tags = lists:seq(0, length(Cons) - 1), - - {[{"e", event}], - {switch, v(e), - [{Pat(Tag, Types), Clause(Tag, Con, lists:zip(aeso_syntax:get_ann(indices, Ann), Types))} - || {Tag, {constr_t, Ann, Con, Types}} <- lists:zip(Tags, Cons) ]}, - {tuple, []}}. - -%% Abort primitive. -builtin_abort() -> - A = fun(X) -> aeb_opcodes:mnemonic(X) end, - {[{"s", string}], - {inline_asm, [A(?PUSH1),0, %% Push a dummy 0 for the first arg - A(?REVERT)]}, %% Stack: 0,Ptr - {tuple,[]}}. - -builtin_block_hash() -> - {[{"height", word}], - ?LET(hash, #prim_block_hash{ height = ?V(height)}, - {ifte, ?EQ(hash, 0), option_none(), option_some(?V(hash))}), - aeso_icode:option_typerep(word)}. - -builtin_require() -> - {[{"c", word}, {"msg", string}], - {ifte, ?V(c), {tuple, []}, ?call(abort, [?V(msg)])}, - {tuple, []}}. - -%% Map primitives -builtin_map_lookup(Type) -> - Ret = aeso_icode:option_typerep(Type), - {[{"m", word}, {"k", word}], - prim_call(?PRIM_CALL_MAP_GET, #integer{value = 0}, - [#var_ref{name = "m"}, #var_ref{name = "k"}], - [word, word], Ret), - Ret}. - -builtin_map_put() -> - %% We don't need the types for put. - {[{"m", word}, {"k", word}, {"v", word}], - prim_call(?PRIM_CALL_MAP_PUT, #integer{value = 0}, - [v(m), v(k), v(v)], [word, word, word], word), - word}. - -builtin_map_delete() -> - {[{"m", word}, {"k", word}], - prim_call(?PRIM_CALL_MAP_DELETE, #integer{value = 0}, - [v(m), v(k)], [word, word], word), - word}. - -builtin_map_size() -> - {[{"m", word}], - prim_call(?PRIM_CALL_MAP_SIZE, #integer{value = 0}, - [v(m)], [word], word), - word}. - -%% Map builtins -builtin_map_get(Type) -> - %% function map_get(m, k) = - %% switch(map_lookup(m, k)) - %% Some(v) => v - {[{"m", word}, {"k", word}], - {switch, ?call({map_lookup, Type}, [v(m), v(k)]), [{option_some(v(v)), v(v)}]}, - Type}. - -builtin_map_lookup_default(Type) -> - %% function map_lookup_default(m, k, default) = - %% switch(map_lookup(m, k)) - %% None => default - %% Some(v) => v - {[{"m", word}, {"k", word}, {"default", Type}], - {switch, ?call({map_lookup, Type}, [v(m), v(k)]), - [{option_none(), v(default)}, - {option_some(v(v)), v(v)}]}, - Type}. - -builtin_map_member() -> - %% function map_member(m, k) : bool = - %% switch(Map.lookup(m, k)) - %% None => false - %% _ => true - {[{"m", word}, {"k", word}], - {switch, ?call({map_lookup, word}, [v(m), v(k)]), - [{option_none(), {integer, 0}}, - {{var_ref, "_"}, {integer, 1}}]}, - word}. - -builtin_map_upd(Type) -> - %% function map_upd(map, key, fun) = - %% map_put(map, key, fun(map_get(map, key))) - {[{"map", word}, {"key", word}, {"valfun", word}], - ?call(map_put, - [v(map), v(key), - #funcall{ function = v(valfun), - args = [?call({map_get, Type}, [v(map), v(key)])] }]), - word}. - -builtin_map_upd_default(Type) -> - %% function map_upd(map, key, val, fun) = - %% map_put(map, key, fun(map_lookup_default(map, key, val))) - {[{"map", word}, {"key", word}, {"val", word}, {"valfun", word}], - ?call(map_put, - [v(map), v(key), - #funcall{ function = v(valfun), - args = [?call({map_lookup_default, Type}, [v(map), v(key), v(val)])] }]), - word}. - -builtin_map_from_list() -> - %% function map_from_list(xs, acc) = - %% switch(xs) - %% [] => acc - %% (k, v) :: xs => map_from_list(xs, acc { [k] = v }) - {[{"xs", {list, {tuple, [word, word]}}}, {"acc", word}], - {switch, v(xs), - [{{list, []}, v(acc)}, - {{binop, '::', {tuple, [v(k), v(v)]}, v(ys)}, - ?call(map_from_list, - [v(ys), ?call(map_put, [v(acc), v(k), v(v)])])}]}, - word}. - -%% list_concat -%% -%% Concatenates two lists. -builtin_list_concat() -> - {[{"l1", {list, word}}, {"l2", {list, word}}], - {switch, v(l1), - [{{list, []}, v(l2)}, - {{binop, '::', v(hd), v(tl)}, - {binop, '::', v(hd), ?call(list_concat, [v(tl), v(l2)])}} - ] - }, - word}. - -builtin_string_length() -> - %% function length(str) = - %% switch(str) - %% {n} -> n // (ab)use the representation - {[{"s", string}], - ?DEREF(n, s, ?V(n)), - word}. - -%% str_concat - concatenate two strings -%% -%% Unless the second string is the empty string, a new string is created at the -%% top of the Heap and the address to it is returned. The tricky bit is when -%% the words from the second string has to be shifted to fit next to the first -%% string. -builtin_string_concat() -> - {[{"s1", string}, {"s2", string}], - ?DEREF(n1, s1, - ?DEREF(n2, s2, - {ifte, ?EQ(n1, 0), - ?V(s2), %% First string is empty return second string - {ifte, ?EQ(n2, 0), - ?V(s1), %% Second string is empty return first string - ?LET(ret, {inline_asm, [?A(?MSIZE)]}, - {seq, [?ADD(n1, n2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, %% Store total len - ?call(string_concat_inner1, [?V(n1), ?NXT(s1), ?V(n2), ?NXT(s2)]), - {inline_asm, [?A(?POP)]}, %% Discard fun ret val - ?V(ret) %% Put the actual return value - ]})} - } - )), - word}. - -builtin_string_concat_inner1() -> - %% Copy all whole words from the first string, and set up for word fusion - %% Special case when the length of the first string is divisible by 32. - {[{"n1", word}, {"p1", pointer}, {"n2", word}, {"p2", pointer}], - ?LET(w1, ?call(string_copy, [?V(n1), ?V(p1)]), - ?LET(nx, ?MOD(n1, 32), - {ifte, ?EQ(nx, 0), - ?LET(w2, ?call(string_copy, [?V(n2), ?V(p2)]), - {seq, [?V(w2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}), - ?call(string_shift_copy, [?V(nx), ?V(w1), ?V(n2), ?V(p2)]) - })), - word}. - -builtin_string_copy() -> - {[{"n", word}, {"p", pointer}], - ?DEREF(w, p, - {ifte, ?GT(n, 31), - {seq, [?V(w), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - ?call(string_copy, [?SUB(n, 32), ?NXT(p)])]}, - ?V(w) - }), - word}. - -builtin_string_shift_copy() -> - {[{"off", word}, {"dst", word}, {"n", word}, {"p", pointer}], - ?DEREF(w, p, - {seq, [?ADD(dst, ?BSR(w, off)), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - {ifte, ?GT(n, ?SUB(32, off)), - ?call(string_shift_copy, [?V(off), ?BSL(w, ?SUB(32, off)), ?SUB(n, 32), ?NXT(p)]), - {inline_asm, [?A(?MSIZE)]}}] - }), - word}. - -builtin_str_equal_p() -> - %% function str_equal_p(n, p1, p2) = - %% if(n =< 0) true - %% else - %% let w1 = *p1 - %% let w2 = *p2 - %% w1 == w2 && str_equal_p(n - 32, p1 + 32, p2 + 32) - {[{"n", word}, {"p1", pointer}, {"p2", pointer}], - {ifte, ?LT(n, 1), - ?I(1), - ?DEREF(w1, p1, - ?DEREF(w2, p2, - ?AND(?EQ(w1, w2), - ?call(str_equal_p, [?SUB(n, 32), ?NXT(p1), ?NXT(p2)]))))}, - word}. - -builtin_str_equal() -> - %% function str_equal(s1, s2) = - %% let n1 = length(s1) - %% let n2 = length(s2) - %% n1 == n2 && str_equal_p(n1, s1 + 32, s2 + 32) - {[{"s1", string}, {"s2", string}], - ?DEREF(n1, s1, - ?DEREF(n2, s2, - ?AND(?EQ(n1, n2), ?call(str_equal_p, [?V(n1), ?NXT(s1), ?NXT(s2)])) - )), - word}. - -%% Count the number of 1s in a bit field. -builtin_popcount() -> - %% function popcount(bits, acc) = - %% if (bits == 0) acc - %% else popcount(bits bsr 1, acc + bits band 1) - {[{"bits", word}, {"acc", word}], - {ifte, ?EQ(bits, 0), - ?V(acc), - ?call(popcount, [op('bsr', 1, bits), ?ADD(acc, op('band', bits, 1))]) - }, word}. - -builtin_int_to_str() -> - {[{"i", word}], ?call({baseX_int, 10}, [?V(i)]), word}. - -builtin_baseX_tab(_X = 10) -> - {[{"ix", word}], ?ADD($0, ix), word}; -builtin_baseX_tab(_X = 58) -> - <> = <<"123456789ABCDEFGHJKLMNPQRSTUVWXY">>, - <> = <<"Zabcdefghijkmnopqrstuvwxyz", 0:48>>, - {[{"ix", word}], - {ifte, ?LT(ix, 32), - ?BYTE(ix, Fst32), - ?BYTE(?SUB(ix, 32), Lst26) - }, - word}. - -builtin_baseX_int(X) -> - {[{"w", word}], - ?LET(ret, {inline_asm, [?A(?MSIZE)]}, - {seq, [?call({baseX_int_pad, X}, [?V(w), ?I(0), ?I(0)]), {inline_asm, [?A(?POP)]}, ?V(ret)]}), - word}. - -builtin_baseX_int_pad(X = 10) -> - {[{"src", word}, {"ix", word}, {"dst", word}], - {ifte, ?LT(src, 0), - ?call({baseX_int_encode, X}, [?NEG(src), ?I(1), ?BSL($-, 31)]), - ?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)])}, - word}; -builtin_baseX_int_pad(X = 16) -> - {[{"src", word}, {"ix", word}, {"dst", word}], - ?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)]), - word}; -builtin_baseX_int_pad(X = 58) -> - {[{"src", word}, {"ix", word}, {"dst", word}], - {ifte, ?GT(?ADD(?DIV(ix, 31), ?BYTE(ix, src)), 0), - ?call({baseX_int_encode, X}, [?V(src), ?V(ix), ?V(dst)]), - ?call({baseX_int_pad, X}, [?V(src), ?ADD(ix, 1), ?ADD(dst, ?BSL($1, ?SUB(31, ix)))])}, - word}. - -builtin_baseX_int_encode(X) -> - {[{"src", word}, {"ix", word}, {"dst", word}], - ?LET(n, ?call({baseX_digits, X}, [?V(src), ?I(0)]), - {seq, [?ADD(n, ?ADD(ix, 1)), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - ?call({baseX_int_encode_, X}, [?V(src), ?V(dst), ?EXP(X, n), ?V(ix)])]}), - word}. - -builtin_baseX_int_encode_(X) -> - {[{"src", word}, {"dst", word}, {"fac", word}, {"ix", word}], - {ifte, ?EQ(fac, 0), - {seq, [?V(dst), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}, - {ifte, ?EQ(ix, 32), - %% We've filled a word, write it and start on new word - {seq, [?V(dst), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - ?call({baseX_int_encode_, X}, [?V(src), ?I(0), ?V(fac), ?I(0)])]}, - ?call({baseX_int_encode_, X}, - [?MOD(src, fac), ?ADD(dst, ?BSL(?call({baseX_tab, X}, [?DIV(src, fac)]), ?SUB(31, ix))), - ?DIV(fac, X), ?ADD(ix, 1)])} - }, - word}. - -builtin_baseX_digits(X) -> - {[{"x0", word}, {"dgts", word}], - ?LET(x1, ?DIV(x0, X), - {ifte, ?EQ(x1, 0), ?V(dgts), ?call({baseX_digits, X}, [?V(x1), ?ADD(dgts, 1)])}), - word}. - -builtin_bytes_to_int(32) -> - {[{"w", word}], ?V(w), word}; -builtin_bytes_to_int(N) when N < 32 -> - {[{"w", word}], ?BSR(w, 32 - N), word}; -builtin_bytes_to_int(N) when N > 32 -> - LastFullWord = N div 32 - 1, - Body = case N rem 32 of - 0 -> ?DEREF(n, ?ADD(b, LastFullWord * 32), ?V(n)); - R -> - ?DEREF(hi, ?ADD(b, LastFullWord * 32), - ?DEREF(lo, ?ADD(b, (LastFullWord + 1) * 32), - ?ADD(?BSR(lo, 32 - R), ?BSL(hi, R)))) - end, - {[{"b", pointer}], Body, word}. - -%% Two versions of this helper function, worker for sections not even 16 bytes long -%% and worker_x for the full sized chunks. -builtin_bytes_to_str_worker_x() -> - <> = <<"0123456789ABCDEF________________">>, - {[{"w", word}, {"offs", word}, {"acc", word}], - {ifte, ?EQ(offs, 16), {seq, [?V(acc), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}, - ?LET(b, ?BYTE(offs, w), - ?LET(lo, ?BYTE(?MOD(b, 16), Tab), - ?LET(hi, ?BYTE(op('bsr', 4 , b), Tab), - ?call(bytes_to_str_worker_x, [?V(w), ?ADD(offs, 1), ?ADD(?BSL(acc, 2), ?ADD(?BSL(hi, 1), lo))])))) - }, - word}. - -builtin_bytes_to_str_worker() -> - <> = <<"0123456789ABCDEF________________">>, - {[{"w", word}, {"offs", word}, {"acc", word}, {"stop", word}], - {ifte, ?EQ(stop, offs), {seq, [?BSL(acc, ?MUL(2, ?SUB(16, offs))), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}, - ?LET(b, ?BYTE(offs, w), - ?LET(lo, ?BYTE(?MOD(b, 16), Tab), - ?LET(hi, ?BYTE(op('bsr', 4 , b), Tab), - ?call(bytes_to_str_worker, [?V(w), ?ADD(offs, 1), ?ADD(?BSL(acc, 2), ?ADD(?BSL(hi, 1), lo)), ?V(stop)])))) - }, - word}. - -builtin_bytes_to_str_body(Var, N) when N < 16 -> - [?call(bytes_to_str_worker, [?V(Var), ?I(0), ?I(0), ?I(N)])]; -builtin_bytes_to_str_body(Var, 16) -> - [?call(bytes_to_str_worker_x, [?V(Var), ?I(0), ?I(0)])]; -builtin_bytes_to_str_body(Var, N) when N < 32 -> - builtin_bytes_to_str_body(Var, 16) ++ [{inline_asm, [?A(?POP)]}] ++ - [?call(bytes_to_str_worker, [?BSL(Var, 16), ?I(0), ?I(0), ?I(N - 16)])]; -builtin_bytes_to_str_body(Var, 32) -> - builtin_bytes_to_str_body(Var, 16) ++ [{inline_asm, [?A(?POP)]}] ++ - [?call(bytes_to_str_worker_x, [?BSL(Var, 16), ?I(0), ?I(0)])]; -builtin_bytes_to_str_body(Var, N) when N > 32 -> - WholeWords = ((N + 31) div 32) - 1, - lists:append( - [ [?DEREF(w, ?ADD(Var, 32 * I), {seq, builtin_bytes_to_str_body(w, 32)}), {inline_asm, [?A(?POP)]}] - || I <- lists:seq(0, WholeWords - 1) ]) ++ - [ ?DEREF(w, ?ADD(Var, 32 * WholeWords), {seq, builtin_bytes_to_str_body(w, N - WholeWords * 32)}) ]. - -builtin_bytes_to_str(N) when N =< 32 -> - {[{"w", word}], - ?LET(ret, {inline_asm, [?A(?MSIZE)]}, - {seq, [?I(N * 2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}] ++ - builtin_bytes_to_str_body(w, N) ++ - [{inline_asm, [?A(?POP)]}, ?V(ret)]}), - string}; -builtin_bytes_to_str(N) when N > 32 -> - {[{"p", pointer}], - ?LET(ret, {inline_asm, [?A(?MSIZE)]}, - {seq, [?I(N * 2), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}] ++ - builtin_bytes_to_str_body(p, N) ++ - [{inline_asm, [?A(?POP)]}, ?V(ret)]}), - string}. - -builtin_string_reverse() -> - {[{"s", string}], - ?DEREF(n, s, - ?LET(ret, {inline_asm, [?A(?MSIZE)]}, - {seq, [?V(n), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - ?call(string_reverse_, [?NXT(s), ?I(0), ?I(31), ?SUB(?V(n), 1)]), - {inline_asm, [?A(?POP)]}, ?V(ret)]})), - word}. - -builtin_string_reverse_() -> - {[{"p", pointer}, {"x", word}, {"i1", word}, {"i2", word}], - {ifte, ?LT(i2, 0), - {seq, [?V(x), {inline_asm, [?A(?MSIZE), ?A(?MSTORE), ?A(?MSIZE)]}]}, - ?LET(p1, ?ADD(p, ?MUL(?DIV(i2, 32), 32)), - ?DEREF(w, p1, - ?LET(b, ?BYTE(?MOD(i2, 32), w), - {ifte, ?LT(i1, 0), - {seq, [?V(x), {inline_asm, [?A(?MSIZE), ?A(?MSTORE)]}, - ?call(string_reverse_, - [?V(p), ?BSL(b, 31), ?I(30), ?SUB(i2, 1)])]}, - ?call(string_reverse_, - [?V(p), ?ADD(x, ?BSL(b, i1)), ?SUB(i1, 1), ?SUB(i2, 1)])})))}, - word}. - -builtin_addr_to_str() -> - {[{"a", word}], ?call({baseX_int, 58}, [?V(a)]), word}. - -%% At most one word -%% | ..... | ========= | ........ | -%% Offs ^ ^- Len -^ TotalLen ^ -bytes_slice(Offs, Len, TotalLen, Bytes) when TotalLen =< 32 -> - %% Bytes are packed into a single word - Masked = - case Offs of - 0 -> Bytes; - _ -> ?MOD(Bytes, 1 bsl ((32 - Offs) * 8)) - end, - Unpadded = - case 32 - (Offs + Len) of - 0 -> Masked; - N -> ?BSR(Masked, N) - end, - case Len of - 32 -> Unpadded; - _ -> ?BSL(Unpadded, 32 - Len) - end; -bytes_slice(Offs, Len, TotalLen, Bytes) when TotalLen > 32 -> - %% Bytes is a pointer to memory. The VM can read at non-aligned addresses. - %% Might read one word more than necessary. - Word = op('!', Offs, Bytes), - case Len == 32 of - true -> Word; - _ -> ?BSL(?BSR(Word, 32 - Len), 32 - Len) - end. - -builtin_bytes_concat(A, B) -> - Type = fun(N) when N =< 32 -> word; (_) -> pointer end, - MkBytes = fun([W]) -> W; - (Ws) -> {tuple, Ws} end, - Words = fun(N) -> (N + 31) div 32 end, - WordsRes = Words(A + B), - Word = fun(I) when 32 * (I + 1) =< A -> bytes_slice(I * 32, 32, A, ?V(a)); - (I) when 32 * I < A -> - Len = A rem 32, - Hi = bytes_slice(32 * I, Len, A, ?V(a)), - Lo = bytes_slice(0, min(32 - Len, B), B, ?V(b)), - ?ADD(Hi, ?BSR(Lo, Len)); - (I) -> - Offs = 32 * I - A, - Len = min(32, B - Offs), - bytes_slice(Offs, Len, B, ?V(b)) - end, - Body = - case {A, B} of - {0, _} -> ?V(b); - {_, 0} -> ?V(a); - _ -> MkBytes([ Word(I) || I <- lists:seq(0, WordsRes - 1) ]) - end, - {[{"a", Type(A)}, {"b", Type(B)}], Body, Type(A + B)}. - -builtin_bytes_split(A, B) -> - Type = fun(N) when N =< 32 -> word; (_) -> pointer end, - MkBytes = fun([W]) -> W; - (Ws) -> {tuple, Ws} end, - Word = fun(I, Max) -> - bytes_slice(I, min(32, Max - I), A + B, ?V(c)) - end, - Body = - case {A, B} of - {0, _} -> [?I(0), ?V(c)]; - {_, 0} -> [?V(c), ?I(0)]; - _ -> [MkBytes([ Word(I, A) || I <- lists:seq(0, A - 1, 32) ]), - MkBytes([ Word(I, A + B) || I <- lists:seq(A, A + B - 1, 32) ])] - end, - {[{"c", Type(A + B)}], {tuple, Body}, {tuple, [Type(A), Type(B)]}}. - -bytes_to_raw_string(N, Term) when N =< 32 -> - {tuple, [?I(N), Term]}; -bytes_to_raw_string(N, Term) when N > 32 -> - Elem = fun(I) -> #binop{op = '!', left = ?I(32 * I), right = ?V(bin)} - end, - Words = (N + 31) div 32, - ?LET(bin, Term, {tuple, [?I(N) | [Elem(I) || I <- lists:seq(0, Words - 1)]]}). - diff --git a/src/aeso_code_errors.erl b/src/aeso_code_errors.erl index bc03256..269d8d7 100644 --- a/src/aeso_code_errors.erl +++ b/src/aeso_code_errors.erl @@ -41,52 +41,20 @@ format({invalid_entrypoint, Why, Ann, {id, _, Name}, Thing}) -> Msg = io_lib:format("The ~sof entrypoint '~s' ~s.", [ThingS, Name, Bad]), case Why of - polymorphic -> mk_err(pos(Ann), Msg, "Use the FATE backend if you want polymorphic entrypoints.\n"); higher_order -> mk_err(pos(Ann), Msg) end; -format({cant_compare_type_aevm, Ann, Op, Type}) -> - StringAndTuple = [ "\n- type string" - "\n- tuple or record of word type" || lists:member(Op, ['==', '!=']) ], - Msg = io_lib:format("Cannot compare values of type\n" - "~s\n" - "The AEVM only supports '~s' on values of\n" - "- word type (int, bool, bits, address, oracle(_, _), etc)" - "~s", - [pp_type(2, Type), Op, StringAndTuple]), - Cxt = "Use FATE if you need to compare arbitrary types.", - mk_err(pos(Ann), Msg, Cxt); 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({unapplied_contract_call, Contract}) -> - Msg = io_lib:format("The AEVM does not support unapplied contract call to\n" - "~s", [pp_expr(2, Contract)]), - Cxt = "Use FATE if you need this.", - mk_err(pos(Contract), Msg, Cxt); -format({unapplied_builtin, Id}) -> - Msg = io_lib:format("The AEVM does not support unapplied use of ~s.", [pp_expr(0, Id)]), - Cxt = "Use FATE if you need this.", - mk_err(pos(Id), Msg, Cxt); -format({invalid_map_key_type, Why, Ann, Type}) -> - Msg = io_lib:format("Invalid map key type\n~s", [pp_type(2, Type)]), - Cxt = case Why of - polymorphic -> "Map keys cannot be polymorphic in the AEVM. Use FATE if you need this."; - function -> "Map keys cannot be higher-order." - end, - mk_err(pos(Ann), Msg, Cxt); 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({higher_order_state, {type_def, Ann, _, _, State}}) -> - Msg = io_lib:format("Invalid state type\n~s", [pp_type(2, State)]), - Cxt = "The state cannot contain functions in the AEVM. Use FATE if you need this.", - 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) diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 348881a..5580a7b 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -2,7 +2,7 @@ %%% @author Happi (Erik Stenman) %%% @copyright (C) 2017, Aeternity Anstalt %%% @doc -%%% Compiler from Aeterinty Sophia language to the Aeternity VM, aevm. +%%% Compiler from Aeterinty Sophia language to FATE. %%% @end %%% Created : 12 Dec 2017 %%%------------------------------------------------------------------- @@ -12,14 +12,13 @@ , file/2 , from_string/2 , check_call/4 - , create_calldata/3 %% deprecated + , create_calldata/3 , create_calldata/4 , version/0 , numeric_version/0 - , sophia_type_to_typerep/1 - , to_sophia_value/4 %% deprecated, need a backend + , to_sophia_value/4 , to_sophia_value/5 - , decode_calldata/3 %% deprecated + , decode_calldata/3 , decode_calldata/4 , parse/2 , add_include_path/2 @@ -27,7 +26,6 @@ ]). -include_lib("aebytecode/include/aeb_opcodes.hrl"). --include("aeso_icode.hrl"). -include("aeso_utils.hrl"). @@ -35,13 +33,10 @@ | pp_ast | pp_types | pp_typed_ast - | pp_icode | pp_assembler - | pp_bytecode | no_code | keep_included | debug_mode - | {backend, aevm | fate} | {include, {file_system, [string()]} | {explicit_files, #{string() => binary()}}} | {src_file, string()} @@ -106,45 +101,22 @@ add_include_path(File, Options) -> end. -spec from_string(binary() | string(), options()) -> {ok, map()} | {error, [aeso_errors:error()]}. -from_string(Contract, Options) -> - from_string(proplists:get_value(backend, Options, aevm), Contract, Options). - -from_string(Backend, ContractBin, Options) when is_binary(ContractBin) -> - from_string(Backend, binary_to_list(ContractBin), Options); -from_string(Backend, ContractString, Options) -> +from_string(ContractBin, Options) when is_binary(ContractBin) -> + from_string(binary_to_list(ContractBin), Options); +from_string(ContractString, Options) -> try - from_string1(Backend, ContractString, Options) + from_string1(ContractString, Options) catch throw:{error, Errors} -> {error, Errors} end. -from_string1(aevm, ContractString, Options) -> - #{ icode := Icode - , folded_typed_ast := FoldedTypedAst - , warnings := Warnings } = string_to_code(ContractString, Options), - TypeInfo = extract_type_info(Icode), - Assembler = assemble(Icode, Options), - pp_assembler(aevm, Assembler, Options), - ByteCodeList = to_bytecode(Assembler, Options), - ByteCode = << << B:8 >> || B <- ByteCodeList >>, - pp_bytecode(ByteCode, Options), - {ok, Version} = version(), - Res = #{byte_code => ByteCode, - compiler_version => Version, - contract_source => ContractString, - type_info => TypeInfo, - abi_version => aeb_aevm_abi:abi_version(), - payable => maps:get(payable, Icode), - warnings => Warnings - }, - {ok, maybe_generate_aci(Res, FoldedTypedAst, Options)}; -from_string1(fate, ContractString, Options) -> +from_string1(ContractString, Options) -> #{ fcode := FCode , fcode_env := #{child_con_env := ChildContracts} , folded_typed_ast := FoldedTypedAst , warnings := Warnings } = string_to_code(ContractString, Options), FateCode = aeso_fcode_to_fate:compile(ChildContracts, FCode, Options), - pp_assembler(fate, FateCode, Options), + pp_assembler(FateCode, Options), ByteCode = aeb_fate_code:serialize(FateCode, []), {ok, Version} = version(), Res = #{byte_code => ByteCode, @@ -174,29 +146,16 @@ string_to_code(ContractString, Options) -> pp_ast(Ast, Options), {TypeEnv, FoldedTypedAst, UnfoldedTypedAst, Warnings} = aeso_ast_infer_types:infer(Ast, [return_env | Options]), pp_typed_ast(UnfoldedTypedAst, Options), - case proplists:get_value(backend, Options, aevm) of - aevm -> - Icode = ast_to_icode(UnfoldedTypedAst, Options), - pp_icode(Icode, Options), - #{ icode => Icode - , unfolded_typed_ast => UnfoldedTypedAst - , folded_typed_ast => FoldedTypedAst - , type_env => TypeEnv - , ast => Ast - , warnings => Warnings}; - fate -> - {Env, Fcode} = aeso_ast_to_fcode:ast_to_fcode(UnfoldedTypedAst, [{original_src, ContractString}|Options]), - #{ fcode => Fcode - , fcode_env => Env - , unfolded_typed_ast => UnfoldedTypedAst - , folded_typed_ast => FoldedTypedAst - , type_env => TypeEnv - , ast => Ast - , warnings => Warnings } - end. + {Env, Fcode} = aeso_ast_to_fcode:ast_to_fcode(UnfoldedTypedAst, [{original_src, ContractString}|Options]), + #{ fcode => Fcode + , fcode_env => Env + , unfolded_typed_ast => UnfoldedTypedAst + , folded_typed_ast => FoldedTypedAst + , type_env => TypeEnv + , ast => Ast + , warnings => Warnings }. -define(CALL_NAME, "__call"). --define(DECODE_NAME, "__decode"). %% Takes a string containing a contract with a declaration/prototype of a %% function (foo, say) and adds function __call() = foo(args) calling this @@ -204,10 +163,8 @@ string_to_code(ContractString, Options) -> %% terms for the arguments. %% NOTE: Special treatment for "init" since it might be implicit and has %% a special return type (typerep, T) --spec check_call(string(), string(), [string()], options()) -> {ok, string(), {[Type], Type}, [term()]} - | {ok, string(), [term()]} - | {error, [aeso_errors:error()]} - when Type :: term(). +-spec check_call(string(), string(), [string()], options()) -> {ok, string(), [term()]} + | {error, [aeso_errors:error()]}. check_call(Source, "init" = FunName, Args, Options) -> case check_call1(Source, FunName, Args, Options) of Err = {error, _} when Args == [] -> @@ -224,44 +181,20 @@ check_call(Source, FunName, Args, Options) -> check_call1(ContractString0, FunName, Args, Options) -> try - case proplists:get_value(backend, Options, aevm) of - aevm -> - %% First check the contract without the __call function - #{ast := Ast} = string_to_code(ContractString0, Options), - ContractString = insert_call_function(Ast, ContractString0, ?CALL_NAME, FunName, Args), - #{unfolded_typed_ast := TypedAst, - icode := Icode} = string_to_code(ContractString, Options), - {ok, {FunName, {fun_t, _, _, ArgTypes, RetType}}} = get_call_type(TypedAst), - ArgVMTypes = [ aeso_ast_to_icode:ast_typerep(T, Icode) || T <- ArgTypes ], - RetVMType = case RetType of - {id, _, "_"} -> any; - _ -> aeso_ast_to_icode:ast_typerep(RetType, Icode) - end, - #{ functions := Funs } = Icode, - ArgIcode = get_arg_icode(Funs), - ArgTerms = [ icode_to_term(T, Arg) || - {T, Arg} <- lists:zip(ArgVMTypes, ArgIcode) ], - RetVMType1 = - case FunName of - "init" -> {tuple, [typerep, RetVMType]}; - _ -> RetVMType - end, - {ok, FunName, {ArgVMTypes, RetVMType1}, ArgTerms}; - fate -> - %% First check the contract without the __call function - #{ fcode := OrgFcode - , fcode_env := #{child_con_env := ChildContracts} - , ast := Ast } = string_to_code(ContractString0, Options), - FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, []), - %% collect all hashes and compute the first name without hash collision to - SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)), - CallName = first_none_match(?CALL_NAME, SymbolHashes, - lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)), - ContractString = insert_call_function(Ast, ContractString0, CallName, FunName, Args), - #{fcode := Fcode} = string_to_code(ContractString, Options), - CallArgs = arguments_of_body(CallName, FunName, Fcode), - {ok, FunName, CallArgs} - end + %% First check the contract without the __call function + #{fcode := OrgFcode + , fcode_env := #{child_con_env := ChildContracts} + , ast := Ast} = string_to_code(ContractString0, Options), + FateCode = aeso_fcode_to_fate:compile(ChildContracts, OrgFcode, []), + %% collect all hashes and compute the first name without hash collision to + SymbolHashes = maps:keys(aeb_fate_code:symbols(FateCode)), + CallName = first_none_match(?CALL_NAME, SymbolHashes, + lists:seq($1, $9) ++ lists:seq($A, $Z) ++ lists:seq($a, $z)), + ContractString = insert_call_function(Ast, ContractString0, CallName, FunName, Args), + #{fcode := Fcode} = string_to_code(ContractString, Options), + CallArgs = arguments_of_body(CallName, FunName, Fcode), + + {ok, FunName, CallArgs} catch throw:{error, Errors} -> {error, Errors} end. @@ -309,32 +242,21 @@ last_contract_indent(Decls) -> _ -> 0 end. --spec to_sophia_value(string(), string(), ok | error | revert, aeb_aevm_data:data()) -> - {ok, aeso_syntax:expr()} | {error, [aeso_errors:error()]}. +-spec to_sophia_value(string(), string(), ok | error | revert, binary()) -> + {ok, aeso_syntax:expr()} | {error, [aeso_errors:error()]}. to_sophia_value(ContractString, Fun, ResType, Data) -> - to_sophia_value(ContractString, Fun, ResType, Data, [{backend, aevm}]). - + to_sophia_value(ContractString, Fun, ResType, Data, []). -spec to_sophia_value(string(), string(), ok | error | revert, binary(), options()) -> {ok, aeso_syntax:expr()} | {error, [aeso_errors:error()]}. to_sophia_value(_, _, error, Err, _Options) -> {ok, {app, [], {id, [], "error"}, [{string, [], Err}]}}; -to_sophia_value(_, _, revert, Data, Options) -> - case proplists:get_value(backend, Options, aevm) of - aevm -> - case aeb_heap:from_binary(string, Data) of - {ok, Err} -> - {ok, {app, [], {id, [], "abort"}, [{string, [], Err}]}}; - {error, _} -> - Msg = "Could not interpret the revert message", - {error, [aeso_errors:new(data_error, Msg)]} - end; - fate -> - try aeb_fate_encoding:deserialize(Data) of - Err -> {ok, {app, [], {id, [], "abort"}, [{string, [], Err}]}} - catch _:_ -> - Msg = "Could not deserialize the revert message", - {error, [aeso_errors:new(data_error, Msg)]} - end +to_sophia_value(_, _, revert, Data, _Options) -> + try aeso_vm_decode:from_fate({id, [], "string"}, aeb_fate_encoding:deserialize(Data)) of + Err -> + {ok, {app, [], {id, [], "abort"}, [Err]}} + catch _:_ -> + Msg = "Could not deserialize the revert message", + {error, [aeso_errors:new(data_error, Msg)]} end; to_sophia_value(ContractString, FunName, ok, Data, Options0) -> Options = [no_code | Options0], @@ -344,74 +266,44 @@ to_sophia_value(ContractString, FunName, ok, Data, Options0) -> {ok, _, Type0} = get_decode_type(FunName, TypedAst), Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]), - case proplists:get_value(backend, Options, aevm) of - aevm -> - Icode = maps:get(icode, Code), - VmType = aeso_ast_to_icode:ast_typerep(Type, Icode), - case aeb_heap:from_binary(VmType, Data) of - {ok, VmValue} -> - try - {ok, aeso_vm_decode:from_aevm(VmType, Type, VmValue)} - catch throw:cannot_translate_to_sophia -> - Type0Str = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Cannot translate VM value ~p\n of type ~p\n to Sophia type ~s", - [Data, VmType, Type0Str]), - {error, [aeso_errors:new(data_error, Msg)]} - end; - {error, _Err} -> - Msg = io_lib:format("Failed to decode binary as type ~p", [VmType]), - {error, [aeso_errors:new(data_error, Msg)]} - end; - fate -> - try - {ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))} - catch throw:cannot_translate_to_sophia -> - Type1 = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s", - [aeb_fate_encoding:deserialize(Data), Type1]), - {error, [aeso_errors:new(data_error, Msg)]}; - _:_ -> - Type1 = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]), - {error, [aeso_errors:new(data_error, Msg)]} - end + try + {ok, aeso_vm_decode:from_fate(Type, aeb_fate_encoding:deserialize(Data))} + catch throw:cannot_translate_to_sophia -> + Type1 = prettypr:format(aeso_pretty:type(Type0)), + Msg = io_lib:format("Cannot translate FATE value ~p\n of Sophia type ~s", + [aeb_fate_encoding:deserialize(Data), Type1]), + {error, [aeso_errors:new(data_error, Msg)]}; + _:_ -> + Type1 = prettypr:format(aeso_pretty:type(Type0)), + Msg = io_lib:format("Failed to decode binary as type ~s", [Type1]), + {error, [aeso_errors:new(data_error, Msg)]} end catch throw:{error, Errors} -> {error, Errors} end. - -spec create_calldata(string(), string(), [string()]) -> - {ok, binary(), aeb_aevm_data:type(), aeb_aevm_data:type()} - | {error, [aeso_errors:error()]}. + {ok, binary()} | {error, [aeso_errors:error()]}. create_calldata(Code, Fun, Args) -> - create_calldata(Code, Fun, Args, [{backend, aevm}]). - + create_calldata(Code, Fun, Args, []). -spec create_calldata(string(), string(), [string()], [{atom(), any()}]) -> {ok, binary()} | {error, [aeso_errors:error()]}. create_calldata(Code, Fun, Args, Options0) -> Options = [no_code | Options0], - case proplists:get_value(backend, Options, aevm) of - aevm -> - case check_call(Code, Fun, Args, Options) of - {ok, FunName, {ArgTypes, RetType}, VMArgs} -> - aeb_aevm_abi:create_calldata(FunName, VMArgs, ArgTypes, RetType); - {error, _} = Err -> Err - end; - fate -> - case check_call(Code, Fun, Args, Options) of - {ok, FunName, FateArgs} -> - aeb_fate_abi:create_calldata(FunName, FateArgs); - {error, _} = Err -> Err - end + case check_call(Code, Fun, Args, Options) of + {ok, FunName, FateArgs} -> + aeb_fate_abi:create_calldata(FunName, FateArgs); + {error, _} = Err -> Err end. -spec decode_calldata(string(), string(), binary()) -> - {ok, [aeso_syntax:type()], [aeso_syntax:expr()]} - | {error, [aeso_errors:error()]}. + {ok, [aeso_syntax:type()], [aeso_syntax:expr()]} + | {error, [aeso_errors:error()]}. decode_calldata(ContractString, FunName, Calldata) -> - decode_calldata(ContractString, FunName, Calldata, [{backend, aevm}]). - + decode_calldata(ContractString, FunName, Calldata, []). +-spec decode_calldata(string(), string(), binary(), options()) -> + {ok, [aeso_syntax:type()], [aeso_syntax:expr()]} + | {error, [aeso_errors:error()]}. decode_calldata(ContractString, FunName, Calldata, Options0) -> Options = [no_code | Options0], try @@ -424,73 +316,27 @@ decode_calldata(ContractString, FunName, Calldata, Options0) -> Type0 = {tuple_t, [], ArgTypes}, %% user defined data types such as variants needed to match against Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]), - case proplists:get_value(backend, Options, aevm) of - aevm -> - Icode = maps:get(icode, Code), - VmType = aeso_ast_to_icode:ast_typerep(Type, Icode), - case aeb_heap:from_binary({tuple, [word, VmType]}, Calldata) of - {ok, {_, VmValue}} -> - try - {tuple, [], Values} = aeso_vm_decode:from_aevm(VmType, Type, VmValue), - %% Values are Sophia expressions in AST format - {ok, ArgTypes, Values} - catch throw:cannot_translate_to_sophia -> - Type0Str = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Cannot translate VM value ~p\n of type ~p\n to Sophia type ~s", - [VmValue, VmType, Type0Str]), - {error, [aeso_errors:new(data_error, Msg)]} - end; - {error, _Err} -> - Msg = io_lib:format("Failed to decode calldata as type ~p", [VmType]), + case aeb_fate_abi:decode_calldata(FunName, Calldata) of + {ok, FateArgs} -> + try + {tuple_t, [], ArgTypes1} = Type, + AstArgs = [ aeso_vm_decode:from_fate(ArgType, FateArg) + || {ArgType, FateArg} <- lists:zip(ArgTypes1, FateArgs)], + {ok, ArgTypes, AstArgs} + catch throw:cannot_translate_to_sophia -> + Type0Str = prettypr:format(aeso_pretty:type(Type0)), + Msg = io_lib:format("Cannot translate FATE value ~p\n to Sophia type ~s", + [FateArgs, Type0Str]), {error, [aeso_errors:new(data_error, Msg)]} end; - fate -> - case aeb_fate_abi:decode_calldata(FunName, Calldata) of - {ok, FateArgs} -> - try - {tuple_t, [], ArgTypes1} = Type, - AstArgs = [ aeso_vm_decode:from_fate(ArgType, FateArg) - || {ArgType, FateArg} <- lists:zip(ArgTypes1, FateArgs)], - {ok, ArgTypes, AstArgs} - catch throw:cannot_translate_to_sophia -> - Type0Str = prettypr:format(aeso_pretty:type(Type0)), - Msg = io_lib:format("Cannot translate FATE value ~p\n to Sophia type ~s", - [FateArgs, Type0Str]), - {error, [aeso_errors:new(data_error, Msg)]} - end; - {error, _} -> - Msg = io_lib:format("Failed to decode calldata binary", []), - {error, [aeso_errors:new(data_error, Msg)]} - end + {error, _} -> + Msg = io_lib:format("Failed to decode calldata binary", []), + {error, [aeso_errors:new(data_error, Msg)]} end catch throw:{error, Errors} -> {error, Errors} end. -get_arg_icode(Funs) -> - case [ Args || {[_, ?CALL_NAME], _, _, {funcall, _, Args}, _} <- Funs ] of - [Args] -> Args; - [] -> error_missing_call_function() - end. - --dialyzer({nowarn_function, error_missing_call_function/0}). -error_missing_call_function() -> - Msg = "Internal error: missing '__call'-function", - aeso_errors:throw(aeso_errors:new(internal_error, Msg)). - -get_call_type([{Contract, _, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) -> - case [ {lists:last(QFunName), FunType} - || {letfun, _, {id, _, ?CALL_NAME}, [], _Ret, - [{guarded, _, [], {typed, _, - {app, _, - {typed, _, {qid, _, QFunName}, FunType}, _}, _}}]} <- Defs ] of - [Call] -> {ok, Call}; - [] -> error_missing_call_function() - end; -get_call_type([_ | Contracts]) -> - %% The __call should be in the final contract - get_call_type(Contracts). - -dialyzer({nowarn_function, get_decode_type/2}). get_decode_type(FunName, [{Contract, Ann, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) -> GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _}) when Name == FunName -> [{Args, Ret}]; @@ -511,87 +357,17 @@ get_decode_type(FunName, [_ | Contracts]) -> %% The __decode should be in the final contract get_decode_type(FunName, Contracts). -%% Translate an icode value (error if not value) to an Erlang term that can be -%% consumed by aeb_heap:to_binary(). -icode_to_term(word, {integer, N}) -> N; -icode_to_term(word, {unop, '-', {integer, N}}) -> -N; -icode_to_term(string, {tuple, [{integer, Len} | Words]}) -> - <> = << <> || {integer, W} <- Words >>, - Str; -icode_to_term({list, T}, {list, Vs}) -> - [ icode_to_term(T, V) || V <- Vs ]; -icode_to_term({tuple, Ts}, {tuple, Vs}) -> - list_to_tuple(icodes_to_terms(Ts, Vs)); -icode_to_term({variant, Cs}, {tuple, [{integer, Tag} | Args]}) -> - Ts = lists:nth(Tag + 1, Cs), - {variant, Tag, icodes_to_terms(Ts, Args)}; -icode_to_term(T = {map, KT, VT}, M) -> - %% Maps are compiled to builtin and primop calls, so this gets a little hairy - case M of - {funcall, {var_ref, {builtin, map_put}}, [M1, K, V]} -> - Map = icode_to_term(T, M1), - Key = icode_to_term(KT, K), - Val = icode_to_term(VT, V), - Map#{ Key => Val }; - #prim_call_contract{ address = {integer, 0}, - arg = {tuple, [{integer, ?PRIM_CALL_MAP_EMPTY}, _, _]} } -> - #{}; - _ -> throw({todo, M}) - end; -icode_to_term(word, {unop, 'bnot', A}) -> - bnot icode_to_term(word, A); -icode_to_term(word, {binop, 'bor', A, B}) -> - icode_to_term(word, A) bor icode_to_term(word, B); -icode_to_term(word, {binop, 'bsl', A, B}) -> - icode_to_term(word, B) bsl icode_to_term(word, A); -icode_to_term(word, {binop, 'band', A, B}) -> - icode_to_term(word, A) band icode_to_term(word, B); -icode_to_term(typerep, _) -> - throw({todo, typerep}); -icode_to_term(T, V) -> - throw({not_a_value, T, V}). - -icodes_to_terms(Ts, Vs) -> - [ icode_to_term(T, V) || {T, V} <- lists:zip(Ts, Vs) ]. - -ast_to_icode(TypedAst, Options) -> - aeso_ast_to_icode:convert_typed(TypedAst, Options). - -assemble(Icode, Options) -> - aeso_icode_to_asm:convert(Icode, Options). - - -to_bytecode(['COMMENT',_|Rest],_Options) -> - to_bytecode(Rest,_Options); -to_bytecode([Op|Rest], Options) -> - [aeb_opcodes:m_to_op(Op)|to_bytecode(Rest, Options)]; -to_bytecode([], _) -> []. - -extract_type_info(#{functions := Functions} =_Icode) -> - ArgTypesOnly = fun(As) -> [ T || {_, T} <- As ] end, - Payable = fun(Attrs) -> proplists:get_value(payable, Attrs, false) end, - TypeInfo = [aeb_aevm_abi:function_type_info(list_to_binary(lists:last(Name)), - Payable(Attrs), ArgTypesOnly(Args), TypeRep) - || {Name, Attrs, Args,_Body, TypeRep} <- Functions, - not is_tuple(Name), - not lists:member(private, Attrs) - ], - lists:sort(TypeInfo). - pp_sophia_code(C, Opts)-> pp(C, Opts, pp_sophia_code, fun(Code) -> io:format("~s\n", [prettypr:format(aeso_pretty:decls(Code))]) end). pp_ast(C, Opts) -> pp(C, Opts, pp_ast, fun aeso_ast:pp/1). pp_typed_ast(C, Opts)-> pp(C, Opts, pp_typed_ast, fun aeso_ast:pp_typed/1). -pp_icode(C, Opts) -> pp(C, Opts, pp_icode, fun aeso_icode:pp/1). -pp_bytecode(C, Opts) -> pp(C, Opts, pp_bytecode, fun aeb_disassemble:pp/1). -pp_assembler(aevm, C, Opts) -> pp(C, Opts, pp_assembler, fun aeb_asm:pp/1); -pp_assembler(fate, C, Opts) -> pp(C, Opts, pp_assembler, fun(Asm) -> io:format("~s", [aeb_fate_asm:pp(Asm)]) end). +pp_assembler(C, Opts) -> pp(C, Opts, pp_assembler, fun(Asm) -> io:format("~s", [aeb_fate_asm:pp(Asm)]) end). pp(Code, Options, Option, PPFun) -> case proplists:lookup(Option, Options) of - {Option, true} -> + {Option1, true} when Option1 =:= Option -> PPFun(Code); none -> ok @@ -604,31 +380,27 @@ pp(Code, Options, Option, PPFun) -> -spec validate_byte_code(map(), string(), options()) -> ok | {error, [aeso_errors:error()]}. validate_byte_code(#{ byte_code := ByteCode, payable := Payable }, Source, Options) -> Fail = fun(Err) -> {error, [aeso_errors:new(data_error, Err)]} end, - case proplists:get_value(backend, Options, aevm) of - B when B /= fate -> Fail(io_lib:format("Unsupported backend: ~s\n", [B])); - fate -> - try - FCode1 = ?protect(deserialize, aeb_fate_code:strip_init_function(aeb_fate_code:deserialize(ByteCode))), - {FCode2, SrcPayable} = - ?protect(compile, - begin - {ok, #{ byte_code := SrcByteCode, payable := SrcPayable }} = - from_string1(fate, Source, Options), - FCode = aeb_fate_code:deserialize(SrcByteCode), - {aeb_fate_code:strip_init_function(FCode), SrcPayable} - end), - case compare_fate_code(FCode1, FCode2) of - ok when SrcPayable /= Payable -> - Not = fun(true) -> ""; (false) -> " not" end, - Fail(io_lib:format("Byte code contract is~s payable, but source code contract is~s.\n", - [Not(Payable), Not(SrcPayable)])); - ok -> ok; - {error, Why} -> Fail(io_lib:format("Byte code does not match source code.\n~s", [Why])) - end - catch - throw:{deserialize, _} -> Fail("Invalid byte code"); - throw:{compile, {error, Errs}} -> {error, Errs} - end + try + FCode1 = ?protect(deserialize, aeb_fate_code:strip_init_function(aeb_fate_code:deserialize(ByteCode))), + {FCode2, SrcPayable} = + ?protect(compile, + begin + {ok, #{ byte_code := SrcByteCode, payable := SrcPayable }} = + from_string1(Source, Options), + FCode = aeb_fate_code:deserialize(SrcByteCode), + {aeb_fate_code:strip_init_function(FCode), SrcPayable} + end), + case compare_fate_code(FCode1, FCode2) of + ok when SrcPayable /= Payable -> + Not = fun(true) -> ""; (false) -> " not" end, + Fail(io_lib:format("Byte code contract is~s payable, but source code contract is~s.\n", + [Not(Payable), Not(SrcPayable)])); + ok -> ok; + {error, Why} -> Fail(io_lib:format("Byte code does not match source code.\n~s", [Why])) + end + catch + throw:{deserialize, _} -> Fail("Invalid byte code"); + throw:{compile, {error, Errs}} -> {error, Errs} end. compare_fate_code(FCode1, FCode2) -> @@ -680,14 +452,6 @@ pp_fate_type(T) -> io_lib:format("~w", [T]). %% ------------------------------------------------------------------- --spec sophia_type_to_typerep(string()) -> {error, bad_type} | {ok, aeb_aevm_data:type()}. -sophia_type_to_typerep(String) -> - Ast = aeso_parser:run_parser(aeso_parser:type(), String), - try aeso_ast_to_icode:ast_typerep(Ast) of - Type -> {ok, Type} - catch _:_ -> {error, bad_type} - end. - -spec parse(string(), aeso_compiler:options()) -> none() | aeso_syntax:ast(). parse(Text, Options) -> parse(Text, sets:new(), Options). diff --git a/src/aeso_icode.erl b/src/aeso_icode.erl deleted file mode 100644 index 0b6357b..0000000 --- a/src/aeso_icode.erl +++ /dev/null @@ -1,153 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author Happi (Erik Stenman) -%%% @copyright (C) 2017, Aeternity Anstalt -%%% @doc -%%% Intermediate Code for Aeterinty Sophia language. -%%% @end -%%% Created : 21 Dec 2017 -%%% -%%%------------------------------------------------------------------- --module(aeso_icode). - --export([new/1, - pp/1, - set_name/2, - set_namespace/2, - set_payable/2, - enter_namespace/2, - get_namespace/1, - in_main_contract/1, - qualify/2, - set_functions/2, - map_typerep/2, - option_typerep/1, - get_constructor_tag/2]). - --export_type([icode/0]). - --include("aeso_icode.hrl"). - --type type_def() :: fun(([aeb_aevm_data:type()]) -> aeb_aevm_data:type()). - --type bindings() :: any(). --type fun_dec() :: { string() - , [modifier()] - , arg_list() - , expr() - , aeb_aevm_data:type()}. - --type modifier() :: private | stateful. - --type type_name() :: string() | [string()]. - --type icode() :: #{ contract_name => string() - , functions => [fun_dec()] - , namespace => aeso_syntax:con() | aeso_syntax:qcon() - , env => [bindings()] - , state_type => aeb_aevm_data:type() - , event_type => aeb_aevm_data:type() - , types => #{ type_name() => type_def() } - , type_vars => #{ string() => aeb_aevm_data:type() } - , constructors => #{ [string()] => integer() } %% name to tag - , options => [any()] - , payable => boolean() - }. - -pp(Icode) -> - %% TODO: Actually do *Pretty* printing. - io:format("~p~n", [Icode]). - --spec new([any()]) -> icode(). -new(Options) -> - #{ contract_name => "" - , functions => [] - , env => new_env() - %% Default to unit type for state and event - , state_type => {tuple, []} - , event_type => {tuple, []} - , types => builtin_types() - , type_vars => #{} - , constructors => builtin_constructors() - , options => Options - , payable => false }. - -builtin_types() -> - Word = fun([]) -> word end, - #{ "bool" => Word - , "int" => Word - , "char" => Word - , "bits" => Word - , "string" => fun([]) -> string end - , "address" => Word - , "hash" => Word - , "unit" => fun([]) -> {tuple, []} end - , "signature" => fun([]) -> {tuple, [word, word]} end - , "oracle" => fun([_, _]) -> word end - , "oracle_query" => fun([_, _]) -> word end - , "list" => fun([A]) -> {list, A} end - , "option" => fun([A]) -> {variant, [[], [A]]} end - , "map" => fun([K, V]) -> map_typerep(K, V) end - , ["Chain", "ttl"] => fun([]) -> {variant, [[word], [word]]} end - , ["AENS", "pointee"] => fun([]) -> {variant, [[word], [word], [word]]} end - }. - -builtin_constructors() -> - #{ ["RelativeTTL"] => 0 - , ["FixedTTL"] => 1 - , ["None"] => 0 - , ["Some"] => 1 - , ["AccountPointee"] => 0 - , ["OraclePointee"] => 1 - , ["ContractPointee"] => 2 - }. - -map_typerep(K, V) -> - {map, K, V}. - -option_typerep(A) -> - {variant, [[], [A]]}. - -new_env() -> - []. - --spec set_name(string(), icode()) -> icode(). -set_name(Name, Icode) -> - maps:put(contract_name, Name, Icode). - --spec set_payable(boolean(), icode()) -> icode(). -set_payable(Payable, Icode) -> - maps:put(payable, Payable, Icode). - --spec set_namespace(aeso_syntax:con() | aeso_syntax:qcon(), icode()) -> icode(). -set_namespace(NS, Icode) -> Icode#{ namespace => NS }. - --spec enter_namespace(aeso_syntax:con(), icode()) -> icode(). -enter_namespace(NS, Icode = #{ namespace := NS1 }) -> - Icode#{ namespace => aeso_syntax:qualify(NS1, NS) }; -enter_namespace(NS, Icode) -> - Icode#{ namespace => NS }. - --spec in_main_contract(icode()) -> boolean(). -in_main_contract(#{ namespace := {con, _, Main}, contract_name := Main }) -> true; -in_main_contract(_Icode) -> false. - --spec get_namespace(icode()) -> false | aeso_syntax:con() | aeso_syntax:qcon(). -get_namespace(Icode) -> maps:get(namespace, Icode, false). - --spec qualify(aeso_syntax:id() | aeso_syntax:con(), icode()) -> aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon(). -qualify(X, Icode) -> - case get_namespace(Icode) of - false -> X; - NS -> aeso_syntax:qualify(NS, X) - end. - --spec set_functions([fun_dec()], icode()) -> icode(). -set_functions(NewFuns, Icode) -> - maps:put(functions, NewFuns, Icode). - --spec get_constructor_tag([string()], icode()) -> integer(). -get_constructor_tag(Name, #{constructors := Constructors}) -> - case maps:get(Name, Constructors, undefined) of - undefined -> error({undefined_constructor, Name}); - Tag -> Tag - end. diff --git a/src/aeso_icode.hrl b/src/aeso_icode.hrl deleted file mode 100644 index d41fe02..0000000 --- a/src/aeso_icode.hrl +++ /dev/null @@ -1,59 +0,0 @@ - --include_lib("aebytecode/include/aeb_typerep_def.hrl"). - --record(arg, {name::string(), type::?Type()}). - --type expr() :: term(). --type arg() :: #arg{name::string(), type::?Type()}. --type arg_list() :: [arg()]. - --record(fun_dec, { name :: string() - , args :: arg_list() - , body :: expr()}). - --record(var_ref, { name :: string() | list(string()) | {builtin, atom() | tuple()}}). - --record(prim_call_contract, - { gas :: expr() - , address :: expr() - , value :: expr() - , arg :: expr() - , type_hash:: expr() - }). - --record(prim_balance, { address :: expr() }). --record(prim_block_hash, { height :: expr() }). --record(prim_put, { state :: expr() }). - --record(integer, {value :: integer()}). - --record(tuple, {cpts :: [expr()]}). - --record(list, {elems :: [expr()]}). - --record(unop, { op :: term() - , rand :: expr()}). - --record(binop, { op :: term() - , left :: expr() - , right :: expr()}). - --record(ifte, { decision :: expr() - , then :: expr() - , else :: expr()}). - --record(switch, { expr :: expr() - , cases :: [{expr(),expr()}]}). - --record(funcall, { function :: expr() - , args :: [expr()]}). - --record(lambda, { args :: arg_list(), - body :: expr()}). - --record(missing_field, { format :: string() - , args :: [term()]}). - --record(seq, {exprs :: [expr()]}). - --record(event, {topics :: [expr()], payload :: expr()}). diff --git a/src/aeso_icode_to_asm.erl b/src/aeso_icode_to_asm.erl deleted file mode 100644 index 422d36f..0000000 --- a/src/aeso_icode_to_asm.erl +++ /dev/null @@ -1,983 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @author Happi (Erik Stenman) -%%% @copyright (C) 2017, Aeternity Anstalt -%%% @doc -%%% Translator from Aesophia Icode to Aevm Assebly -%%% @end -%%% Created : 21 Dec 2017 -%%% -%%%------------------------------------------------------------------- --module(aeso_icode_to_asm). - --export([convert/2]). - --include_lib("aebytecode/include/aeb_opcodes.hrl"). --include("aeso_icode.hrl"). - -i(Code) -> aeb_opcodes:mnemonic(Code). - -%% We don't track purity or statefulness in the type checker yet. -is_stateful({FName, _, _, _, _}) -> lists:last(FName) /= "init". - -is_public({_Name, Attrs, _Args, _Body, _Type}) -> not lists:member(private, Attrs). - -convert(#{ contract_name := _ContractName - , state_type := StateType - , functions := Functions - }, - _Options) -> - %% Create a function dispatcher - DispatchFun = {"%main", [], [{"arg", "_"}], - {switch, {var_ref, "arg"}, - [{{tuple, [fun_hash(Fun), - {tuple, make_args(Args)}]}, - icode_seq([ hack_return_address(Fun, length(Args) + 1) ] ++ - [ {funcall, {var_ref, FName}, make_args(Args)}] - )} - || Fun={FName, _, Args, _,_TypeRep} <- Functions, is_public(Fun) ]}, - word}, - NewFunctions = Functions ++ [DispatchFun], - %% Create a function environment - Funs = [{Name, length(Args), make_ref()} - || {Name, _Attrs, Args, _Body, _Type} <- NewFunctions], - %% Create dummy code to call the main function with one argument - %% taken from the stack - StopLabel = make_ref(), - StatefulStopLabel = make_ref(), - MainFunction = lookup_fun(Funs, "%main"), - - StateTypeValue = aeso_ast_to_icode:type_value(StateType), - - DispatchCode = [%% push two return addresses to stop, one for stateful - %% functions and one for non-stateful functions. - push_label(StatefulStopLabel), - push_label(StopLabel), - %% The calldata is already on the stack when we start. Put - %% it on top (also reorders StatefulStop and Stop). - swap(2), - - jump(MainFunction), - jumpdest(StatefulStopLabel), - - %% We need to encode the state type and put it - %% underneath the return value. - assemble_expr(Funs, [], nontail, StateTypeValue), %% StateT Ret - swap(1), %% Ret StateT - - %% We should also change the state value at address 0 to a - %% pointer to the state value (to allow 0 to represent an - %% unchanged state). - i(?MSIZE), %% Ptr - push(0), i(?MLOAD), %% Val Ptr - i(?MSIZE), i(?MSTORE), %% Ptr Mem[Ptr] := Val - push(0), i(?MSTORE), %% Mem[0] := Ptr - - %% The pointer to the return value is on top of - %% the stack, but the return instruction takes two - %% stack arguments. - push(0), - i(?RETURN), - jumpdest(StopLabel), - %% Set state pointer to 0 to indicate that we didn't change state - push(0), dup(1), i(?MSTORE), - %% Same as StatefulStopLabel above - push(0), - i(?RETURN) - ], - %% Code is a deep list of instructions, containing labels and - %% references to them. Labels take the form {'JUMPDEST', Ref}, and - %% references take the form {push_label, Ref}, which is translated - %% into a PUSH instruction. - Code = [assemble_function(Funs, Name, Args, Body) - || {Name, _, Args, Body, _Type} <- NewFunctions], - resolve_references( - [%% i(?COMMENT), "CONTRACT: " ++ ContractName, - DispatchCode, - Code]). - -%% Generate error on correct format. - -gen_error(Error) -> - error({code_errors, [Error]}). - -make_args(Args) -> - [{var_ref, [I-1 + $a]} || I <- lists:seq(1, length(Args))]. - -fun_hash({FName, _, Args, _, TypeRep}) -> - ArgType = {tuple, [T || {_, T} <- Args]}, - <> = aeb_aevm_abi:function_type_hash(list_to_binary(lists:last(FName)), ArgType, TypeRep), - {integer, Hash}. - -%% Expects two return addresses below N elements on the stack. Picks the top -%% one for stateful functions and the bottom one for non-stateful. -hack_return_address(Fun, N) -> - case is_stateful(Fun) of - true -> {inline_asm, [i(?MSIZE)]}; - false -> - {inline_asm, %% X1 .. XN State NoState - [ dup(N + 2) %% NoState X1 .. XN State NoState - , swap(N + 1) %% State X1 .. XN NoState NoState - ]} %% Top of the stack will be discarded. - end. - -assemble_function(Funs, Name, Args, Body) -> - [jumpdest(lookup_fun(Funs, Name)), - assemble_expr(Funs, lists:reverse(Args), tail, Body), - %% swap return value and first argument - pop_args(length(Args)), - swap(1), - i(?JUMP)]. - -%% {seq, Es} - should be "one" operation in terms of stack content -%% i.e. after the `seq` there should be one new element on the stack. -assemble_expr(Funs, Stack, Tail, {seq, [E]}) -> - assemble_expr(Funs, Stack, Tail, E); -assemble_expr(Funs, Stack, Tail, {seq, [E | Es]}) -> - [assemble_expr(Funs, Stack, nontail, E), - assemble_expr(Funs, Stack, Tail, {seq, Es})]; -assemble_expr(_Funs, _Stack, _Tail, {inline_asm, Code}) -> - Code; %% Unsafe! Code should take care to respect the stack! -assemble_expr(Funs, Stack, _TailPosition, {var_ref, Id}) -> - case lists:keymember(Id, 1, Stack) of - true -> - dup(lookup_var(Id, Stack)); - false -> - %% Build a closure - %% When a top-level fun is called directly, we do not - %% reach this case. - Eta = make_ref(), - Continue = make_ref(), - [i(?MSIZE), - push_label(Eta), - dup(2), - i(?MSTORE), - jump(Continue), - %% the code of the closure - jumpdest(Eta), - %% pop the pointer to the function - pop(1), - jump(lookup_fun(Funs, Id)), - jumpdest(Continue)] - end; -assemble_expr(_, _, _, {missing_field, Format, Args}) -> - io:format(Format, Args), - gen_error(missing_field); -assemble_expr(_Funs, _Stack, _, {integer, N}) -> - push(N); -assemble_expr(Funs, Stack, _, {tuple, Cpts}) -> - %% We build tuples right-to-left, so that the first write to the - %% tuple extends the memory size. Because we use ?MSIZE as the - %% heap pointer, we must allocate the tuple AFTER computing the - %% first element. - %% We store elements into the tuple as soon as possible, to avoid - %% keeping them for a long time on the stack. - case lists:reverse(Cpts) of - [] -> - i(?MSIZE); - [Last|Rest] -> - [assemble_expr(Funs, Stack, nontail, Last), - %% allocate the tuple memory - i(?MSIZE), - %% compute address of last word - push(32 * (length(Cpts) - 1)), i(?ADD), - %% Stack: - %% Write value to memory (allocates the tuple) - swap(1), dup(2), i(?MSTORE), - %% Stack: pointer to last word written - [[%% Update pointer to next word to be written - push(32), swap(1), i(?SUB), - %% Compute element - assemble_expr(Funs, [pointer|Stack], nontail, A), - %% Write element to memory - dup(2), i(?MSTORE)] - %% And we leave a pointer to the last word written on - %% the stack - || A <- Rest]] - %% The pointer to the entire tuple is on the stack - end; -assemble_expr(_Funs, _Stack, _, {list, []}) -> - %% Use Erik's value of -1 for [] - [push(0), i(?NOT)]; -assemble_expr(Funs, Stack, _, {list, [A|B]}) -> - assemble_expr(Funs, Stack, nontail, {tuple, [A, {list, B}]}); -assemble_expr(Funs, Stack, _, {unop, '!', A}) -> - case A of - {binop, Logical, _, _} when Logical=='&&'; Logical=='||' -> - assemble_expr(Funs, Stack, nontail, {ifte, A, {integer, 0}, {integer, 1}}); - _ -> - [assemble_expr(Funs, Stack, nontail, A), - i(?ISZERO) - ] - end; -assemble_expr(Funs, Stack, _, {event, Topics, Payload}) -> - [assemble_exprs(Funs, Stack, Topics ++ [Payload]), - case length(Topics) of - 0 -> i(?LOG0); - 1 -> i(?LOG1); - 2 -> i(?LOG2); - 3 -> i(?LOG3); - 4 -> i(?LOG4) - end, i(?MSIZE)]; -assemble_expr(Funs, Stack, _, {unop, Op, A}) -> - [assemble_expr(Funs, Stack, nontail, A), - assemble_prefix(Op)]; -assemble_expr(Funs, Stack, Tail, {binop, '&&', A, B}) -> - assemble_expr(Funs, Stack, Tail, {ifte, A, B, {integer, 0}}); -assemble_expr(Funs, Stack, Tail, {binop, '||', A, B}) -> - assemble_expr(Funs, Stack, Tail, {ifte, A, {integer, 1}, B}); -assemble_expr(Funs, Stack, Tail, {binop, '::', A, B}) -> - %% Take advantage of optimizations in tuple construction. - assemble_expr(Funs, Stack, Tail, {tuple, [A, B]}); -assemble_expr(Funs, Stack, _, {binop, Op, A, B}) -> - %% EEVM binary instructions take their first argument from the top - %% of the stack, so to get operands on the stack in the right - %% order, we evaluate from right to left. - [assemble_expr(Funs, Stack, nontail, B), - assemble_expr(Funs, [dummy|Stack], nontail, A), - assemble_infix(Op)]; -assemble_expr(Funs, Stack, _, {lambda, Args, Body}) -> - Function = make_ref(), - FunBody = make_ref(), - Continue = make_ref(), - NoMatch = make_ref(), - FreeVars = free_vars({lambda, Args, Body}), - {NewVars, MatchingCode} = assemble_pattern(FunBody, NoMatch, {tuple, [{var_ref, "_"}|FreeVars]}), - BodyCode = assemble_expr(Funs, NewVars ++ lists:reverse([ {Arg#arg.name, Arg#arg.type} || Arg <- Args ]), tail, Body), - [assemble_expr(Funs, Stack, nontail, {tuple, [{label, Function}|FreeVars]}), - jump(Continue), %% will be optimized away - jumpdest(Function), - %% A pointer to the closure is on the stack - MatchingCode, - jumpdest(FunBody), - BodyCode, - pop_args(length(Args)+length(NewVars)), - swap(1), - i(?JUMP), - jumpdest(NoMatch), %% dead code--raise an exception just in case - push(0), - i(?NOT), - i(?MLOAD), - i(?STOP), - jumpdest(Continue)]; -assemble_expr(_, _, _, {label, Label}) -> - push_label(Label); -assemble_expr(Funs, Stack, nontail, {funcall, Fun, Args}) -> - Return = make_ref(), - %% This is the obvious code: - %% [{push_label, Return}, - %% assemble_exprs(Funs, [return_address|Stack], Args++[Fun]), - %% 'JUMP', - %% {'JUMPDEST', Return}]; - %% Its problem is that it stores the return address on the stack - %% while the arguments are computed, which is unnecessary. To - %% avoid that, we compute the last argument FIRST, and replace it - %% with the return address using a SWAP. - %% - %% assemble_function leaves the code pointer of the function to - %% call on top of the stack, and--if the function is not a - %% top-level name--a pointer to its tuple of free variables. In - %% either case a JUMP is the right way to call it. - case Args of - [] -> - [push_label(Return), - assemble_function(Funs, [return_address|Stack], Fun), - i(?JUMP), - jumpdest(Return)]; - _ -> - {Init, [Last]} = lists:split(length(Args) - 1, Args), - [assemble_exprs(Funs, Stack, [Last|Init]), - %% Put the return address in the right place, which also - %% reorders the args correctly. - push_label(Return), - swap(length(Args)), - assemble_function(Funs, [dummy || _ <- Args] ++ [return_address|Stack], Fun), - i(?JUMP), - jumpdest(Return)] - end; -assemble_expr(Funs, Stack, tail, {funcall, Fun, Args}) -> - IsTopLevel = is_top_level_fun(Stack, Fun), - %% If the fun is not top-level, then it may refer to local - %% variables and must be computed before stack shuffling. - ArgsAndFun = Args++[Fun || not IsTopLevel], - ComputeArgsAndFun = assemble_exprs(Funs, Stack, ArgsAndFun), - %% Copy arguments back down the stack to the start of the frame - ShuffleSpec = lists:seq(length(ArgsAndFun), 1, -1) ++ [discard || _ <- Stack], - Shuffle = shuffle_stack(ShuffleSpec), - [ComputeArgsAndFun, Shuffle, - if IsTopLevel -> - %% still need to compute function - assemble_function(Funs, [], Fun); - true -> - %% need to unpack a closure - [dup(1), i(?MLOAD)] - end, - i(?JUMP)]; -assemble_expr(Funs, Stack, Tail, {ifte, Decision, Then, Else}) -> - %% This compilation scheme introduces a lot of labels and - %% jumps. Unnecessary ones are removed later in - %% resolve_references. - Close = make_ref(), - ThenL = make_ref(), - ElseL = make_ref(), - [assemble_decision(Funs, Stack, Decision, ThenL, ElseL), - jumpdest(ElseL), - assemble_expr(Funs, Stack, Tail, Else), - jump(Close), - jumpdest(ThenL), - assemble_expr(Funs, Stack, Tail, Then), - jumpdest(Close) - ]; -assemble_expr(Funs, Stack, Tail, {switch, A, Cases}) -> - Close = make_ref(), - [assemble_expr(Funs, Stack, nontail, A), - assemble_cases(Funs, Stack, Tail, Close, Cases), - {'JUMPDEST', Close}]; -%% State primitives -%% (A pointer to) the contract state is stored at address 0. -assemble_expr(_Funs, _Stack, _Tail, prim_state) -> - [push(0), i(?MLOAD)]; -assemble_expr(Funs, Stack, _Tail, #prim_put{ state = State }) -> - [assemble_expr(Funs, Stack, nontail, State), - push(0), i(?MSTORE), %% We need something for the unit value on the stack, - i(?MSIZE)]; %% MSIZE is the cheapest instruction. -%% Environment primitives -assemble_expr(_Funs, _Stack, _Tail, prim_contract_address) -> - [i(?ADDRESS)]; -assemble_expr(_Funs, _Stack, _Tail, prim_contract_creator) -> - [i(?CREATOR)]; -assemble_expr(_Funs, _Stack, _Tail, prim_call_origin) -> - [i(?ORIGIN)]; -assemble_expr(_Funs, _Stack, _Tail, prim_caller) -> - [i(?CALLER)]; -assemble_expr(_Funs, _Stack, _Tail, prim_call_value) -> - [i(?CALLVALUE)]; -assemble_expr(_Funs, _Stack, _Tail, prim_gas_price) -> - [i(?GASPRICE)]; -assemble_expr(_Funs, _Stack, _Tail, prim_gas_left) -> - [i(?GAS)]; -assemble_expr(_Funs, _Stack, _Tail, prim_coinbase) -> - [i(?COINBASE)]; -assemble_expr(_Funs, _Stack, _Tail, prim_timestamp) -> - [i(?TIMESTAMP)]; -assemble_expr(_Funs, _Stack, _Tail, prim_block_height) -> - [i(?NUMBER)]; -assemble_expr(_Funs, _Stack, _Tail, prim_difficulty) -> - [i(?DIFFICULTY)]; -assemble_expr(_Funs, _Stack, _Tail, prim_gas_limit) -> - [i(?GASLIMIT)]; -assemble_expr(Funs, Stack, _Tail, #prim_balance{ address = Addr }) -> - [assemble_expr(Funs, Stack, nontail, Addr), - i(?BALANCE)]; -assemble_expr(Funs, Stack, _Tail, #prim_block_hash{ height = Height }) -> - [assemble_expr(Funs, Stack, nontail, Height), - i(?BLOCKHASH)]; -assemble_expr(Funs, Stack, _Tail, - #prim_call_contract{ gas = Gas - , address = To - , value = Value - , arg = Arg - , type_hash= TypeHash - }) -> - %% ?CALL takes (from the top) - %% Gas, To, Value, Arg, TypeHash, _OOffset,_OSize - %% So assemble these in reverse order. - [ assemble_exprs(Funs, Stack, [ {integer, 0}, {integer, 0}, TypeHash - , Arg, Value, To, Gas ]) - , i(?CALL) - ]. - - -assemble_exprs(_Funs, _Stack, []) -> - []; -assemble_exprs(Funs, Stack, [E|Es]) -> - [assemble_expr(Funs, Stack, nontail, E), - assemble_exprs(Funs, [dummy|Stack], Es)]. - -assemble_decision(Funs, Stack, {binop, '&&', A, B}, Then, Else) -> - Label = make_ref(), - [assemble_decision(Funs, Stack, A, Label, Else), - jumpdest(Label), - assemble_decision(Funs, Stack, B, Then, Else)]; -assemble_decision(Funs, Stack, {binop, '||', A, B}, Then, Else) -> - Label = make_ref(), - [assemble_decision(Funs, Stack, A, Then, Label), - jumpdest(Label), - assemble_decision(Funs, Stack, B, Then, Else)]; -assemble_decision(Funs, Stack, {unop, '!', A}, Then, Else) -> - assemble_decision(Funs, Stack, A, Else, Then); -assemble_decision(Funs, Stack, {ifte, A, B, C}, Then, Else) -> - TrueL = make_ref(), - FalseL = make_ref(), - [assemble_decision(Funs, Stack, A, TrueL, FalseL), - jumpdest(TrueL), assemble_decision(Funs, Stack, B, Then, Else), - jumpdest(FalseL), assemble_decision(Funs, Stack, C, Then, Else)]; -assemble_decision(Funs, Stack, Decision, Then, Else) -> - [assemble_expr(Funs, Stack, nontail, Decision), - jump_if(Then), jump(Else)]. - -%% Entered with value to switch on on top of the stack -%% Evaluate selected case, then jump to Close with result on the -%% stack. -assemble_cases(_Funs, _Stack, _Tail, _Close, []) -> - %% No match! What should be do? There's no real way to raise an - %% exception, except consuming all the gas. - %% There should not be enough gas to do this: - [push(1), i(?NOT), - i(?MLOAD), - %% now stop, so that jump optimizer realizes we will not fall - %% through this code. - i(?STOP)]; -assemble_cases(Funs, Stack, Tail, Close, [{Pattern, Body}|Cases]) -> - Succeed = make_ref(), - Fail = make_ref(), - {NewVars, MatchingCode} = - assemble_pattern(Succeed, Fail, Pattern), - %% In the code that follows, if this is NOT the last case, then we - %% save the value being switched on, and discard it on - %% success. The code is simpler if this IS the last case. - [[dup(1) || Cases /= []], %% save value for next case, if there is one - MatchingCode, - jumpdest(Succeed), - %% Discard saved value, if we saved one - [case NewVars of - [] -> - pop(1); - [_] -> - %% Special case for peep-hole optimization - pop_args(1); - _ -> - [swap(length(NewVars)), pop(1)] - end - || Cases/=[]], - assemble_expr(Funs, - case Cases of - [] -> NewVars; - _ -> reorder_vars(NewVars) - end - ++Stack, Tail, Body), - %% If the Body makes a tail call, then we will not return - %% here--but it doesn't matter, because - %% (a) the NewVars will be popped before the tailcall - %% (b) the code below will be deleted since it is dead - pop_args(length(NewVars)), - jump(Close), - jumpdest(Fail), - assemble_cases(Funs, Stack, Tail, Close, Cases)]. - -%% Entered with value to match on top of the stack. -%% Generated code removes value, and -%% - jumps to Fail if no match, or -%% - binds variables, leaves them on the stack, and jumps to Succeed -%% Result is a list of variables to add to the stack, and the matching -%% code. -assemble_pattern(Succeed, Fail, {integer, N}) -> - {[], [push(N), - i(?EQ), - jump_if(Succeed), - jump(Fail)]}; -assemble_pattern(Succeed, _Fail, {var_ref, "_"}) -> - {[], [i(?POP), jump(Succeed)]}; -assemble_pattern(Succeed, Fail, {missing_field, _, _}) -> - %% Missing record fields are quite ok in patterns. - assemble_pattern(Succeed, Fail, {var_ref, "_"}); -assemble_pattern(Succeed, _Fail, {var_ref, Id}) -> - {[{Id, "_"}], jump(Succeed)}; -assemble_pattern(Succeed, _Fail, {tuple, []}) -> - {[], [pop(1), jump(Succeed)]}; -assemble_pattern(Succeed, Fail, {tuple, [A]}) -> - %% Treat this case specially, because we don't need to save the - %% pointer to the tuple. - {AVars, ACode} = assemble_pattern(Succeed, Fail, A), - {AVars, [i(?MLOAD), - ACode]}; -assemble_pattern(Succeed, Fail, {tuple, [A|B]}) -> - %% Entered with the address of the tuple on the top of the - %% stack. We will duplicate the address before matching on A. - Continue = make_ref(), %% the label for matching B - Pop1Fail = make_ref(), %% pop 1 word and goto Fail - PopNFail = make_ref(), %% pop length(AVars) words and goto Fail - {AVars, ACode} = - assemble_pattern(Continue, Pop1Fail, A), - {BVars, BCode} = - assemble_pattern(Succeed, PopNFail, {tuple, B}), - {BVars ++ reorder_vars(AVars), - [%% duplicate the pointer so we don't lose it when we match on A - dup(1), - i(?MLOAD), - ACode, - jumpdest(Continue), - %% Bring the pointer to the top of the stack--this reorders AVars! - swap(length(AVars)), - push(32), - i(?ADD), - BCode, - case AVars of - [] -> - [jumpdest(Pop1Fail), pop(1), - jumpdest(PopNFail), - jump(Fail)]; - _ -> - [{'JUMPDEST', PopNFail}, pop(length(AVars)-1), - {'JUMPDEST', Pop1Fail}, pop(1), - {push_label, Fail}, 'JUMP'] - end]}; -assemble_pattern(Succeed, Fail, {list, []}) -> - %% [] is represented by -1. - {[], [push(1), - i(?ADD), - jump_if(Fail), - jump(Succeed)]}; -assemble_pattern(Succeed, Fail, {list, [A|B]}) -> - assemble_pattern(Succeed, Fail, {binop, '::', A, {list, B}}); -assemble_pattern(Succeed, Fail, {binop, '::', A, B}) -> - %% Make sure it's not [], then match as tuple. - NotNil = make_ref(), - {Vars, Code} = assemble_pattern(Succeed, Fail, {tuple, [A, B]}), - {Vars, [dup(1), push(1), i(?ADD), %% Check for [] without consuming the value - jump_if(NotNil), %% so it's still there when matching the tuple. - pop(1), %% It was [] so discard the saved value. - jump(Fail), - jumpdest(NotNil), - Code]}. - -%% When Vars are on the stack, with a value we want to discard -%% below them, then we swap the top variable with that value and pop. -%% This reorders the variables on the stack, as follows: -reorder_vars([]) -> - []; -reorder_vars([V|Vs]) -> - Vs ++ [V]. - -assemble_prefix('sha3') -> [i(?DUP1), i(?MLOAD), %% length, ptr - i(?SWAP1), push(32), i(?ADD), %% ptr+32, length - i(?SHA3)]; -assemble_prefix('-') -> [push(0), i(?SUB)]; -assemble_prefix('bnot') -> i(?NOT). - -assemble_infix('+') -> i(?ADD); -assemble_infix('-') -> i(?SUB); -assemble_infix('*') -> i(?MUL); -assemble_infix('/') -> i(?SDIV); -assemble_infix('div') -> i(?DIV); -assemble_infix('mod') -> i(?MOD); -assemble_infix('^') -> i(?EXP); -assemble_infix('bor') -> i(?OR); -assemble_infix('band') -> i(?AND); -assemble_infix('bxor') -> i(?XOR); -assemble_infix('bsl') -> i(?SHL); -assemble_infix('bsr') -> i(?SHR); -assemble_infix('<') -> i(?SLT); %% comparisons are SIGNED -assemble_infix('>') -> i(?SGT); -assemble_infix('==') -> i(?EQ); -assemble_infix('<=') -> [i(?SGT), i(?ISZERO)]; -assemble_infix('=<') -> [i(?SGT), i(?ISZERO)]; -assemble_infix('>=') -> [i(?SLT), i(?ISZERO)]; -assemble_infix('!=') -> [i(?EQ), i(?ISZERO)]; -assemble_infix('!') -> [i(?ADD), i(?MLOAD)]; -assemble_infix('byte') -> i(?BYTE). -%% assemble_infix('::') -> [i(?MSIZE), write_word(0), write_word(1)]. - -%% a function may either refer to a top-level function, in which case -%% we fetch the code label from Funs, or it may be a lambda-expression -%% (including a top-level function passed as a parameter). In the -%% latter case, the function value is a pointer to a tuple of the code -%% pointer and the free variables: we keep the pointer and push the -%% code pointer onto the stack. In either case, we are ready to enter -%% the function with JUMP. -assemble_function(Funs, Stack, Fun) -> - case is_top_level_fun(Stack, Fun) of - true -> - {var_ref, Name} = Fun, - {push_label, lookup_fun(Funs, Name)}; - false -> - [assemble_expr(Funs, Stack, nontail, Fun), - dup(1), - i(?MLOAD)] - end. - -free_vars(V={var_ref, _}) -> - [V]; -free_vars({switch, E, Cases}) -> - lists:umerge(free_vars(E), - lists:umerge([free_vars(Body)--free_vars(Pattern) - || {Pattern, Body} <- Cases])); -free_vars({lambda, Args, Body}) -> - free_vars(Body) -- [{var_ref, Arg#arg.name} || Arg <- Args]; -free_vars(T) when is_tuple(T) -> - free_vars(tuple_to_list(T)); -free_vars([H|T]) -> - lists:umerge(free_vars(H), free_vars(T)); -free_vars(_) -> - []. - - - -%% shuffle_stack reorders the stack, for example before a tailcall. It is called -%% with a description of the current stack, and how the final stack -%% should appear. The argument is a list containing -%% a NUMBER for each element that should be kept, the number being -%% the position this element should occupy in the final stack -%% discard, for elements that can be discarded. -%% The positions start at 1, referring to the variable to be placed at -%% the bottom of the stack, and ranging up to the size of the final stack. -shuffle_stack([]) -> - []; -shuffle_stack([discard|Stack]) -> - [i(?POP) | shuffle_stack(Stack)]; -shuffle_stack([N|Stack]) -> - case length(Stack) + 1 - N of - 0 -> - %% the job should be finished - CorrectStack = lists:seq(N - 1, 1, -1), - CorrectStack = Stack, - []; - MoveBy -> - {Pref, [_|Suff]} = lists:split(MoveBy - 1, Stack), - [swap(MoveBy) | shuffle_stack([lists:nth(MoveBy, Stack) | Pref ++ [N|Suff]])] - end. - - - -lookup_fun(Funs, Name) -> - case [Ref || {Name1, _, Ref} <- Funs, - Name == Name1] of - [Ref] -> Ref; - [] -> gen_error({undefined_function, Name}) - end. - -is_top_level_fun(Stack, {var_ref, Id}) -> - not lists:keymember(Id, 1, Stack); -is_top_level_fun(_, _) -> - false. - -lookup_var(Id, Stack) -> - lookup_var(1, Id, Stack). - -lookup_var(N, Id, [{Id, _Type}|_]) -> - N; -lookup_var(N, Id, [_|Stack]) -> - lookup_var(N + 1, Id, Stack); -lookup_var(_, Id, []) -> - gen_error({var_not_in_scope, Id}). - -%% Smart instruction generation - -%% TODO: handle references to the stack beyond depth 16. Perhaps the -%% best way is to repush variables that will be needed in -%% subexpressions before evaluating he subexpression... i.e. fix the -%% problem in assemble_expr, rather than here. A fix here would have -%% to save the top elements of the stack in memory, duplicate the -%% targetted element, and then repush the values from memory. -dup(N) when 1 =< N, N =< 16 -> - i(?DUP1 + N - 1). - -push(N) -> - Bytes = binary:encode_unsigned(N), - true = size(Bytes) =< 32, - [i(?PUSH1 + size(Bytes) - 1) | - binary_to_list(Bytes)]. - -%% Pop N values from UNDER the top element of the stack. -%% This is a pseudo-instruction so peephole optimization can -%% combine pop_args(M), pop_args(N) to pop_args(M+N) -pop_args(0) -> - []; -pop_args(N) -> - {pop_args, N}. -%% [swap(N), pop(N)]. - -pop(N) -> - [i(?POP) || _ <- lists:seq(1, N)]. - -swap(0) -> - %% Doesn't exist, but is logically a no-op. - []; -swap(N) when 1 =< N, N =< 16 -> - i(?SWAP1 + N - 1). - -jumpdest(Label) -> {i(?JUMPDEST), Label}. -push_label(Label) -> {push_label, Label}. - -jump(Label) -> [push_label(Label), i(?JUMP)]. -jump_if(Label) -> [push_label(Label), i(?JUMPI)]. - -%% ICode utilities (TODO: move to separate module) - -icode_noname() -> #var_ref{name = "_"}. - -icode_seq([A]) -> A; -icode_seq([A | As]) -> - icode_seq(A, icode_seq(As)). - -icode_seq(A, B) -> - #switch{ expr = A, cases = [{icode_noname(), B}] }. - -%% Stack: ADDR -%% Write elements at addresses ADDR, ADDR+32, ADDR+64... -%% Stack afterwards: ADDR -% write_words(N) -> -% [write_word(I) || I <- lists:seq(N-1, 0, -1)]. - -%% Unused at the moment. Comment out to please dialyzer. -%% write_word(I) -> -%% [%% Stack: elements e ADDR -%% swap(1), -%% dup(2), -%% %% Stack: elements ADDR e ADDR -%% push(32*I), -%% i(?ADD), -%% %% Stack: elements ADDR e ADDR+32I -%% i(?MSTORE)]. - -%% Resolve references, and convert code from deep list to flat list. -%% List elements are: -%% Opcodes -%% Byte values -%% {'JUMPDEST', Ref} -- assembles to ?JUMPDEST and sets Ref -%% {push_label, Ref} -- assembles to ?PUSHN address bytes - -%% For now, we assemble all code addresses as three bytes. - -resolve_references(Code) -> - Peephole = peep_hole(lists:flatten(Code)), - %% WARNING: Optimizing jumps reorders the code and deletes - %% instructions. When debugging the assemble_ functions, it can be - %% useful to replace the next line by: - %% Instrs = lists:flatten(Code), - %% thus disabling the optimization. - OptimizedJumps = optimize_jumps(Peephole), - Instrs = lists:reverse(peep_hole_backwards(lists:reverse(OptimizedJumps))), - Labels = define_labels(0, Instrs), - lists:flatten([use_labels(Labels, I) || I <- Instrs]). - -define_labels(Addr, [{'JUMPDEST', Lab}|More]) -> - [{Lab, Addr}|define_labels(Addr + 1, More)]; -define_labels(Addr, [{push_label, _}|More]) -> - define_labels(Addr + 4, More); -define_labels(Addr, [{pop_args, N}|More]) -> - define_labels(Addr + N + 1, More); -define_labels(Addr, [_|More]) -> - define_labels(Addr + 1, More); -define_labels(_, []) -> - []. - -use_labels(_, {'JUMPDEST', _}) -> - 'JUMPDEST'; -use_labels(Labels, {push_label, Ref}) -> - case proplists:get_value(Ref, Labels) of - undefined -> - gen_error({undefined_label, Ref}); - Addr when is_integer(Addr) -> - [i(?PUSH3), - Addr div 65536, (Addr div 256) rem 256, Addr rem 256] - end; -use_labels(_, {pop_args, N}) -> - [swap(N), pop(N)]; -use_labels(_, I) -> - I. - -%% Peep-hole optimization. -%% The compilation of conditionals can introduce jumps depending on -%% constants 1 and 0. These are removed by peep-hole optimization. - -peep_hole(['PUSH1', 0, {push_label, _}, 'JUMPI'|More]) -> - peep_hole(More); -peep_hole(['PUSH1', 1, {push_label, Lab}, 'JUMPI'|More]) -> - [{push_label, Lab}, 'JUMP'|peep_hole(More)]; -peep_hole([{pop_args, M}, {pop_args, N}|More]) when M + N =< 16 -> - peep_hole([{pop_args, M + N}|More]); -peep_hole([I|More]) -> - [I|peep_hole(More)]; -peep_hole([]) -> - []. - -%% Peep-hole optimization on reversed instructions lists. - -peep_hole_backwards(Code) -> - NewCode = peep_hole_backwards1(Code), - if Code == NewCode -> Code; - true -> peep_hole_backwards(NewCode) - end. - -peep_hole_backwards1(['ADD', 0, 'PUSH1'|Code]) -> - peep_hole_backwards1(Code); -peep_hole_backwards1(['POP', UnOp|Code]) when UnOp=='MLOAD';UnOp=='ISZERO';UnOp=='NOT' -> - peep_hole_backwards1(['POP'|Code]); -peep_hole_backwards1(['POP', BinOp|Code]) when - %% TODO: more binary operators - BinOp=='ADD';BinOp=='SUB';BinOp=='MUL';BinOp=='SDIV' -> - peep_hole_backwards1(['POP', 'POP'|Code]); -peep_hole_backwards1(['POP', _, 'PUSH1'|Code]) -> - peep_hole_backwards1(Code); -peep_hole_backwards1([I|Code]) -> - [I|peep_hole_backwards1(Code)]; -peep_hole_backwards1([]) -> - []. - -%% Jump optimization: -%% Replaces a jump to a jump with a jump to the final destination -%% Moves basic blocks to eliminate an unconditional jump to them. - -%% The compilation of conditionals generates a lot of labels and -%% jumps, some of them unnecessary. This optimization phase reorders -%% code so that as many jumps as possible can be eliminated, and -%% replaced by just falling through to the destination label. This -%% both optimizes the code generated by conditionals, and converts one -%% call of a function into falling through into its code--so it -%% reorders code quite aggressively. Function returns are indirect -%% jumps, however, and are never optimized away. - -%% IMPORTANT: since execution begins at address zero, then the first -%% block of code must never be moved elsewhere. The code below has -%% this property, because it processes blocks from left to right, and -%% because the first block does not begin with a label, and so can -%% never be jumped to--hence no code can be inserted before it. - -%% The optimization works by taking one block of code at a time, and -%% then prepending blocks that jump directly to it, and appending -%% blocks that it jumps directly to, resulting in a jump-free sequence -%% that is as long as possible. To do so, we store blocks in the form -%% {OptionalLabel, Body, OptionalJump} which represents the code block -%% OptionalLabel++Body++OptionalJump; the optional parts are the empty -%% list of instructions if not present. Two blocks can be merged if -%% the first ends in an OptionalJump to the OptionalLabel beginning -%% the second; the OptionalJump can then be removed (and the -%% OptionalLabel if there are no other references to it--this happens -%% during dead code elimination. - -%% TODO: the present implementation is QUADRATIC, because we search -%% repeatedly for matching blocks to merge with the first one, storing -%% the blocks in a list. A near linear time implementation could use -%% two ets tables, one keyed on the labels, and the other keyed on the -%% final jumps. - -optimize_jumps(Code) -> - JJs = jumps_to_jumps(Code), - ShortCircuited = [short_circuit_jumps(JJs, Instr) || Instr <- Code], - NoDeadCode = eliminate_dead_code(ShortCircuited), - MovedCode = merge_blocks(moveable_blocks(NoDeadCode)), - %% Moving code may have made some labels superfluous. - eliminate_dead_code(MovedCode). - - -jumps_to_jumps([{'JUMPDEST', Label}, {push_label, Target}, 'JUMP'|More]) -> - [{Label, Target}|jumps_to_jumps(More)]; -jumps_to_jumps([{'JUMPDEST', Label}, {'JUMPDEST', Target}|More]) -> - [{Label, Target}|jumps_to_jumps([{'JUMPDEST', Target}|More])]; -jumps_to_jumps([_|More]) -> - jumps_to_jumps(More); -jumps_to_jumps([]) -> - []. - -short_circuit_jumps(JJs, {push_label, Lab}) -> - case proplists:get_value(Lab, JJs) of - undefined -> - {push_label, Lab}; - Target -> - %% I wonder if this will ever loop infinitely? - short_circuit_jumps(JJs, {push_label, Target}) - end; -short_circuit_jumps(_JJs, Instr) -> - Instr. - -eliminate_dead_code(Code) -> - Jumps = lists:usort([Lab || {push_label, Lab} <- Code]), - NewCode = live_code(Jumps, Code), - if Code==NewCode -> - Code; - true -> - eliminate_dead_code(NewCode) - end. - -live_code(Jumps, ['JUMP'|More]) -> - ['JUMP'|dead_code(Jumps, More)]; -live_code(Jumps, ['STOP'|More]) -> - ['STOP'|dead_code(Jumps, More)]; -live_code(Jumps, [{'JUMPDEST', Lab}|More]) -> - case lists:member(Lab, Jumps) of - true -> - [{'JUMPDEST', Lab}|live_code(Jumps, More)]; - false -> - live_code(Jumps, More) - end; -live_code(Jumps, [I|More]) -> - [I|live_code(Jumps, More)]; -live_code(_, []) -> - []. - -dead_code(Jumps, [{'JUMPDEST', Lab}|More]) -> - case lists:member(Lab, Jumps) of - true -> - [{'JUMPDEST', Lab}|live_code(Jumps, More)]; - false -> - dead_code(Jumps, More) - end; -dead_code(Jumps, [_I|More]) -> - dead_code(Jumps, More); -dead_code(_, []) -> - []. - -%% Split the code into "moveable blocks" that control flow only -%% reaches via jumps. -moveable_blocks([]) -> - []; -moveable_blocks([I]) -> - [[I]]; -moveable_blocks([Jump|More]) when Jump=='JUMP'; Jump=='STOP' -> - [[Jump]|moveable_blocks(More)]; -moveable_blocks([I|More]) -> - [Block|MoreBlocks] = moveable_blocks(More), - [[I|Block]|MoreBlocks]. - -%% Merge blocks to eliminate jumps where possible. -merge_blocks(Blocks) -> - BlocksAndTargets = [label_and_jump(B) || B <- Blocks], - [I || {Pref, Body, Suff} <- merge_after(BlocksAndTargets), - I <- Pref++Body++Suff]. - -%% Merge the first block with other blocks that come after it -merge_after(All=[{Label, Body, [{push_label, Target}, 'JUMP']}|BlocksAndTargets]) -> - case [{B, J} || {[{'JUMPDEST', L}], B, J} <- BlocksAndTargets, - L == Target] of - [{B, J}|_] -> - merge_after([{Label, Body ++ [{'JUMPDEST', Target}] ++ B, J}| - lists:delete({[{'JUMPDEST', Target}], B, J}, - BlocksAndTargets)]); - [] -> - merge_before(All) - end; -merge_after(All) -> - merge_before(All). - -%% The first block cannot be merged with any blocks that it jumps -%% to... but maybe it can be merged with a block that jumps to it! -merge_before([Block={[{'JUMPDEST', Label}], Body, Jump}|BlocksAndTargets]) -> - case [{L, B, T} || {L, B, [{push_label, T}, 'JUMP']} <- BlocksAndTargets, - T == Label] of - [{L, B, T}|_] -> - merge_before([{L, B ++ [{'JUMPDEST', Label}] ++ Body, Jump} - |lists:delete({L, B, [{push_label, T}, 'JUMP']}, BlocksAndTargets)]); - _ -> - [Block | merge_after(BlocksAndTargets)] - end; -merge_before([Block|BlocksAndTargets]) -> - [Block | merge_after(BlocksAndTargets)]; -merge_before([]) -> - []. - -%% Convert each block to a PREFIX, which is a label or empty, a -%% middle, and a SUFFIX which is a JUMP to a label, or empty. -label_and_jump(B) -> - {Label, B1} = case B of - [{'JUMPDEST', L}|More1] -> - {[{'JUMPDEST', L}], More1}; - _ -> - {[], B} - end, - {Target, B2} = case lists:reverse(B1) of - ['JUMP', {push_label, T}|More2] -> - {[{push_label, T}, 'JUMP'], lists:reverse(More2)}; - _ -> - {[], B1} - end, - {Label, B2, Target}. diff --git a/src/aeso_vm_decode.erl b/src/aeso_vm_decode.erl index 0a293dd..dc5d18b 100644 --- a/src/aeso_vm_decode.erl +++ b/src/aeso_vm_decode.erl @@ -1,75 +1,15 @@ %%%------------------------------------------------------------------- %%% @copyright (C) 2017, Aeternity Anstalt -%%% @doc Decoding aevm and fate data to AST -%%% +%%% @doc Decoding fate data to AST %%% @end %%%------------------------------------------------------------------- -module(aeso_vm_decode). --export([ from_aevm/3, from_fate/2 ]). +-export([ from_fate/2 ]). -include_lib("aebytecode/include/aeb_fate_data.hrl"). -address_literal(Type, N) -> {Type, [], <>}. - --spec from_aevm(aeb_aevm_data:type(), aeso_syntax:type(), aeb_aevm_data:data()) -> aeso_syntax:expr(). -from_aevm(word, {id, _, "address"}, N) -> address_literal(account_pubkey, N); -from_aevm(word, {app_t, _, {id, _, "oracle"}, _}, N) -> address_literal(oracle_pubkey, N); -from_aevm(word, {app_t, _, {id, _, "oracle_query"}, _}, N) -> address_literal(oracle_query_id, N); -from_aevm(word, {con, _, _Name}, N) -> address_literal(contract_pubkey, N); -from_aevm(word, {id, _, "int"}, N0) -> - <> = <>, - if N < 0 -> {app, [{format, prefix}], {'-', []}, [{int, [], -N}]}; - true -> {int, [], N} end; -from_aevm(word, {id, _, "bits"}, N0) -> - <> = <>, - make_bits(N); -from_aevm(word, {id, _, "bool"}, N) -> {bool, [], N /= 0}; -from_aevm(word, {bytes_t, _, Len}, Val) when Len =< 32 -> - <> = <>, - {bytes, [], <>}; -from_aevm({tuple, _}, {bytes_t, _, Len}, Val) -> - {bytes, [], binary:part(<< <> || W <- tuple_to_list(Val) >>, 0, Len)}; -from_aevm(string, {id, _, "string"}, S) -> {string, [], S}; -from_aevm({list, VmType}, {app_t, _, {id, _, "list"}, [Type]}, List) -> - {list, [], [from_aevm(VmType, Type, X) || X <- List]}; -from_aevm({variant, [[], [VmType]]}, {app_t, _, {id, _, "option"}, [Type]}, Val) -> - case Val of - {variant, 0, []} -> {con, [], "None"}; - {variant, 1, [X]} -> {app, [], {con, [], "Some"}, [from_aevm(VmType, Type, X)]} - end; -from_aevm({tuple, VmTypes}, {tuple_t, _, Types}, Val) - when length(VmTypes) == length(Types), - length(VmTypes) == tuple_size(Val) -> - {tuple, [], [from_aevm(VmType, Type, X) - || {VmType, Type, X} <- lists:zip3(VmTypes, Types, tuple_to_list(Val))]}; -from_aevm({tuple, VmTypes}, {record_t, Fields}, Val) - when length(VmTypes) == length(Fields), - length(VmTypes) == tuple_size(Val) -> - {record, [], [ {field, [], [{proj, [], FName}], from_aevm(VmType, FType, X)} - || {VmType, {field_t, _, FName, FType}, X} <- lists:zip3(VmTypes, Fields, tuple_to_list(Val)) ]}; -from_aevm({map, VmKeyType, VmValType}, {app_t, _, {id, _, "map"}, [KeyType, ValType]}, Map) - when is_map(Map) -> - {map, [], [ {from_aevm(VmKeyType, KeyType, Key), - from_aevm(VmValType, ValType, Val)} - || {Key, Val} <- maps:to_list(Map) ]}; -from_aevm({variant, VmCons}, {variant_t, Cons}, {variant, Tag, Args}) - when length(VmCons) == length(Cons), - length(VmCons) > Tag -> - VmTypes = lists:nth(Tag + 1, VmCons), - ConType = lists:nth(Tag + 1, Cons), - from_aevm(VmTypes, ConType, Args); -from_aevm([], {constr_t, _, Con, []}, []) -> Con; -from_aevm(VmTypes, {constr_t, _, Con, Types}, Args) - when length(VmTypes) == length(Types), - length(VmTypes) == length(Args) -> - {app, [], Con, [ from_aevm(VmType, Type, Arg) - || {VmType, Type, Arg} <- lists:zip3(VmTypes, Types, Args) ]}; -from_aevm(_VmType, _Type, _Data) -> - throw(cannot_translate_to_sophia). - - -spec from_fate(aeso_syntax:type(), aeb_fate_data:fate_type()) -> aeso_syntax:expr(). from_fate({id, _, "address"}, ?FATE_ADDRESS(Bin)) -> {account_pubkey, [], Bin}; from_fate({app_t, _, {id, _, "oracle"}, _}, ?FATE_ORACLE(Bin)) -> {oracle_pubkey, [], Bin}; diff --git a/test/aeso_abi_tests.erl b/test/aeso_abi_tests.erl index 9461d64..2a8faba 100644 --- a/test/aeso_abi_tests.erl +++ b/test/aeso_abi_tests.erl @@ -5,7 +5,6 @@ -define(SANDBOX(Code), sandbox(fun() -> Code end)). -define(DUMMY_HASH_WORD, 16#123). --define(DUMMY_HASH, <<0:30/unit:8, 127, 119>>). %% 16#123 -define(DUMMY_HASH_LIT, "#0000000000000000000000000000000000000000000000000000000000000123"). sandbox(Code) -> @@ -20,12 +19,6 @@ sandbox(Code) -> {error, loop} end. -malicious_from_binary_test() -> - CircularList = from_words([32, 1, 32]), %% Xs = 1 :: Xs - {ok, {error, circular_references}} = ?SANDBOX(aeb_heap:from_binary({list, word}, CircularList)), - {ok, {error, {binary_too_short, _}}} = ?SANDBOX(aeb_heap:from_binary(word, <<1, 2, 3, 4>>)), - ok. - from_words(Ws) -> << <<(from_word(W))/binary>> || W <- Ws >>. @@ -37,23 +30,14 @@ from_word(S) when is_list(S) -> <>. encode_decode_test() -> - encode_decode(word, 42), - 42 = encode_decode(word, 42), - -1 = encode_decode(signed_word, -1), - <<"Hello world">> = encode_decode(string, <<"Hello world">>), - {} = encode_decode({tuple, []}, {}), - {42} = encode_decode({tuple, [word]}, {42}), - {42, 0} = encode_decode({tuple, [word, word]}, {42, 0}), - [] = encode_decode({list, word}, []), - [32] = encode_decode({list, word}, [32]), - none = encode_decode({option, word}, none), - {some, 1} = encode_decode({option, word}, {some, 1}), - string = encode_decode(typerep, string), - word = encode_decode(typerep, word), - {list, word} = encode_decode(typerep, {list, word}), - {tuple, [word]} = encode_decode(typerep, {tuple, [word]}), - 1 = encode_decode(word, 1), - 0 = encode_decode(word, 0), + Tests = + [42, 1, 0 -1, <<"Hello">>, + {tuple, {}}, {tuple, {42}}, {tuple, {21, 37}}, + [], [42], [21, 37], + {variant, [0, 1], 0, {}}, {variant, [0, 1], 1, {42}}, {variant, [2], 0, {21, 37}}, + {typerep, string}, {typerep, integer}, {typerep, {list, integer}}, {typerep, {tuple, [integer]}} + ], + [?assertEqual(Test, encode_decode(Test)) || Test <- Tests], ok. encode_decode_sophia_test() -> @@ -95,55 +79,44 @@ to_sophia_value_mcl_bls12_381_test() -> to_sophia_value_neg_test() -> Code = [ "contract Foo =\n" - " entrypoint x(y : int) : string = \"hello\"\n" ], + " entrypoint f(x : int) : string = \"hello\"\n" ], - {error, [Err1]} = aeso_compiler:to_sophia_value(Code, "x", ok, encode(12)), - ?assertEqual("Data error:\nFailed to decode binary as type string\n", aeso_errors:pp(Err1)), - {error, [Err2]} = aeso_compiler:to_sophia_value(Code, "x", ok, encode(12), [{backend, fate}]), - ?assertEqual("Data error:\nFailed to decode binary as type string\n", aeso_errors:pp(Err2)), + {error, [Err1]} = aeso_compiler:to_sophia_value(Code, "f", ok, encode(12)), + ?assertEqual("Data error:\nCannot translate FATE value 12\n of Sophia type string\n", aeso_errors:pp(Err1)), - {error, [Err3]} = aeso_compiler:to_sophia_value(Code, "x", revert, encode(12)), - ?assertEqual("Data error:\nCould not interpret the revert message\n", aeso_errors:pp(Err3)), - {error, [Err4]} = aeso_compiler:to_sophia_value(Code, "x", revert, encode(12), [{backend, fate}]), - ?assertEqual("Data error:\nCould not deserialize the revert message\n", aeso_errors:pp(Err4)), + {error, [Err2]} = aeso_compiler:to_sophia_value(Code, "f", revert, encode(12)), + ?assertEqual("Data error:\nCould not deserialize the revert message\n", aeso_errors:pp(Err2)), ok. encode_calldata_neg_test() -> Code = [ "contract Foo =\n" - " entrypoint x(y : int) : string = \"hello\"\n" ], + " entrypoint f(x : int) : string = \"hello\"\n" ], ExpErr1 = "Type error at line 5, col 34:\nCannot unify `int` and `bool`\n" "when checking the application of\n" - " `x : (int) => string`\n" + " `f : (int) => string`\n" "to arguments\n" " `true : bool`\n", - {error, [Err1]} = aeso_compiler:create_calldata(Code, "x", ["true"]), + {error, [Err1]} = aeso_compiler:create_calldata(Code, "f", ["true"]), ?assertEqual(ExpErr1, aeso_errors:pp(Err1)), - {error, [Err2]} = aeso_compiler:create_calldata(Code, "x", ["true"], [{backend, fate}]), - ?assertEqual(ExpErr1, aeso_errors:pp(Err2)), ok. decode_calldata_neg_test() -> Code1 = [ "contract Foo =\n" - " entrypoint x(y : int) : string = \"hello\"\n" ], + " entrypoint f(x : int) : string = \"hello\"\n" ], Code2 = [ "contract Foo =\n" - " entrypoint x(y : string) : int = 42\n" ], + " entrypoint f(x : string) : int = 42\n" ], - {ok, CallDataAEVM} = aeso_compiler:create_calldata(Code1, "x", ["42"]), - {ok, CallDataFATE} = aeso_compiler:create_calldata(Code1, "x", ["42"], [{backend, fate}]), + {ok, CallDataFATE} = aeso_compiler:create_calldata(Code1, "f", ["42"]), - {error, [Err1]} = aeso_compiler:decode_calldata(Code2, "x", CallDataAEVM), - ?assertEqual("Data error:\nFailed to decode calldata as type {tuple,[string]}\n", aeso_errors:pp(Err1)), - {error, [Err2]} = aeso_compiler:decode_calldata(Code2, "x", <<1,2,3>>, [{backend, fate}]), - ?assertEqual("Data error:\nFailed to decode calldata binary\n", aeso_errors:pp(Err2)), - {error, [Err3]} = aeso_compiler:decode_calldata(Code2, "x", CallDataFATE, [{backend, fate}]), - ?assertEqual("Data error:\nCannot translate FATE value \"*\"\n to Sophia type (string)\n", aeso_errors:pp(Err3)), + {error, [Err1]} = aeso_compiler:decode_calldata(Code2, "f", <<1,2,3>>), + ?assertEqual("Data error:\nFailed to decode calldata binary\n", aeso_errors:pp(Err1)), + {error, [Err2]} = aeso_compiler:decode_calldata(Code2, "f", CallDataFATE), + ?assertEqual("Data error:\nCannot translate FATE value \"*\"\n to Sophia type (string)\n", aeso_errors:pp(Err2)), - {error, [Err4]} = aeso_compiler:decode_calldata(Code2, "y", CallDataAEVM), - ?assertEqual("Data error at line 1, col 1:\nFunction 'y' is missing in contract\n", aeso_errors:pp(Err4)), - {error, [Err5]} = aeso_compiler:decode_calldata(Code2, "y", CallDataFATE, [{backend, fate}]), - ?assertEqual("Data error at line 1, col 1:\nFunction 'y' is missing in contract\n", aeso_errors:pp(Err5)), + {error, [Err3]} = aeso_compiler:decode_calldata(Code2, "x", CallDataFATE), + ?assertEqual("Data error at line 1, col 1:\nFunction 'x' is missing in contract\n", aeso_errors:pp(Err3)), ok. @@ -156,8 +129,7 @@ encode_decode_sophia_string(SophiaType, String) -> , " datatype variant = Red | Blue(map(string, int))\n" , " entrypoint foo : arg_type => arg_type\n" ], case aeso_compiler:check_call(lists:flatten(Code), "foo", [String], [no_code]) of - {ok, _, {[Type], _}, [Arg]} -> - io:format("Type ~p~n", [Type]), + {ok, _, [Arg]} -> Data = encode(Arg), case aeso_compiler:to_sophia_value(Code, "foo", ok, Data, [no_code]) of {ok, Sophia} -> @@ -173,30 +145,32 @@ encode_decode_sophia_string(SophiaType, String) -> calldata_test() -> [42, <<"foobar">>] = encode_decode_calldata("foo", ["int", "string"], ["42", "\"foobar\""]), - Map = #{ <<"a">> => 4 }, - [{variant, 1, [Map]}, {{<<"b">>, 5}, {variant, 0, []}}] = + [{variant, [0,1], 1, {#{ <<"a">> := 4 }}}, {tuple, {{tuple, {<<"b">>, 5}}, {variant, [0,1], 0, {}}}}] = encode_decode_calldata("foo", ["variant", "r"], ["Blue({[\"a\"] = 4})", "{x = (\"b\", 5), y = Red}"]), - [?DUMMY_HASH_WORD, 16#456] = encode_decode_calldata("foo", ["bytes(32)", "address"], - [?DUMMY_HASH_LIT, "ak_1111111111111111111111111111113AFEFpt5"]), - [?DUMMY_HASH_WORD, ?DUMMY_HASH_WORD] = + [{bytes, <<291:256>>}, {address, <<1110:256>>}] = + encode_decode_calldata("foo", ["bytes(32)", "address"], + [?DUMMY_HASH_LIT, "ak_1111111111111111111111111111113AFEFpt5"]), + [{bytes, <<291:256>>}, {bytes, <<291:256>>}] = encode_decode_calldata("foo", ["bytes(32)", "hash"], [?DUMMY_HASH_LIT, ?DUMMY_HASH_LIT]), - [119, {0, 0}] = encode_decode_calldata("foo", ["int", "signature"], ["119", [$# | lists:duplicate(128, $0)]]), + [119, {bytes, <<0:64/unit:8>>}] = encode_decode_calldata("foo", ["int", "signature"], ["119", [$# | lists:duplicate(128, $0)]]), - [16#456] = encode_decode_calldata("foo", ["Remote"], ["ct_1111111111111111111111111111113AFEFpt5"]), + [{contract, <<1110:256>>}] = encode_decode_calldata("foo", ["Remote"], ["ct_1111111111111111111111111111113AFEFpt5"]), ok. calldata_init_test() -> - encode_decode_calldata("init", ["int"], ["42"], {tuple, [typerep, word]}), + encode_decode_calldata("init", ["int"], ["42"]), Code = parameterized_contract("foo", ["int"]), - encode_decode_calldata_(Code, "init", [], {tuple, [typerep, {tuple, []}]}). + encode_decode_calldata_(Code, "init", []), + + ok. calldata_indent_test() -> Test = fun(Extra) -> Code = parameterized_contract(Extra, "foo", ["int"]), - encode_decode_calldata_(Code, "foo", ["42"], word) + encode_decode_calldata_(Code, "foo", ["42"]) end, Test(" stateful entrypoint bla() = ()"), Test(" type x = int"), @@ -225,9 +199,9 @@ oracle_test() -> "contract OracleTest =\n" " entrypoint question(o, q : oracle_query(list(string), option(int))) =\n" " Oracle.get_question(o, q)\n", - {ok, _, {[word, word], {list, string}}, [16#123, 16#456]} = - aeso_compiler:check_call(Contract, "question", ["ok_111111111111111111111111111111ZrdqRz9", - "oq_1111111111111111111111111111113AFEFpt5"], [no_code]), + ?assertEqual({ok, "question", [{oracle, <<291:256>>}, {oracle_query, <<1110:256>>}]}, + aeso_compiler:check_call(Contract, "question", ["ok_111111111111111111111111111111ZrdqRz9", + "oq_1111111111111111111111111111113AFEFpt5"], [no_code])), ok. @@ -243,35 +217,26 @@ permissive_literals_fail_test() -> ok. encode_decode_calldata(FunName, Types, Args) -> - encode_decode_calldata(FunName, Types, Args, word). - -encode_decode_calldata(FunName, Types, Args, RetType) -> Code = parameterized_contract(FunName, Types), - encode_decode_calldata_(Code, FunName, Args, RetType). + encode_decode_calldata_(Code, FunName, Args). -encode_decode_calldata_(Code, FunName, Args, RetVMType) -> +encode_decode_calldata_(Code, FunName, Args) -> {ok, Calldata} = aeso_compiler:create_calldata(Code, FunName, Args, []), - {ok, _, {ArgTypes, RetType}, _} = aeso_compiler:check_call(Code, FunName, Args, [{backend, aevm}, no_code]), - ?assertEqual(RetType, RetVMType), - CalldataType = {tuple, [word, {tuple, ArgTypes}]}, - {ok, {_Hash, ArgTuple}} = aeb_heap:from_binary(CalldataType, Calldata), + {ok, _, _} = aeso_compiler:check_call(Code, FunName, Args, [no_code]), case FunName of "init" -> - ok; + []; _ -> - {ok, _ArgTypes, ValueASTs} = aeso_compiler:decode_calldata(Code, FunName, Calldata, []), - Values = [ prettypr:format(aeso_pretty:expr(V)) || V <- ValueASTs ], - ?assertMatch({X, X}, {Args, Values}) - end, - tuple_to_list(ArgTuple). + {ok, FateArgs} = aeb_fate_abi:decode_calldata(FunName, Calldata), + FateArgs + end. -encode_decode(T, D) -> - ?assertEqual(D, decode(T, encode(D))), +encode_decode(D) -> + ?assertEqual(D, decode(encode(D))), D. encode(D) -> - aeb_heap:to_binary(D). + aeb_fate_encoding:serialize(D). -decode(T,B) -> - {ok, D} = aeb_heap:from_binary(T, B), - D. +decode(B) -> + aeb_fate_encoding:deserialize(B). diff --git a/test/aeso_aci_tests.erl b/test/aeso_aci_tests.erl index fe71638..43ac0c3 100644 --- a/test/aeso_aci_tests.erl +++ b/test/aeso_aci_tests.erl @@ -108,7 +108,7 @@ aci_test_contract(Name) -> {error, ErrorStringJ} when is_binary(ErrorStringJ) -> error(ErrorStringJ); {error, ErrorJ} -> aeso_compiler_tests:print_and_throw(ErrorJ) end, - case aeso_compiler:from_string(String, [{aci, json}, {backend, fate} | Opts]) of + case aeso_compiler:from_string(String, [{aci, json} | Opts]) of {ok, #{aci := JSON1}} -> ?assertEqual(JSON, JSON1), io:format("JSON:\n~p\n", [JSON]), diff --git a/test/aeso_calldata_tests.erl b/test/aeso_calldata_tests.erl index 80ef24f..c897180 100644 --- a/test/aeso_calldata_tests.erl +++ b/test/aeso_calldata_tests.erl @@ -19,19 +19,9 @@ calldata_test_() -> [ {"Testing " ++ ContractName ++ " contract calling " ++ Fun, fun() -> ContractString = aeso_test_utils:read_contract(ContractName), - AevmExprs = - case not lists:member(ContractName, not_yet_compilable(aevm)) of - true -> ast_exprs(ContractString, Fun, Args, [{backend, aevm}]); - false -> undefined - end, - FateExprs = - case not lists:member(ContractName, not_yet_compilable(fate)) of - true -> ast_exprs(ContractString, Fun, Args, [{backend, fate}]); - false -> undefined - end, + FateExprs = ast_exprs(ContractString, Fun, Args), ParsedExprs = parse_args(Fun, Args), - [ ?assertEqual(ParsedExprs, AevmExprs) || AevmExprs /= undefined ], - [ ?assertEqual(ParsedExprs, FateExprs) || FateExprs /= undefined ], + ?assertEqual(ParsedExprs, FateExprs), ok end} || {ContractName, Fun, Args} <- compilable_contracts()]. @@ -42,19 +32,9 @@ calldata_aci_test_() -> {ok, ContractACIBin} = aeso_aci:contract_interface(string, ContractString), ContractACI = binary_to_list(ContractACIBin), io:format("ACI:\n~s\n", [ContractACIBin]), - AevmExprs = - case not lists:member(ContractName, not_yet_compilable(aevm)) of - true -> ast_exprs(ContractACI, Fun, Args, [{backend, aevm}]); - false -> undefined - end, - FateExprs = - case not lists:member(ContractName, not_yet_compilable(fate)) of - true -> ast_exprs(ContractACI, Fun, Args, [{backend, fate}]); - false -> undefined - end, + FateExprs = ast_exprs(ContractACI, Fun, Args), ParsedExprs = parse_args(Fun, Args), - [ ?assertEqual(ParsedExprs, AevmExprs) || AevmExprs /= undefined ], - [ ?assertEqual(ParsedExprs, FateExprs) || FateExprs /= undefined ], + ?assertEqual(ParsedExprs, FateExprs), ok end} || {ContractName, Fun, Args} <- compilable_contracts()]. @@ -75,6 +55,8 @@ strip_ann1(L) when is_list(L) -> lists:map(fun strip_ann/1, L); strip_ann1(X) -> X. +ast_exprs(ContractString, Fun, Args) -> + ast_exprs(ContractString, Fun, Args, []). ast_exprs(ContractString, Fun, Args, Opts) -> {ok, Data} = (catch aeso_compiler:create_calldata(ContractString, Fun, Args, Opts)), {ok, _Types, Exprs} = (catch aeso_compiler:decode_calldata(ContractString, Fun, Data, Opts)), @@ -159,8 +141,3 @@ compilable_contracts() -> {"stub", "foo", ["-42"]}, {"payable", "foo", ["42"]} ]. - -not_yet_compilable(fate) -> - []; -not_yet_compilable(aevm) -> - ["funargs", "strings"]. diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index fa3cb6a..f9e4009 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -24,20 +24,15 @@ run_test(Test) -> %% are made on the output, just that it is a binary which indicates %% that the compilation worked. simple_compile_test_() -> - [ {"Testing the " ++ ContractName ++ " contract with the " ++ atom_to_list(Backend) ++ " backend", + [ {"Testing the " ++ ContractName ++ " contract", fun() -> - case compile(Backend, ContractName) of - #{byte_code := ByteCode, - contract_source := _, - type_info := _} when Backend == aevm -> - ?assertMatch(Code when is_binary(Code), ByteCode); - #{fate_code := Code} when Backend == fate -> + case compile(ContractName) of + #{fate_code := Code} -> Code1 = aeb_fate_code:deserialize(aeb_fate_code:serialize(Code)), ?assertMatch({X, X}, {Code1, Code}); Error -> io:format("\n\n~p\n\n", [Error]), print_and_throw(Error) end - end} || ContractName <- compilable_contracts(), Backend <- [aevm, fate], - not lists:member(ContractName, not_compilable_on(Backend))] ++ + end} || ContractName <- compilable_contracts()] ++ [ {"Test file not found error", fun() -> {error, Errors} = aeso_compiler:file("does_not_exist.aes"), @@ -46,26 +41,16 @@ simple_compile_test_() -> end} ] ++ [ {"Testing error messages of " ++ ContractName, fun() -> - Errors = compile(aevm, ContractName, [warn_all, warn_error]), + Errors = compile(ContractName, [warn_all, warn_error]), check_errors(ExpectedErrors, Errors) end} || {ContractName, ExpectedErrors} <- failing_contracts() ] ++ - [ {"Testing " ++ atom_to_list(Backend) ++ " code generation error messages of " ++ ContractName, + [ {"Testing code generation error messages of " ++ ContractName, fun() -> - Errors = compile(Backend, ContractName), - Expect = - case is_binary(ExpectedError) of - true -> [ExpectedError]; - false -> - case proplists:get_value(Backend, ExpectedError, no_error) of - no_error -> no_error; - Err -> [Err] - end - end, - check_errors(Expect, Errors) + Errors = compile(ContractName), + check_errors([ExpectedError], Errors) end} || - {ContractName, ExpectedError} <- failing_code_gen_contracts(), - Backend <- [aevm, fate] ] ++ + {ContractName, ExpectedError} <- failing_code_gen_contracts()] ++ [ {"Testing include with explicit files", fun() -> FileSystem = maps:from_list( @@ -73,26 +58,25 @@ simple_compile_test_() -> {ok, Bin} = file:read_file(filename:join([aeso_test_utils:contract_path(), File])), {File, Bin} end || File <- ["included.aes", "../contracts/included2.aes"] ]), - #{byte_code := Code1} = compile(aevm, "include", [{include, {explicit_files, FileSystem}}]), - #{byte_code := Code2} = compile(aevm, "include"), + #{byte_code := Code1} = compile("include", [{include, {explicit_files, FileSystem}}]), + #{byte_code := Code2} = compile("include"), ?assertMatch(true, Code1 == Code2) end} ] ++ - [ {"Testing deadcode elimination for " ++ atom_to_list(Backend), + [ {"Testing deadcode elimination", fun() -> - #{ byte_code := NoDeadCode } = compile(Backend, "nodeadcode"), - #{ byte_code := DeadCode } = compile(Backend, "deadcode"), + #{ byte_code := NoDeadCode } = compile("nodeadcode"), + #{ byte_code := DeadCode } = compile("deadcode"), SizeNoDeadCode = byte_size(NoDeadCode), SizeDeadCode = byte_size(DeadCode), - Delta = if Backend == aevm -> 40; - Backend == fate -> 20 end, + Delta = 20, ?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + Delta < SizeNoDeadCode}), ok - end} || Backend <- [aevm, fate] ] ++ + end} ] ++ [ {"Testing warning messages", fun() -> - #{ warnings := Warnings } = compile(Backend, "warnings", [warn_all]), + #{ warnings := Warnings } = compile("warnings", [warn_all]), check_warnings(warnings(), Warnings) - end} || Backend <- [aevm, fate] ] ++ + end} ] ++ []. %% Check if all modules in the standard library compile @@ -101,7 +85,7 @@ stdlib_test_() -> [ { "Testing " ++ File ++ " from the stdlib", fun() -> String = "include \"" ++ File ++ "\"\nmain contract Test =\n entrypoint f(x) = x", - Options = [{src_file, File}, {backend, fate}], + Options = [{src_file, File}], case aeso_compiler:from_string(String, Options) of {ok, #{fate_code := Code}} -> Code1 = aeb_fate_code:deserialize(aeb_fate_code:serialize(Code)), @@ -133,18 +117,17 @@ check_warnings(Expect0, Actual0) -> {Missing, Extra} -> ?assertEqual(Missing, Extra) end. -compile(Backend, Name) -> - compile(Backend, Name, - [{include, {file_system, [aeso_test_utils:contract_path()]}}]). +compile(Name) -> + compile( Name, [{include, {file_system, [aeso_test_utils:contract_path()]}}]). -compile(Backend, Name, Options) -> +compile(Name, Options) -> String = aeso_test_utils:read_contract(Name), Options1 = case lists:member(Name, debug_mode_contracts()) of true -> [debug_mode]; false -> [] end ++ - [ {src_file, Name ++ ".aes"}, {backend, Backend} + [ {src_file, Name ++ ".aes"} , {include, {file_system, [aeso_test_utils:contract_path()]}} ] ++ Options, case aeso_compiler:from_string(String, Options1) of @@ -222,9 +205,6 @@ compilable_contracts() -> "test" % Custom general-purpose test file. Keep it last on the list. ]. -not_compilable_on(fate) -> []; -not_compilable_on(aevm) -> compilable_contracts(). - debug_mode_contracts() -> ["hermetization_turnoff"]. @@ -840,113 +820,51 @@ failing_contracts() -> -define(Path(File), "code_errors/" ??File). -define(Msg(File, Line, Col, Err), <>). --define(SAME(File, Line, Col, Err), {?Path(File), ?Msg(File, Line, Col, Err)}). --define(AEVM(File, Line, Col, Err), {?Path(File), [{aevm, ?Msg(File, Line, Col, Err)}]}). --define(FATE(File, Line, Col, Err), {?Path(File), [{fate, ?Msg(File, Line, Col, Err)}]}). --define(BOTH(File, Line, Col, ErrAEVM, ErrFATE), - {?Path(File), [{aevm, ?Msg(File, Line, Col, ErrAEVM)}, - {fate, ?Msg(File, Line, Col, ErrFATE)}]}). +-define(FATE_ERR(File, Line, Col, Err), {?Path(File), ?Msg(File, Line, Col, Err)}). failing_code_gen_contracts() -> - [ ?SAME(missing_definition, 2, 14, + [ ?FATE_ERR(missing_definition, 2, 14, "Missing definition of function 'foo'.") - , ?AEVM(polymorphic_entrypoint, 2, 17, - "The argument\n" - " x : 'a\n" - "of entrypoint 'id' has a polymorphic (contains type variables) type.\n" - "Use the FATE backend if you want polymorphic entrypoints.") - , ?AEVM(polymorphic_entrypoint_return, 2, 3, - "The return type\n" - " 'a\n" - "of entrypoint 'fail' is polymorphic (contains type variables).\n" - "Use the FATE backend if you want polymorphic entrypoints.") - , ?SAME(higher_order_entrypoint, 2, 20, + , ?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.") - , ?SAME(higher_order_entrypoint_return, 2, 3, + , ?FATE_ERR(higher_order_entrypoint_return, 2, 3, "The return type\n" " (int) => int\n" "of entrypoint 'add' is higher-order (contains function types).") - , ?SAME(missing_init_function, 1, 10, + , ?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'.") - , ?SAME(parameterised_state, 3, 8, + , ?FATE_ERR(parameterised_state, 3, 8, "The state type cannot be parameterized.") - , ?SAME(parameterised_event, 3, 12, + , ?FATE_ERR(parameterised_event, 3, 12, "The event type cannot be parameterized.") - , ?SAME(polymorphic_aens_resolve, 4, 5, + , ?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).") - , ?SAME(bad_aens_resolve, 6, 5, + , ?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).") - , ?AEVM(polymorphic_compare, 4, 5, - "Cannot compare values of type\n" - " 'a\n" - "The AEVM only supports '==' on values of\n" - "- word type (int, bool, bits, address, oracle(_, _), etc)\n" - "- type string\n" - "- tuple or record of word type\n" - "Use FATE if you need to compare arbitrary types.") - , ?AEVM(complex_compare, 4, 5, - "Cannot compare values of type\n" - " (string * int)\n" - "The AEVM only supports '!=' on values of\n" - "- word type (int, bool, bits, address, oracle(_, _), etc)\n" - "- type string\n" - "- tuple or record of word type\n" - "Use FATE if you need to compare arbitrary types.") - , ?AEVM(complex_compare_leq, 4, 5, - "Cannot compare values of type\n" - " (int * int)\n" - "The AEVM only supports '=<' on values of\n" - "- word type (int, bool, bits, address, oracle(_, _), etc)\n" - "Use FATE if you need to compare arbitrary types.") - , ?AEVM(higher_order_compare, 4, 5, - "Cannot compare values of type\n" - " (int) => int\n" - "The AEVM only supports '<' on values of\n" - "- word type (int, bool, bits, address, oracle(_, _), etc)\n" - "Use FATE if you need to compare arbitrary types.") - , ?AEVM(unapplied_contract_call, 6, 19, - "The AEVM does not support unapplied contract call to\n" - " r : Remote\n" - "Use FATE if you need this.") - , ?AEVM(unapplied_named_arg_builtin, 4, 15, - "The AEVM does not support unapplied use of Oracle.register.\n" - "Use FATE if you need this.") - , ?AEVM(polymorphic_map_keys, 4, 34, - "Invalid map key type\n" - " 'a\n" - "Map keys cannot be polymorphic in the AEVM. Use FATE if you need this.") - , ?AEVM(higher_order_map_keys, 4, 42, - "Invalid map key type\n" - " (int) => int\n" - "Map keys cannot be higher-order.") - , ?SAME(polymorphic_query_type, 3, 5, + , ?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).") - , ?SAME(polymorphic_response_type, 3, 5, + , ?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).") - , ?SAME(higher_order_query_type, 3, 5, + , ?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).") - , ?SAME(higher_order_response_type, 3, 5, + , ?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).") - , ?AEVM(higher_order_state, 3, 3, - "Invalid state type\n" - " {f : (int) => int}\n" - "The state cannot contain functions in the AEVM. Use FATE if you need this.") - , ?FATE(child_with_decls, 2, 14, + , ?FATE_ERR(child_with_decls, 2, 14, "Missing definition of function 'f'.") ]. @@ -985,7 +903,7 @@ validation_fails() -> "Byte code contract is not payable, but source code contract is.">>]}]. validate(Contract1, Contract2) -> - case compile(fate, Contract1) of + case compile(Contract1) of ByteCode = #{ fate_code := FCode } -> FCode1 = aeb_fate_code:serialize(aeb_fate_code:strip_init_function(FCode)), Source = aeso_test_utils:read_contract(Contract2), @@ -995,7 +913,7 @@ validate(Contract1, Contract2) -> true -> [debug_mode]; false -> [] end ++ - [{backend, fate}, {include, {file_system, [aeso_test_utils:contract_path()]}}]); + [{include, {file_system, [aeso_test_utils:contract_path()]}}]); Error -> print_and_throw(Error) end. diff --git a/test/contracts/Makefile b/test/contracts/Makefile deleted file mode 100644 index 0034194..0000000 --- a/test/contracts/Makefile +++ /dev/null @@ -1,15 +0,0 @@ - -## Requires ocaml >= 4.02, < 4.06 -## and reason-3.0.0 (opam install reason). - -default : voting_test - -%.ml : %.re - refmt -p ml $< > $@ - - -voting_test : rte.ml voting.ml voting_test.ml - ocamlopt -o $@ $^ - -clean : - rm -f *.cmi *.cmx *.ml *.o voting_test diff --git a/test/contracts/abort_test.aes b/test/contracts/abort_test.aes deleted file mode 100644 index 3da5324..0000000 --- a/test/contracts/abort_test.aes +++ /dev/null @@ -1,31 +0,0 @@ -// A simple test of the abort built-in function. - -contract AbortTest = - - record state = { value : int } - - public function init(v : int) = - { value = v } - - // Aborting - public function do_abort(v : int, s : string) : unit = - put_value(v) - revert_abort(s) - - // Accessing the value - public function get_value() = state.value - public function put_value(v : int) = put(state{value = v}) - public function get_values() : list(int) = [state.value] - public function put_values(v : int) = put(state{value = v}) - - // Some basic statistics - public function get_stats(acct : address) = - ( Contract.balance, Chain.balance(acct) ) - - // Abort functions. - private function revert_abort(s : string) = - abort(s) - - // This is still legal but will be stripped out. - // TODO: This function confuses the type inference, so it cannot be present. - //private function abort(s : string) = 42 diff --git a/test/contracts/abort_test_int.aes b/test/contracts/abort_test_int.aes deleted file mode 100644 index ab1e9fe..0000000 --- a/test/contracts/abort_test_int.aes +++ /dev/null @@ -1,27 +0,0 @@ -contract Interface = - function do_abort : (int, string) => unit - function get_value : () => int - function put_value : (int) => unit - function get_values : () => list(int) - function put_values : (int) => unit - -contract AbortTestInt = - - record state = {r : Interface, value : int} - - public function init(r : Interface, value : int) = - {r = r, value = value} - - // Aborting - public function do_abort(v : int, s : string) = - put_value(v) - state.r.do_abort(v + 100, s) - - // Accessing the value - public function put_value(v : int) = put(state{value = v}) - public function get_value() = state.value - public function get_values() : list(int) = - state.value :: state.r.get_values() - public function put_values(v : int) = - put_value(v) - state.r.put_values(v + 1000) diff --git a/test/contracts/channel_env.aes b/test/contracts/channel_env.aes deleted file mode 100644 index e3d5860..0000000 --- a/test/contracts/channel_env.aes +++ /dev/null @@ -1,8 +0,0 @@ -contract ChannelEnv = - public function coinbase() : address = Chain.coinbase - - public function timestamp() : int = Chain.timestamp - - public function block_height() : int = Chain.block_height - - public function difficulty() : int = Chain.difficulty diff --git a/test/contracts/channel_on_chain_contract_name_resolution.aes b/test/contracts/channel_on_chain_contract_name_resolution.aes deleted file mode 100644 index 6171286..0000000 --- a/test/contracts/channel_on_chain_contract_name_resolution.aes +++ /dev/null @@ -1,7 +0,0 @@ -contract ChannelOnChainContractNameResolution = - - public function can_resolve(name: string, key: string) : bool = - switch(AENS.resolve(name, key) : option(string)) - None => false - Some(_address) => true - diff --git a/test/contracts/channel_on_chain_contract_oracle.aes b/test/contracts/channel_on_chain_contract_oracle.aes deleted file mode 100644 index de681aa..0000000 --- a/test/contracts/channel_on_chain_contract_oracle.aes +++ /dev/null @@ -1,51 +0,0 @@ -contract ChannelOnChainContractOracle = - - type query_t = string - type answer_t = string - type oracle_id = oracle(query_t, answer_t) - type query_id = oracle_query(query_t, answer_t) - - record state = { oracle : oracle_id, - question : string, - bets : map(string, address) - } - - - public function init(oracle: oracle_id, question: string) : state = - { oracle = oracle, - question = question, - bets = {} - } - - public stateful function place_bet(answer: string) = - switch(Map.lookup(answer, state.bets)) - None => - put(state{ bets = state.bets{[answer] = Call.caller}}) - "ok" - Some(_value) => - "bet_already_taken" - - public function expiry() = - Oracle.expiry(state.oracle) - - public function query_fee() = - Oracle.query_fee(state.oracle) - - public function get_question(q: query_id) = - Oracle.get_question(state.oracle, q) - - public stateful function resolve(q: query_id) = - switch(Oracle.get_answer(state.oracle, q)) - None => - "no response" - Some(result) => - if(state.question == Oracle.get_question(state.oracle, q)) - switch(Map.lookup(result, state.bets)) - None => - "no winning bet" - Some(winner) => - Chain.spend(winner, Contract.balance) - "ok" - else - "different question" - diff --git a/test/contracts/channel_remote_on_chain_contract_name_resolution.aes b/test/contracts/channel_remote_on_chain_contract_name_resolution.aes deleted file mode 100644 index 8847335..0000000 --- a/test/contracts/channel_remote_on_chain_contract_name_resolution.aes +++ /dev/null @@ -1,9 +0,0 @@ -contract Remote = - function get : () => int - function can_resolve : (string, string) => bool - -contract RemoteCall = - - function remote_resolve(r : Remote, name: string, key: string) : bool = - r.can_resolve(name, key) - diff --git a/test/contracts/chess.aes b/test/contracts/chess.aes deleted file mode 100644 index 571297f..0000000 --- a/test/contracts/chess.aes +++ /dev/null @@ -1,51 +0,0 @@ - -contract Chess = - - type board = map(int, map(int, string)) - type state = board - - private function get_row(r, m : board) = - Map.lookup_default(r, m, {}) - - private function set_piece(r, c, p, m : board) = - m { [r] = get_row(r, m) { [c] = p } } - - private function get_piece(r, c, m : board) = - Map.lookup(c, get_row(r, m)) - - private function from_list(xs, m : board) = - switch(xs) - [] => m - (r, c, p) :: xs => from_list(xs, set_piece(r, c, p, m)) - - function init() = - from_list([ (2, 1, "white pawn"), (7, 1, "black pawn") - , (2, 2, "white pawn"), (7, 2, "black pawn") - , (2, 3, "white pawn"), (7, 3, "black pawn") - , (2, 4, "white pawn"), (7, 4, "black pawn") - , (2, 5, "white pawn"), (7, 5, "black pawn") - , (2, 6, "white pawn"), (7, 6, "black pawn") - , (2, 7, "white pawn"), (7, 7, "black pawn") - , (2, 8, "white pawn"), (7, 8, "black pawn") - , (1, 1, "white rook"), (8, 1, "black rook") - , (1, 2, "white knight"), (8, 2, "black knight") - , (1, 3, "white bishop"), (8, 3, "black bishop") - , (1, 4, "white queen"), (8, 4, "black queen") - , (1, 5, "white king"), (8, 5, "black king") - , (1, 6, "white bishop"), (8, 6, "black bishop") - , (1, 7, "white knight"), (8, 7, "black knight") - , (1, 8, "white rook"), (8, 8, "black rook") - ], {}) - - function piece(r, c) = get_piece(r, c, state) - - function move_piece(r, c, r1, c1) = - switch(piece(r, c)) - Some(p) => put(set_piece(r1, c1, p, state)) - - function destroy_piece(r, c) = - put(state{ [r] = Map.delete(c, get_row(r, state)) }) - - function delete_row(r) = - put(Map.delete(r, state)) - diff --git a/test/contracts/code_errors/unapplied_named_arg_builtin.aes b/test/contracts/code_errors/unapplied_named_arg_builtin.aes index ebd2d1a..8b7f550 100644 --- a/test/contracts/code_errors/unapplied_named_arg_builtin.aes +++ b/test/contracts/code_errors/unapplied_named_arg_builtin.aes @@ -1,5 +1,4 @@ contract UnappliedNamedArgBuiltin = - // Allowed in FATE, but not AEVM stateful entrypoint main_fun(s) = let reg = Oracle.register reg(signature = s, Contract.address, 100, RelativeTTL(100)) : oracle(int, int) diff --git a/test/contracts/contract_types.aes b/test/contracts/contract_types.aes deleted file mode 100644 index 99ecfca..0000000 --- a/test/contracts/contract_types.aes +++ /dev/null @@ -1,20 +0,0 @@ - -contract OtherContract = - - function multiply : (int, int) => int - -contract ThisContract = - - record state = { server : OtherContract, n : int } - - function init(server : OtherContract) = - { server = server, n = 2 } - - function square() = - put(state{ n @ n = state.server.multiply(value = 100, n, n) }) - - function get_n() = state.n - - function tip_server() = - Chain.spend(state.server.address, Call.value) - diff --git a/test/contracts/erc20_token.aes b/test/contracts/erc20_token.aes deleted file mode 100644 index 517b9f4..0000000 --- a/test/contracts/erc20_token.aes +++ /dev/null @@ -1,87 +0,0 @@ -contract ERC20Token = - record state = { - totalSupply : int, - decimals : int, - name : string, - symbol : string, - balances : map(address, int), - allowed : map(address, map(address,int)), - // Logs, remove when native Events are there - transfer_log : list((address,address,int)), - approval_log : list((address,address,int))} - - // init(100000000, 10, "Token Name", "TKN") - public stateful function init(_totalSupply : int, _decimals : int, _name : string, _symbol : string ) = { - totalSupply = _totalSupply, - decimals = _decimals, - name = _name, - symbol = _symbol, - balances = {[Call.caller] = _totalSupply }, // creator gets all Tokens - allowed = {}, - // Logs, remove when native Events are there - transfer_log = [], - approval_log = []} - - public stateful function totalSupply() : int = state.totalSupply - public stateful function decimals() : int = state.decimals - public stateful function name() : string = state.name - public stateful function symbol() : string = state.symbol - - public stateful function balanceOf(tokenOwner : address ) : int = - Map.lookup_default(tokenOwner, state.balances, 0) - - public stateful function transfer(to : address, tokens : int) = - put( state{balances[Call.caller] = sub(state.balances[Call.caller], tokens) }) - put( state{balances[to] = add(Map.lookup_default(to, state.balances, 0), tokens) }) - transferEvent(Call.caller, to, tokens) - true - - public stateful function approve(spender : address, tokens : int) = - // allowed[Call.caller] field must have a value! - ensure_allowed(Call.caller) - put( state{allowed[Call.caller][spender] = tokens} ) - approvalEvent(Call.caller, spender, tokens) - true - - public stateful function transferFrom(from : address, to : address, tokens : int) = - put( state{ balances[from] = sub(state.balances[from], tokens) }) - put( state{ allowed[from][Call.caller] = sub(state.allowed[from][Call.caller], tokens) }) - put( state{ balances[to] = add(balanceOf(to), tokens) }) - transferEvent(from, to, tokens) - true - - public function allowance(_owner : address, _spender : address) : int = - state.allowed[_owner][_spender] - - public stateful function getTransferLog() : list((address,address,int)) = - state.transfer_log - public stateful function getApprovalLog() : list((address,address,int)) = - state.approval_log - - // - // Private Functions - // - - private function ensure_allowed(key : address) = - switch(Map.lookup(key, state.allowed)) - None => put(state{allowed[key] = {}}) - Some(_) => () - - private function transferEvent(from : address, to : address, tokens : int) = - let e = (from, to, tokens) - put( state{transfer_log = e :: state.transfer_log }) - e - - private function approvalEvent(from : address, to : address, tokens : int) = - let e = (from, to, tokens) - put( state{approval_log = e :: state.approval_log }) - e - - private function sub(_a : int, _b : int) : int = - require(_b =< _a, "Error") - _a - _b - - private function add(_a : int, _b : int) : int = - let c : int = _a + _b - require(c >= _a, "Error") - c diff --git a/test/contracts/exploits.aes b/test/contracts/exploits.aes deleted file mode 100644 index bbc16e1..0000000 --- a/test/contracts/exploits.aes +++ /dev/null @@ -1,6 +0,0 @@ - -contract Exploits = - - // We'll hack the bytecode of this changing the return type to string. - function pair(n : int) = (n, 0) - diff --git a/test/contracts/init_error.aes b/test/contracts/init_error.aes deleted file mode 100644 index 9d81a3a..0000000 --- a/test/contracts/init_error.aes +++ /dev/null @@ -1,9 +0,0 @@ -contract Remote = - function missing : (int) => int - -contract Init_error = - - record state = {value : int} - - function init(r : Remote, x : int) = - {value = r.missing(x)} diff --git a/test/contracts/local_poly_fail.aes b/test/contracts/local_poly_fail.aes deleted file mode 100644 index 189ab23..0000000 --- a/test/contracts/local_poly_fail.aes +++ /dev/null @@ -1,7 +0,0 @@ - -contract Fail = - - entrypoint tttt() : bool * int = - let f(x : 'a) : 'a = x - (f(true), f(1)) - diff --git a/test/contracts/map_of_maps.aes b/test/contracts/map_of_maps.aes deleted file mode 100644 index 49599c1..0000000 --- a/test/contracts/map_of_maps.aes +++ /dev/null @@ -1,36 +0,0 @@ - -contract MapOfMaps = - - type board = map(int, map(int, string)) - type map2('a, 'b, 'c) = map('a, map('b, 'c)) - - record state = { big1 : map2(string, string, string), - big2 : map2(string, string, string), - small1 : map(string, string), - small2 : map(string, string) } - - private function empty_state() = - { big1 = {}, big2 = {}, - small1 = {}, small2 = {} } - - function init() = empty_state() - - function setup_state() = - let small = {["key"] = "val"} - put({ big1 = {["one"] = small}, - big2 = {["two"] = small}, - small1 = small, - small2 = small }) - - // -- Garbage collection of inner map when outer map is garbage collected - function test1_setup() = - let inner = {["key"] = "val"} - put(empty_state() { big1 = {["one"] = inner} }) - - function test1_execute() = - put(state{ big1 = {} }) - - function test1_check() = - state.big1 - - diff --git a/test/contracts/maps_benchmark.aes b/test/contracts/maps_benchmark.aes deleted file mode 100644 index fd8204d..0000000 --- a/test/contracts/maps_benchmark.aes +++ /dev/null @@ -1,29 +0,0 @@ - -contract MapUpdater = - function update_map : (int, string, map(int, string)) => map(int, string) - -contract Benchmark = - - record state = { updater : MapUpdater, - map : map(int, string) } - - function init(u, m) = { updater = u, map = m } - - function set_updater(u) = put(state{ updater = u }) - - function update_map(k : int, v : string, m) = m{ [k] = v } - - function update(a : int, b : int, v : string) = - if (a > b) () - else - put(state{ map[a] = v }) - update(a + 1, b, v) - - function get(k) = state.map[k] - function noop() = () - - function benchmark(k, v) = - let m = state.updater.update_map(k, v, state.map) - put(state{ map = m }) - m - diff --git a/test/contracts/minimal_init.aes b/test/contracts/minimal_init.aes deleted file mode 100644 index 28e618a..0000000 --- a/test/contracts/minimal_init.aes +++ /dev/null @@ -1,6 +0,0 @@ -contract MinimalInit = - - record state = {foo : int} - - function init() = - { foo = 0 } diff --git a/test/contracts/multiplication_server.aes b/test/contracts/multiplication_server.aes deleted file mode 100644 index 859cd44..0000000 --- a/test/contracts/multiplication_server.aes +++ /dev/null @@ -1,7 +0,0 @@ - -contract MultiplicationServer = - - function multiply(x : int, y : int) = - switch(Call.value >= 100) - true => x * y - diff --git a/test/contracts/oracles_err.aes b/test/contracts/oracles_err.aes deleted file mode 100644 index 7a5aa22..0000000 --- a/test/contracts/oracles_err.aes +++ /dev/null @@ -1,11 +0,0 @@ -contract OraclesErr = - - public function unsafeCreateQueryThenErr( - o : oracle(string, int), - q : string, - qfee : int, - qttl : Chain.ttl, - rttl : Chain.ttl) : oracle_query(string, int) = - let x = Oracle.query(o, q, qfee, qttl, rttl) - switch(0) 1 => () - x // Never reached. diff --git a/test/contracts/oracles_gas.aes b/test/contracts/oracles_gas.aes deleted file mode 100644 index 87c8b28..0000000 --- a/test/contracts/oracles_gas.aes +++ /dev/null @@ -1,22 +0,0 @@ -contract OraclesGas = - - type fee = int - type question_t = string - type answer_t = int - - public function happyPathWithAllBuiltinsAtSameHeight( - qfee : fee, - ottl : Chain.ttl, - ettl : Chain.ttl, - qttl : Chain.ttl, - rttl : Chain.ttl - ) = - let question = "why" - let answer = 42 - let o = Oracle.register(Contract.address, qfee, ottl) : oracle(question_t, answer_t) - Oracle.extend(o, ettl) - require(qfee =< Call.value, "insufficient value for qfee") - let q = Oracle.query(o, question, qfee, qttl, rttl) - Oracle.respond(o, q, answer) - () - diff --git a/test/contracts/oracles_no_vm.aes b/test/contracts/oracles_no_vm.aes deleted file mode 100644 index 28d3c3f..0000000 --- a/test/contracts/oracles_no_vm.aes +++ /dev/null @@ -1,35 +0,0 @@ -contract Oracles = - - type fee = int - type ttl = Chain.ttl - - type query_t = string - type answer_t = string - - type oracle_id = oracle(query_t, answer_t) - type query_id = oracle_query(query_t, answer_t) - - function createQuery(o : oracle_id, - q : query_t, - qfee : fee, - qttl : ttl, - rttl : ttl) : query_id = - require(qfee =< Call.value, "insufficient value for qfee") - Oracle.query(o, q, qfee, qttl, rttl) - - - function respond(o : oracle_id, - q : query_id, - sign : signature, - r : answer_t) : unit = - Oracle.respond(o, q, signature = sign, r) - - - function getQuestion(o : oracle_id, - q : query_id) : query_t = - Oracle.get_question(o, q) - - function getAnswer(o : oracle_id, - q : query_id) : option(answer_t) = - Oracle.get_answer(o, q) - diff --git a/test/contracts/polymorphism_test.aes b/test/contracts/polymorphism_test.aes deleted file mode 100644 index a6c4c91..0000000 --- a/test/contracts/polymorphism_test.aes +++ /dev/null @@ -1,16 +0,0 @@ - -contract Identity = - - function zip_with(f, xs, ys) = - switch((xs, ys)) - (x :: xs, y :: ys) => f(x, y) :: zip_with(f, xs, ys) - _ => [] - - // Check that we can use zip_with at different types - - function foo() = - zip_with((x, y) => x + y, [1, 2, 3], [4, 5, 6, 7]) - - function bar() = - zip_with((x, y) => if(x) y else 0, [true, false, true, false], [1, 2, 3]) - diff --git a/test/contracts/primitive_map.aes b/test/contracts/primitive_map.aes deleted file mode 100644 index 73c2e41..0000000 --- a/test/contracts/primitive_map.aes +++ /dev/null @@ -1,57 +0,0 @@ - -contract MapServer = - - function insert : (string, string, map(string, string)) => map(string, string) - function delete : (string, map(string, string)) => map(string, string) - -contract PrimitiveMaps = - - record state = { remote : MapServer, - map : map(string, string), - map2 : map(string, string) } - - function init(r) = - let m = {} - { remote = r, map = m, map2 = m } - - function set_remote(r) = put(state{ remote = r }) - - function insert(k, v, m) : map(string, string) = m{ [k] = v } - function delete(k, m) : map(string, string) = Map.delete(k, m) - - function remote_insert(k, v, m) = - state.remote.insert(k, v, m) - - function remote_delete(k, m) = - state.remote.delete(k, m) - - function get_state_map() = state.map - function set_state_map(m) = put(state{ map = m }) - - function clone_state() = put(state{ map2 = state.map }) - - function insert_state(k, v) = put(state{ map @ m = m { [k] = v } }) - function delete_state(k) = put(state{ map @ m = Map.delete(k, m) }) - function lookup_state(k) = Map.lookup(k, state.map) - - function double_insert_state(k, v1, v2) = - put(state{ map @ m = m { [k] = v1 }, - map2 @ m = m { [k] = v2 } }) - - function test() = - let m = {} : map(string, string) - let m1 = m { ["foo"] = "value_of_foo", - ["bla"] = "value_of_bla" } - let m2 = Map.delete("foo", m1) - let m3 = m2 { ["bla"] = "new_value_of_bla" } - [Map.lookup("foo", m), Map.lookup("bla", m), - Map.lookup("foo", m1), Map.lookup("bla", m1), - Map.lookup("foo", m2), Map.lookup("bla", m2), - Map.lookup("foo", m3), Map.lookup("bla", m3)] - - function return_map() = - Map.delete("goo", {["foo"] = "bar", ["goo"] = "gaa"}) - - function argument_map(m : map(string, string)) = - m["foo"] - diff --git a/test/contracts/remote_gas_test.aes b/test/contracts/remote_gas_test.aes deleted file mode 100644 index ee88cf2..0000000 --- a/test/contracts/remote_gas_test.aes +++ /dev/null @@ -1,20 +0,0 @@ -contract Remote1 = - function set : (int) => int - -contract RemoteCall = - record state = { i : int } - - function init(x) = { i = x } - - function set( x : int) : int = - let old = state.i - put(state{ i = x }) - old - - function call(r : Remote1, x : int, g : int) : int = - r.set(gas = g, value = 10, x) - - function get() = state.i - - - diff --git a/test/contracts/remote_state.aes b/test/contracts/remote_state.aes deleted file mode 100644 index c9bfff3..0000000 --- a/test/contracts/remote_state.aes +++ /dev/null @@ -1,23 +0,0 @@ -contract RemoteState = - record rstate = { i : int, s : string, m : map(int, int) } - - function look_at(s : rstate) = () - function return_s(big : bool) = - let x = "short" - let y = "______longer_string_at_least_32_bytes_long___________longer_string_at_least_32_bytes_long___________longer_string_at_least_32_bytes_long_____" - if(big) y else x - function return_m(big : bool) = - let x = { [1] = 2 } - let y = { [1] = 2, [3] = 4, [5] = 6 } - if(big) y else x - - function get(s : rstate) = s - function get_i(s : rstate) = s.i - function get_s(s : rstate) = s.s - function get_m(s : rstate) = s.m - - function fun_update_i(s : rstate, ni) = s{ i = ni } - function fun_update_s(s : rstate, ns) = s{ s = ns } - function fun_update_m(s : rstate, nm) = s{ m = nm } - function fun_update_mk(s : rstate, k, v) = s{ m = s.m{[k] = v} } - diff --git a/test/contracts/remote_type_check.aes b/test/contracts/remote_type_check.aes deleted file mode 100644 index ed62fe9..0000000 --- a/test/contracts/remote_type_check.aes +++ /dev/null @@ -1,22 +0,0 @@ -contract Remote = - function id : ('a) => 'a - function missing : ('a) => 'a - function wrong_type : (string) => string - -contract Main = - - function id(x : int) = - x - - function wrong_type(x : int) = - x - - function remote_id(r : Remote, x) = - r.id(x) - - function remote_missing(r : Remote, x) = - r.missing(x) - - function remote_wrong_type(r : Remote, x) = - r.wrong_type(x) - diff --git a/test/contracts/remote_value_on_err.aes b/test/contracts/remote_value_on_err.aes deleted file mode 100644 index 4a5de6a..0000000 --- a/test/contracts/remote_value_on_err.aes +++ /dev/null @@ -1,21 +0,0 @@ -contract ValueOnErr = - function err : () => int - function ok : () => int - -contract RemoteValueOnErr = - - public function callErr( - r : ValueOnErr, - value : int) : int = - r.err(value = value) - - public function callErrLimitGas( - r : ValueOnErr, - value : int, - gas : int) : int = - r.err(value = value, gas = gas) - - public function callOk( - r : ValueOnErr, - value : int) : int = - r.ok(value = value) diff --git a/test/contracts/test.aes b/test/contracts/test.aes index 2b3783e..ebdd4a2 100644 --- a/test/contracts/test.aes +++ b/test/contracts/test.aes @@ -1,12 +1,4 @@ -// This is a custom test file if you need to run a compiler without -// changing aeso_compiler_tests.erl - -include "List.aes" - -contract IntegerHolder = - type state = int - entrypoint init(x) = x - entrypoint get() = state - -main contract Test = - stateful entrypoint f(c) = Chain.clone(ref=c, 123) \ No newline at end of file +contract ShareTwo = + record state = {s1 : int, s2 : int} + entrypoint init() = {s1 = 0, s2 = 0} + stateful entrypoint buy() = () \ No newline at end of file diff --git a/test/contracts/unapplied_builtins.aes b/test/contracts/unapplied_builtins.aes index 1f2e9ae..169a29b 100644 --- a/test/contracts/unapplied_builtins.aes +++ b/test/contracts/unapplied_builtins.aes @@ -1,4 +1,4 @@ -// Builtins without named arguments can appear unapplied in both AEVM and FATE. +// Builtins without named arguments can appear unapplied. // Named argument builtins are: // Oracle.register // Oracle.respond diff --git a/test/contracts/upfront_charges.aes b/test/contracts/upfront_charges.aes deleted file mode 100644 index 74041d0..0000000 --- a/test/contracts/upfront_charges.aes +++ /dev/null @@ -1,6 +0,0 @@ -contract UpfrontCharges = - record state = { b : int } // For enabling retrieval of sender balance observed inside init. - public function init() : state = { b = b() } - public function initialSenderBalance() : int = state.b - public function senderBalance() : int = b() - private function b() = Chain.balance(Call.origin) diff --git a/test/contracts/value_on_err.aes b/test/contracts/value_on_err.aes deleted file mode 100644 index 43cbb93..0000000 --- a/test/contracts/value_on_err.aes +++ /dev/null @@ -1,7 +0,0 @@ -contract ValueOnErr = - - public function err() : int = - switch(0) 1 => 5 - - public function ok() : int = - 11