QPQ-AG/sophia
11
0
Fork 0
Code Issues 43 Pull Requests 7 Actions Packages Projects Releases 16 Wiki Activity

add compiler function to translate a vm value to Sophia AST

Browse Source
This commit is contained in:
Ulf Norell
2019-02-25 13:44:23 +01:00
parent 202a06a580
commit ccad660eac
2 changed files with 135 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/aeso_compiler.erl
+114 -1
View File
@@ -15,6 +15,8 @@
, create_calldata/3
, version/0
, sophia_type_to_typerep/1
, to_sophia_value/2
, to_sophia_value/3
]).
-include_lib("aebytecode/include/aeb_opcodes.hrl").
@@ -101,7 +103,8 @@ join_errors(Prefix, Errors, Pfun) ->
Ess = [ Pfun(E) || E <- Errors ],
list_to_binary(string:join([Prefix|Ess], "\n")).
-define(CALL_NAME, "__call").
-define(CALL_NAME, "__call").
-define(DECODE_NAME, "__decode").
%% Takes a string containing a contract with a declaration/prototype of a
%% function (foo, say) and a function __call() = foo(args) calling this
@@ -142,6 +145,100 @@ check_call(ContractString, Options) ->
fun (E) -> io_lib:format("~p", [E]) end)}
end.
-spec to_sophia_value(string(), aeso_sophia:data()) ->
{ok, aeso_syntax:expr()} | {error, term()}.
to_sophia_value(ContractString, Data) ->
to_sophia_value(ContractString, Data, []).
-spec to_sophia_value(string(), aeso_sophia:data(), options()) ->
{ok, aeso_syntax:expr()} | {error, term()}.
to_sophia_value(ContractString, Data, Options) ->
try
Ast = parse(ContractString, Options),
ok = pp_sophia_code(Ast, Options),
ok = pp_ast(Ast, Options),
{Env, TypedAst} = aeso_ast_infer_types:infer(Ast, [return_env]),
{ok, Type0} = get_decode_type(TypedAst),
Type = aeso_ast_infer_types:unfold_types_in_type(Env, Type0, [unfold_record_types, unfold_variant_types]),
ok = pp_typed_ast(TypedAst, Options),
Icode = to_icode(TypedAst, Options),
{ok, VmType} = get_decode_vm_type(Icode),
ok = pp_icode(Icode, Options),
try
{ok, translate_vm_value(VmType, Type, Data)}
catch throw:cannot_translate_to_sophia ->
Type0Str = prettypr:format(aeso_pretty:type(Type0)),
{error, join_errors("Translation error", [io_lib:format("Cannot translate VM value ~p\n of type ~p\n to Sophia type ~s\n",
[Data, VmType, Type0Str])],
fun (E) -> E end)}
end
catch
error:{parse_errors, Errors} ->
{error, join_errors("Parse errors", Errors, fun (E) -> E end)};
error:{type_errors, Errors} ->
{error, join_errors("Type errors", Errors, fun (E) -> E end)};
error:{badmatch, {error, missing_decode_function}} ->
{error, join_errors("Type errors", ["missing __decode function"],
fun (E) -> E end)};
throw:Error -> %Don't ask
{error, join_errors("Code errors", [Error],
fun (E) -> io_lib:format("~p", [E]) end)}
end.
address_literal(N) -> {hash, [], <<N:256>>}. % TODO
%% TODO: somewhere else
translate_vm_value(word, {id, _, "address"}, N) -> address_literal(N);
translate_vm_value(word, {app_t, _, {id, _, "oracle"}, _}, N) -> address_literal(N);
translate_vm_value(word, {app_t, _, {id, _, "oracle_query"}, _}, N) -> address_literal(N);
translate_vm_value(word, {id, _, "hash"}, N) -> {hash, [], <<N:256>>};
translate_vm_value(word, {id, _, "int"}, N) -> {int, [], N};
translate_vm_value(word, {id, _, "bits"}, N) -> error({todo, bits, N});
translate_vm_value(word, {id, _, "bool"}, N) -> {bool, [], N /= 0};
translate_vm_value({tuple, [word, word]}, {id, _, "signature"}, {tuple, [Hi, Lo]}) ->
{hash, [], <<Hi:256, Lo:256>>};
translate_vm_value(string, {id, _, "string"}, S) -> {string, [], S};
translate_vm_value({list, VmType}, {app_t, _, {id, _, "list"}, [Type]}, List) ->
{list, [], [translate_vm_value(VmType, Type, X) || X <- List]};
translate_vm_value({option, VmType}, {app_t, _, {id, _, "option"}, [Type]}, Val) ->
case Val of
none -> {con, [], "None"};
{some, X} -> {app, [], {con, [], "Some"}, [translate_vm_value(VmType, Type, X)]}
end;
translate_vm_value({variant, [[], [VmType]]}, {app_t, _, {id, _, "option"}, [Type]}, Val) ->
case Val of
{variant, 0, []} -> {con, [], "None"};
{variant, 1, [X]} -> {app, [], {con, [], "Some"}, [translate_vm_value(VmType, Type, X)]}
end;
translate_vm_value({tuple, VmTypes}, {tuple_t, _, Types}, Val)
when length(VmTypes) == length(Types),
length(VmTypes) == tuple_size(Val) ->
{tuple, [], [translate_vm_value(VmType, Type, X)
|| {VmType, Type, X} <- lists:zip3(VmTypes, Types, tuple_to_list(Val))]};
translate_vm_value({tuple, VmTypes}, {record_t, Fields}, Val)
when length(VmTypes) == length(Fields),
length(VmTypes) == tuple_size(Val) ->
{record, [], [ {field, [], [{proj, [], FName}], translate_vm_value(VmType, FType, X)}
|| {VmType, {field_t, _, FName, FType}, X} <- lists:zip3(VmTypes, Fields, tuple_to_list(Val)) ]};
translate_vm_value({map, VmKeyType, VmValType}, {app_t, _, {id, _, "map"}, [KeyType, ValType]}, Map)
when is_map(Map) ->
{map, [], [ {translate_vm_value(VmKeyType, KeyType, Key),
translate_vm_value(VmValType, ValType, Val)}
|| {Key, Val} <- maps:to_list(Map) ]};
translate_vm_value({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),
translate_vm_value(VmTypes, ConType, Args);
translate_vm_value(VmTypes, {constr_t, _, Con, Types}, Args)
when length(VmTypes) == length(Types),
length(VmTypes) == length(Args) ->
{app, [], Con, [ translate_vm_value(VmType, Type, Arg)
|| {VmType, Type, Arg} <- lists:zip3(VmTypes, Types, Args) ]};
translate_vm_value(_VmType, _Type, _Data) ->
throw(cannot_translate_to_sophia).
-spec create_calldata(map(), string(), string()) ->
{ok, binary(), aeso_sophia:type(), aeso_sophia:type()}
| {error, argument_syntax_error}.
@@ -189,6 +286,22 @@ get_call_type([_ | Contracts]) ->
%% The __call should be in the final contract
get_call_type(Contracts).
get_decode_type([{contract, _, _, Defs}]) ->
case [ DecodeType
|| {letfun, _, {id, _, ?DECODE_NAME}, [{arg, _, _, DecodeType}], _Ret, _} <- Defs ] of
[Type] -> {ok, Type};
[] -> {error, missing_call_function}
end;
get_decode_type([_ | Contracts]) ->
%% The __decode should be in the final contract
get_decode_type(Contracts).
get_decode_vm_type(#{ functions := Funs }) ->
case [ VMType || {[_, ?DECODE_NAME], _, [{_, VMType}], _, _} <- Funs ] of
[Type] -> {ok, Type};
[] -> {error, missing_decode_function}
end.
%% Translate an icode value (error if not value) to an Erlang term that can be
%% consumed by aeso_heap:to_binary().
icode_to_term(word, {integer, N}) -> N;