Merge pull request #66 from aeternity/PT-166788647-fate-efficient-maps

PT-166788647 FATE efficient maps
This commit is contained in:
Ulf Norell 2019-08-13 15:51:13 +02:00 committed by GitHub
commit af6224cb3b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 247 additions and 15 deletions

View File

@ -5,6 +5,7 @@
-define(FATE_LIST_T, list()). -define(FATE_LIST_T, list()).
-define(FATE_UNIT_T, {tuple, {}}). -define(FATE_UNIT_T, {tuple, {}}).
-define(FATE_MAP_T, #{ fate_type() => fate_type() }). -define(FATE_MAP_T, #{ fate_type() => fate_type() }).
-define(FATE_STORE_MAP_T, {store_map, #{ fate_type() => fate_type() | ?FATE_MAP_TOMBSTONE }, integer()}).
-define(FATE_STRING_T, binary()). -define(FATE_STRING_T, binary()).
-define(FATE_ADDRESS_T, {address, <<_:256>>}). -define(FATE_ADDRESS_T, {address, <<_:256>>}).
-define(FATE_BYTES_T(N), {bytes, binary()}). -define(FATE_BYTES_T(N), {bytes, binary()}).
@ -20,6 +21,10 @@
-define(IS_FATE_INTEGER(X), (is_integer(X))). -define(IS_FATE_INTEGER(X), (is_integer(X))).
-define(IS_FATE_LIST(X), (is_list(X))). -define(IS_FATE_LIST(X), (is_list(X))).
-define(IS_FATE_STRING(X), (is_binary(X))). -define(IS_FATE_STRING(X), (is_binary(X))).
-define(IS_FATE_STORE_MAP(X), (is_tuple(X) andalso tuple_size(X) == 3
andalso store_map == element(1, X)
andalso is_map(element(2, X))
andalso is_integer(element(3, X)))).
-define(IS_FATE_MAP(X), (is_map(X))). -define(IS_FATE_MAP(X), (is_map(X))).
-define(IS_FATE_TUPLE(X), (is_tuple(X) andalso (tuple == element(1, X) andalso is_tuple(element(2, X))))). -define(IS_FATE_TUPLE(X), (is_tuple(X) andalso (tuple == element(1, X) andalso is_tuple(element(2, X))))).
-define(IS_FATE_ADDRESS(X), (is_tuple(X) andalso (address == element(1, X) andalso is_binary(element(2, X))))). -define(IS_FATE_ADDRESS(X), (is_tuple(X) andalso (address == element(1, X) andalso is_binary(element(2, X))))).
@ -50,6 +55,8 @@
-define(FATE_CHANNEL(X), {channel, X}). -define(FATE_CHANNEL(X), {channel, X}).
-define(FATE_BITS(B), {bits, B}). -define(FATE_BITS(B), {bits, B}).
-define(FATE_TYPEREP(T), {typerep, T}). -define(FATE_TYPEREP(T), {typerep, T}).
-define(FATE_STORE_MAP(Cache, Id), {store_map, Cache, Id}).
-define(FATE_MAP_TOMBSTONE, '__DELETED__').
-define(FATE_INTEGER_VALUE(X), (X)). -define(FATE_INTEGER_VALUE(X), (X)).
-define(FATE_BOOLEAN_VALUE(X), (X)). -define(FATE_BOOLEAN_VALUE(X), (X)).
@ -63,6 +70,8 @@
-define(FATE_CHANNEL_VALUE(X), (element(2, X))). -define(FATE_CHANNEL_VALUE(X), (element(2, X))).
-define(FATE_BITS_VALUE(X), (element(2, X))). -define(FATE_BITS_VALUE(X), (element(2, X))).
-define(FATE_MAP_VALUE(X), (X)). -define(FATE_MAP_VALUE(X), (X)).
-define(FATE_STORE_MAP_CACHE(X), (element(2, X))).
-define(FATE_STORE_MAP_ID(X), (element(3, X))).
-define(FATE_MAP_SIZE(X), (map_size(X))). -define(FATE_MAP_SIZE(X), (map_size(X))).
-define(FATE_STRING_SIZE(X), (byte_size(X))). -define(FATE_STRING_SIZE(X), (byte_size(X))).
-define(FATE_TRUE, true). -define(FATE_TRUE, true).

View File

@ -10,6 +10,7 @@
-type fate_list() :: ?FATE_LIST_T. -type fate_list() :: ?FATE_LIST_T.
-type fate_unit() :: ?FATE_UNIT_T. -type fate_unit() :: ?FATE_UNIT_T.
-type fate_map() :: ?FATE_MAP_T. -type fate_map() :: ?FATE_MAP_T.
-type fate_store_map() :: ?FATE_STORE_MAP_T.
-type fate_string() :: ?FATE_STRING_T. -type fate_string() :: ?FATE_STRING_T.
-type fate_address() :: ?FATE_ADDRESS_T. -type fate_address() :: ?FATE_ADDRESS_T.
-type fate_hash() :: ?FATE_BYTES_T(32). -type fate_hash() :: ?FATE_BYTES_T(32).
@ -71,6 +72,7 @@
, fate_channel/0 , fate_channel/0
, fate_variant/0 , fate_variant/0
, fate_map/0 , fate_map/0
, fate_store_map/0
, fate_bits/0 , fate_bits/0
, fate_type_type/0 , fate_type_type/0
]). ]).
@ -82,6 +84,8 @@
, make_tuple/1 , make_tuple/1
, make_string/1 , make_string/1
, make_map/1 , make_map/1
, make_store_map/1
, make_store_map/2
, make_address/1 , make_address/1
, make_bytes/1 , make_bytes/1
, make_hash/1 , make_hash/1
@ -108,6 +112,8 @@ make_list(L) -> ?MAKE_FATE_LIST(L).
make_unit() -> ?FATE_UNIT. make_unit() -> ?FATE_UNIT.
make_tuple(T) -> ?FATE_TUPLE(T). make_tuple(T) -> ?FATE_TUPLE(T).
make_map(M) -> ?MAKE_FATE_MAP(M). make_map(M) -> ?MAKE_FATE_MAP(M).
make_store_map(Id) -> make_store_map(#{}, Id).
make_store_map(Cache, Id) -> ?FATE_STORE_MAP(Cache, Id).
make_address(X) -> ?FATE_ADDRESS(X). make_address(X) -> ?FATE_ADDRESS(X).
make_bytes(X) -> ?FATE_BYTES(X). make_bytes(X) -> ?FATE_BYTES(X).
make_hash(X) -> make_bytes(X). make_hash(X) -> make_bytes(X).

View File

@ -93,6 +93,7 @@
%% %% 1000 1111 - FREE (Possibly for bytecode in the future.) %% %% 1000 1111 - FREE (Possibly for bytecode in the future.)
-define(OBJECT , 2#10011111). %% 1001 1111 | ObjectType | RLP encoded Array -define(OBJECT , 2#10011111). %% 1001 1111 | ObjectType | RLP encoded Array
-define(VARIANT , 2#10101111). %% 1010 1111 | [encoded arities] | encoded tag | [encoded values] -define(VARIANT , 2#10101111). %% 1010 1111 | [encoded arities] | encoded tag | [encoded values]
-define(MAP_ID , 2#10111111). %% 1011 1111 | RLP encoded integer (store map id)
-define(NEG_BITS , 2#11001111). %% 1100 1111 | RLP encoded integer (infinite 1:s bitfield) -define(NEG_BITS , 2#11001111). %% 1100 1111 | RLP encoded integer (infinite 1:s bitfield)
-define(EMPTY_MAP , 2#11011111). %% 1101 1111 -define(EMPTY_MAP , 2#11011111). %% 1101 1111
-define(NEG_BIG_INT , 2#11101111). %% 1110 1111 | RLP encoded (integer - 64) -define(NEG_BIG_INT , 2#11101111). %% 1110 1111 | RLP encoded (integer - 64)
@ -193,6 +194,9 @@ serialize(Map) when ?IS_FATE_MAP(Map) ->
<<?MAP, <<?MAP,
(rlp_encode_int(Size))/binary, (rlp_encode_int(Size))/binary,
(Elements)/binary>>; (Elements)/binary>>;
serialize(?FATE_STORE_MAP(Cache, Id)) when Cache =:= #{} ->
%% We should never get to serialization without having flushed the caches.
<<?MAP_ID, (rlp_encode_int(Id))/binary>>;
serialize(?FATE_VARIANT(Arities, Tag, Values)) -> serialize(?FATE_VARIANT(Arities, Tag, Values)) ->
Arities = [A || A <- Arities, is_integer(A), A < 256], Arities = [A || A <- Arities, is_integer(A), A < 256],
Size = length(Arities), Size = length(Arities),
@ -426,6 +430,9 @@ deserialize2(<<?MAP, Rest/binary>>) ->
false -> false ->
error({unknown_map_serialization_format, KVList}) error({unknown_map_serialization_format, KVList})
end; end;
deserialize2(<<?MAP_ID, Rest/binary>>) ->
{Id, Rest1} = rlp_decode_int(Rest),
{?FATE_STORE_MAP(#{}, Id), Rest1};
deserialize2(<<?VARIANT, Rest/binary>>) -> deserialize2(<<?VARIANT, Rest/binary>>) ->
{AritiesBin, <<Tag:8, Rest2/binary>>} = aeser_rlp:decode_one(Rest), {AritiesBin, <<Tag:8, Rest2/binary>>} = aeser_rlp:decode_one(Rest),
Arities = binary_to_list(AritiesBin), Arities = binary_to_list(AritiesBin),

View File

@ -46,11 +46,11 @@ ops_defs() ->
[ { 'RETURN', 16#00, true, true, true, 2, [], return, {}, any, "Return from function call, top of stack is return value . The type of the retun value has to match the return type of the function."} [ { 'RETURN', 16#00, true, true, true, 2, [], return, {}, any, "Return from function call, top of stack is return value . The type of the retun value has to match the return type of the function."}
, { 'RETURNR', 16#01, true, true, true, 2, [a], returnr, {any}, any, "Push Arg0 and return from function. The type of the retun value has to match the return type of the function."} , { 'RETURNR', 16#01, true, true, true, 2, [a], returnr, {any}, any, "Push Arg0 and return from function. The type of the retun value has to match the return type of the function."}
, { 'CALL', 16#02, true, true, true, 4, [a], call, {string}, any, "Call the function Arg0 with args on stack. The types of the arguments has to match the argument typs of the function."} , { 'CALL', 16#02, true, true, true, 4, [a], call, {string}, any, "Call the function Arg0 with args on stack. The types of the arguments has to match the argument typs of the function."}
, { 'CALL_R', 16#03, true, false, true, 8, [a,is,a], call_r, {contract, string, integer}, any, "Remote call to contract Arg0 and function Arg1 with value Arg2. The types of the arguments has to match the argument typs of the function."} , { 'CALL_R', 16#03, true, false, true, 8, [a,is,ii,a], call_r, {contract, string, integer, integer}, any, "Remote call to contract Arg0 and Arg2-ary function Arg1 with value Arg3. The types of the arguments has to match the argument typs of the function."}
, { 'CALL_T', 16#04, true, true, true, 4, [a], call_t, {string}, any, "Tail call to function Arg0. The types of the arguments has to match the argument typs of the function. And the return type of the called function has to match the type of the current function."} , { 'CALL_T', 16#04, true, true, true, 4, [a], call_t, {string}, any, "Tail call to function Arg0. The types of the arguments has to match the argument typs of the function. And the return type of the called function has to match the type of the current function."}
, { 'CALL_TR', 16#05, true, false, true, 8, [a,is,a], call_tr, {contract, string, integer}, any, "Remote tail call to contract Arg0 and function Arg1 with value Arg2. The types of the arguments has to match the argument typs of the function. And the return type of the called function has to match the type of the current function."} , { 'UNUSED_1', 16#05, false, false, true, 8, [], unused_1, {}, none, "Was CALL_TR."}
, { 'CALL_GR', 16#06, true, false, true, 8, [a,is,a,a], call_gr, {contract, string, integer, integer}, any, "Remote call with gas cap in Arg3. Otherwise as CALL_R."} , { 'CALL_GR', 16#06, true, false, true, 8, [a,is,ii,a,a], call_gr, {contract, string, integer, integer, integer}, any, "Remote call with gas cap in Arg3. Otherwise as CALL_R."}
, { 'CALL_GTR', 16#07, true, false, true, 8, [a,is,a,a], call_gtr, {contract, string, integer, integer}, any, "Remote tail call with gas cap in Arg3. Otherwise as CALL_TR."} , { 'UNUSED_2', 16#07, false, false, true, 8, [], unused_2, {}, none, "Was CALL_GTR."}
, { 'JUMP', 16#08, true, true, true, 3, [ii], jump, {integer}, none, "Jump to a basic block. The basic block has to exist in the current function."} , { 'JUMP', 16#08, true, true, true, 3, [ii], jump, {integer}, none, "Jump to a basic block. The basic block has to exist in the current function."}
, { 'JUMPIF', 16#09, true, true, true, 4, [a,ii], jumpif, {boolean, integer}, none, "Conditional jump to a basic block. If Arg0 then jump to Arg1."} , { 'JUMPIF', 16#09, true, true, true, 4, [a,ii], jumpif, {boolean, integer}, none, "Conditional jump to a basic block. If Arg0 then jump to Arg1."}
, { 'SWITCH_V2', 16#0a, true, true, true, 4, [a,ii,ii], switch, {variant, integer, ingeger}, none, "Conditional jump to a basic block on variant tag."} , { 'SWITCH_V2', 16#0a, true, true, true, 4, [a,ii,ii], switch, {variant, integer, ingeger}, none, "Conditional jump to a basic block on variant tag."}
@ -488,25 +488,29 @@ gen_asm_pp(Module, Path, Ops) ->
io:format(File, "format_op(Op, _Symbols) -> io_lib:format(\";; Bad Op: ~~w\\n\", [Op]).\n", []), io:format(File, "format_op(Op, _Symbols) -> io_lib:format(\";; Bad Op: ~~w\\n\", [Op]).\n", []),
file:close(File). file:close(File).
gen_format(#{opname := Name}) when (Name =:= 'CALL_R') or (Name =:= 'CALL_TR') -> gen_format(#{opname := Name}) when (Name =:= 'CALL_R') ->
io_lib:format("format_op({~w, {immediate, Contract}, {immediate, Function}, Value}, Symbols) ->\n" io_lib:format("format_op({~w, {immediate, Contract}, {immediate, Function}, Arity, Value}, Symbols) ->\n"
" [\"~s \", lookup(Contract, Symbols), \".\", " " [\"~s \", lookup(Contract, Symbols), \".\", "
"lookup(Function, Symbols), \" \", " "lookup(Function, Symbols), \" \", "
"format_arg(a, Arity), \" \", "
"format_arg(a, Value)];\n" "format_arg(a, Value)];\n"
"format_op({~w, Contract, {immediate, Function}, Value}, Symbols) ->\n" "format_op({~w, Contract, {immediate, Function}, Arity, Value}, Symbols) ->\n"
"[\"~s \", format_arg(a, Contract), \".\", " "[\"~s \", format_arg(a, Contract), \".\", "
"lookup(Function, Symbols), \" \", " "lookup(Function, Symbols), \" \", "
"format_arg(a, Arity), \" \", "
"format_arg(a, Value)];\n", "format_arg(a, Value)];\n",
[Name, atom_to_list(Name), Name, atom_to_list(Name)]); [Name, atom_to_list(Name), Name, atom_to_list(Name)]);
gen_format(#{opname := Name}) when (Name =:= 'CALL_GR') or (Name =:= 'CALL_GTR') -> gen_format(#{opname := Name}) when (Name =:= 'CALL_GR') ->
io_lib:format("format_op({~w, {immediate, Contract}, {immediate, Function}, Value, Gas}, Symbols) ->\n" io_lib:format("format_op({~w, {immediate, Contract}, {immediate, Function}, Arity, Value, Gas}, Symbols) ->\n"
" [\"~s \", lookup(Contract, Symbols), \".\", " " [\"~s \", lookup(Contract, Symbols), \".\", "
"lookup(Function, Symbols), \" \", " "lookup(Function, Symbols), \" \", "
"format_arg(a, Arity), \" \", "
"format_arg(a, Value), \" \", " "format_arg(a, Value), \" \", "
"format_arg(a, Gas)];\n" "format_arg(a, Gas)];\n"
"format_op({~w, Contract, {immediate, Function}, Value, Gas}, Symbols) ->\n" "format_op({~w, Contract, {immediate, Function}, Arity, Value, Gas}, Symbols) ->\n"
"[\"~s \", format_arg(a, Contract), \".\", " "[\"~s \", format_arg(a, Contract), \".\", "
"lookup(Function, Symbols), \" \", " "lookup(Function, Symbols), \" \", "
"format_arg(a, Arity), \" \", "
"format_arg(a, Value), \" \", " "format_arg(a, Value), \" \", "
"format_arg(a, Gas)];\n", "format_arg(a, Gas)];\n",
[Name, atom_to_list(Name), Name, atom_to_list(Name)]); [Name, atom_to_list(Name), Name, atom_to_list(Name)]);

210
src/aeb_fate_maps.erl Normal file
View File

@ -0,0 +1,210 @@
%%%-------------------------------------------------------------------
%%% @copyright (C) 2019, Aeternity Anstalt
%%% @doc
%%% Functions for manipulating FATE maps. In particular for mediating
%%% between plain map values (represented by Erlang maps) and maps that are
%%% fully or partially saved in the contract store.
%%% @end
%%% -------------------------------------------------------------------
-module(aeb_fate_maps).
-include("aeb_fate_data.hrl").
-export([ allocate_store_maps/2
, has_store_maps/1
, unfold_store_maps/2
, refcount/1
, refcount_zero/0
, refcount_diff/2
, refcount_union/1
, refcount_union/2
, no_used_ids/0 ]).
-export_type([used_ids/0, maps/0, refcount/0]).
%% Size in bytes of serialization of a map for which we turn it into a store
%% map. It's not worth turning small maps into store maps.
%% Under consensus!
-define(STORE_MAP_THRESHOLD, 500).
-type fate_value() :: aeb_fate_data:fate_type().
-type id() :: integer().
-type used_ids() :: list(id()).
-type maps() :: #{ id() => aeb_fate_data:fate_map() | aeb_fate_data:fate_store_map() }.
%% -- Allocating store maps --------------------------------------------------
-spec allocate_store_maps(used_ids(), [fate_value()]) -> {[fate_value()], maps()}.
allocate_store_maps(Used, Vals) ->
{_Used, Vals1, Maps} = allocate_store_maps_l(Used, Vals, #{}),
{Vals1, Maps}.
allocate_store_maps(Used, ?FATE_TRUE = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_FALSE = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_UNIT = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_BITS(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_BYTES(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_ADDRESS(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_CONTRACT(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_ORACLE(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_ORACLE_Q(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_CHANNEL(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_TYPEREP(_) = Val, Maps) -> {Used, Val, Maps};
allocate_store_maps(Used, Val, Maps) when ?IS_FATE_INTEGER(Val) -> {Used, Val, Maps};
allocate_store_maps(Used, Val, Maps) when ?IS_FATE_STRING(Val) -> {Used, Val, Maps};
allocate_store_maps(Used, ?FATE_TUPLE(Val), Maps) ->
{Used1, Vals, Maps1} = allocate_store_maps_l(Used, tuple_to_list(Val), Maps),
{Used1, ?FATE_TUPLE(list_to_tuple(Vals)), Maps1};
allocate_store_maps(Used, Val, Maps) when ?IS_FATE_LIST(Val) ->
{Used1, Vals, Maps1} = allocate_store_maps_l(Used, ?FATE_LIST_VALUE(Val), Maps),
{Used1, ?MAKE_FATE_LIST(Vals), Maps1};
allocate_store_maps(Used, ?FATE_VARIANT(Arities, Tag, Vals), Maps) ->
{Used1, Vals1, Maps1} = allocate_store_maps_l(Used, tuple_to_list(Vals), Maps),
{Used1, ?FATE_VARIANT(Arities, Tag, list_to_tuple(Vals1)), Maps1};
allocate_store_maps(Used, Val, Maps) when ?IS_FATE_MAP(Val) ->
{Used1, KVs, Maps1} = allocate_store_maps_m(Used, ?FATE_MAP_VALUE(Val), Maps),
Val1 = ?MAKE_FATE_MAP(KVs),
case byte_size(aeb_fate_encoding:serialize(Val1)) < ?STORE_MAP_THRESHOLD of
true -> {Used1, Val1, Maps1};
false ->
{Id, Used2} = next_id(Used1),
{Used2, ?FATE_STORE_MAP(#{}, Id), Maps1#{Id => Val1}}
end;
allocate_store_maps(Used, ?FATE_STORE_MAP(Cache, _Id) = Val, Maps) when Cache =:= #{} ->
{Used, Val, Maps};
allocate_store_maps(Used, ?FATE_STORE_MAP(Cache, Id), Maps) ->
{NewId, Used1} = next_id(Used),
{Used1, Cache1, Maps1} = allocate_store_maps_m(Used1, Cache, Maps),
{Used1, ?FATE_STORE_MAP(#{}, NewId), Maps1#{NewId => ?FATE_STORE_MAP(Cache1, Id)}}.
allocate_store_maps_l(Used, [], Maps) -> {Used, [], Maps};
allocate_store_maps_l(Used, [H | T], Maps) ->
{Used1, H1, Maps1} = allocate_store_maps(Used, H, Maps),
{Used2, T1, Maps2} = allocate_store_maps(Used1, T, Maps1),
{Used2, [H1 | T1], Maps2}.
allocate_store_maps_m(Used, Val, Maps) ->
maps:fold(fun(K, V, {Us, M, Ms}) ->
{Us1, V1, Ms1} = allocate_store_maps(Us, V, Ms),
{Us1, M#{ K => V1 }, Ms1}
end, {Used, #{}, Maps}, Val).
%% -- Unfolding store maps ---------------------------------------------------
-type unfold_fun() :: fun((id()) -> aeb_fate_data:fate_map()).
-spec unfold_store_maps(unfold_fun(), fate_value()) -> fate_value().
unfold_store_maps(_Unfold, ?FATE_TRUE = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_FALSE = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_UNIT = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_BITS(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_BYTES(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_ADDRESS(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_CONTRACT(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_ORACLE(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_ORACLE_Q(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_CHANNEL(_) = Val) -> Val;
unfold_store_maps(_Unfold, ?FATE_TYPEREP(_) = Val) -> Val;
unfold_store_maps(_Unfold, Val) when ?IS_FATE_INTEGER(Val) -> Val;
unfold_store_maps(_Unfold, Val) when ?IS_FATE_STRING(Val) -> Val;
unfold_store_maps(Unfold, ?FATE_TUPLE(Val)) ->
Vals = unfold_store_maps_l(Unfold, tuple_to_list(Val)),
?FATE_TUPLE(list_to_tuple(Vals));
unfold_store_maps(Unfold, Val) when ?IS_FATE_LIST(Val) ->
?MAKE_FATE_LIST(unfold_store_maps_l(Unfold, ?FATE_LIST_VALUE(Val)));
unfold_store_maps(Unfold, ?FATE_VARIANT(Arities, Tag, Vals)) ->
Vals1 = unfold_store_maps_l(Unfold, tuple_to_list(Vals)),
?FATE_VARIANT(Arities, Tag, list_to_tuple(Vals1));
unfold_store_maps(Unfold, Val) when ?IS_FATE_MAP(Val) ->
?MAKE_FATE_MAP(unfold_store_maps_m(Unfold, ?FATE_MAP_VALUE(Val)));
unfold_store_maps(Unfold, ?FATE_STORE_MAP(Cache, Id)) ->
StoreMap = Unfold(Id),
maps:fold(fun write_cache/3, unfold_store_maps(Unfold, StoreMap), Cache).
unfold_store_maps_l(Unfold, Vals) ->
[ unfold_store_maps(Unfold, Val) || Val <- Vals ].
unfold_store_maps_m(Unfold, Val) ->
maps:map(fun(_, V) -> unfold_store_maps(Unfold, V) end, Val).
write_cache(Key, ?FATE_MAP_TOMBSTONE, Map) ->
maps:remove(Key, Map);
write_cache(Key, Val, Map) ->
Map#{ Key => Val }.
%% -- Reference counting -----------------------------------------------------
-type refcount() :: #{id() => pos_integer()}.
-spec refcount_zero() -> refcount().
refcount_zero() -> #{}.
-spec refcount_diff(refcount(), refcount()) -> refcount().
refcount_diff(New, Old) ->
maps:fold(fun(K, N, C) -> maps:update_with(K, fun(M) -> M - N end, -N, C) end,
New, Old).
-spec refcount_union([refcount()]) -> refcount().
refcount_union(Counts) -> lists:foldl(fun refcount_union/2, #{}, Counts).
-spec refcount_union(refcount(), refcount()) -> refcount().
refcount_union(A, B) ->
maps:fold(fun(K, N, C) -> maps:update_with(K, fun(M) -> M + N end, N, C) end,
B, A).
-spec has_store_maps(fate_value()) -> boolean().
has_store_maps(Val) ->
refcount_zero() /= refcount(Val).
-spec refcount(fate_value()) -> refcount().
refcount(Val) -> refcount(Val, #{}).
-spec refcount(fate_value(), refcount()) -> refcount().
refcount(?FATE_MAP_TOMBSTONE, Count) -> Count;
refcount(?FATE_TRUE, Count) -> Count;
refcount(?FATE_FALSE, Count) -> Count;
refcount(?FATE_UNIT, Count) -> Count;
refcount(?FATE_BITS(_), Count) -> Count;
refcount(?FATE_BYTES(_), Count) -> Count;
refcount(?FATE_ADDRESS(_), Count) -> Count;
refcount(?FATE_CONTRACT(_), Count) -> Count;
refcount(?FATE_ORACLE(_), Count) -> Count;
refcount(?FATE_ORACLE_Q(_), Count) -> Count;
refcount(?FATE_CHANNEL(_), Count) -> Count;
refcount(?FATE_TYPEREP(_), Count) -> Count;
refcount(Val, Count) when ?IS_FATE_INTEGER(Val) -> Count;
refcount(Val, Count) when ?IS_FATE_STRING(Val) -> Count;
refcount(?FATE_TUPLE(Val), Count) ->
refcount_l(tuple_to_list(Val), Count);
refcount(Val, Count) when ?IS_FATE_LIST(Val) ->
refcount_l(?FATE_LIST_VALUE(Val), Count);
refcount(?FATE_VARIANT(_Arities, _Tag, Vals), Count) ->
refcount_l(tuple_to_list(Vals), Count);
refcount(Val, Count) when ?IS_FATE_MAP(Val) ->
refcount_m(?FATE_MAP_VALUE(Val), Count);
refcount(?FATE_STORE_MAP(Cache, Id), Count) ->
refcount_m(Cache, maps:update_with(Id, fun(N) -> N + 1 end, 1, Count)).
refcount_l(Vals, Count) ->
lists:foldl(fun refcount/2, Count, Vals).
refcount_m(Val, Count) ->
%% No maps in map keys
maps:fold(fun(_, ?FATE_MAP_TOMBSTONE, C) -> C;
(_, V, C) -> refcount(V, C) end, Count, Val).
%% -- Map id allocation ------------------------------------------------------
-spec no_used_ids() -> used_ids().
no_used_ids() -> [].
-spec next_id(used_ids()) -> {id(), used_ids()}.
next_id(UsedIds) ->
next_id(UsedIds, 0, []).
next_id(Used, J, Acc) when Used == []; J < hd(Used) ->
{J, lists:reverse(Acc) ++ [J | Used]};
next_id([I | Used], I, Acc) ->
next_id(Used, I + 1, [I | Acc]);
next_id([I | Used], J, Acc) when J > I ->
next_id(Used, J, [I | Acc]).

View File

@ -30,14 +30,10 @@ FUNCTION tailcall(integer) -> integer
FUNCTION remote_call(integer) : integer FUNCTION remote_call(integer) : integer
PUSH arg0 PUSH arg0
CALL_R remote.add_five 0 CALL_R remote.add_five 1 0
INCA INCA
RETURN RETURN
FUNCTION remote_tailcall(integer) : integer
PUSH arg0
CALL_TR remote add_five 0
;; Test the code from the shell ;; Test the code from the shell
;; _build/default/rel/aessembler/bin/aessembler console ;; _build/default/rel/aessembler/bin/aessembler console