Distinguish local vars and top-level names already in fcode
This commit is contained in:
Ulf Norell
parent
1d39464190
commit
6f17477c72
@ -36,7 +36,8 @@
|
||||
| {oracle_query_id, binary()}
|
||||
| {bool, false | true}
|
||||
| nil
|
||||
| {var, sophia_name()}
|
||||
| {var, var_name()}
|
||||
| {def, fun_name()}
|
||||
| {con, arities(), tag(), [fexpr()]}
|
||||
| {tuple, [fexpr()]}
|
||||
| {proj, fexpr(), integer()}
|
||||
@ -113,6 +114,7 @@
|
||||
con_env := con_env(),
|
||||
options := [option()],
|
||||
context => context(),
|
||||
vars => [var_name()],
|
||||
functions := #{ fun_name() => fun_def() } }.
|
||||
|
||||
%% -- Entrypoint -------------------------------------------------------------
|
||||
@ -197,7 +199,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R
|
||||
Attrs = get_attributes(Ann),
|
||||
FName = lookup_fun(Env, qname(Env, Name)),
|
||||
FArgs = args_to_fcode(Env, Args),
|
||||
FBody = expr_to_fcode(Env, Body),
|
||||
FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body),
|
||||
%% io:format("Body of ~s:\n~s\n", [Name, format_fexpr(FBody)]),
|
||||
Def = #{ attrs => Attrs,
|
||||
args => FArgs,
|
||||
@ -279,8 +281,8 @@ expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {oracle_pubkey, K};
|
||||
expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {oracle_query_id, K};
|
||||
|
||||
%% Variables
|
||||
expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, [X]};
|
||||
expr_to_fcode(_Env, _Type, {qid, _, X}) -> {var, X};
|
||||
expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]);
|
||||
expr_to_fcode(Env, _Type, {qid, _, X}) -> resolve_var(Env, X);
|
||||
|
||||
%% Constructors
|
||||
expr_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon ->
|
||||
@ -311,20 +313,21 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) ->
|
||||
|
||||
expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) ->
|
||||
X = fresh_name(),
|
||||
Proj = fun(I) -> {proj, {var, [X]}, I - 1} end,
|
||||
Proj = fun(I) -> {proj, {var, X}, I - 1} end,
|
||||
Comp = fun({I, false}) -> Proj(I);
|
||||
({_, {set, E}}) -> expr_to_fcode(Env, E);
|
||||
({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(Env, E)}
|
||||
end,
|
||||
Set = fun({_, false}, R) -> R;
|
||||
({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)};
|
||||
({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, {'let', Z, Proj(I), expr_to_fcode(Env, E)}}
|
||||
({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1,
|
||||
{'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}}
|
||||
end,
|
||||
Expand = length(Fields) == length(FieldTypes),
|
||||
Updates = [ {I, field_value(FT, Fields)} || {I, FT} <- indexed(FieldTypes) ],
|
||||
Body = case Expand of
|
||||
true -> {tuple, lists:map(Comp, Updates)};
|
||||
false -> lists:foldr(Set, {var, [X]}, Updates)
|
||||
false -> lists:foldr(Set, {var, X}, Updates)
|
||||
end,
|
||||
{'let', X, expr_to_fcode(Env, Rec), Body};
|
||||
|
||||
@ -341,7 +344,7 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) ->
|
||||
{'case', {bool, true}, {nosplit, expr_to_fcode(Env, Then)}}]}}
|
||||
end,
|
||||
case Cond of
|
||||
{var, [X]} -> Switch(X);
|
||||
{var, X} -> Switch(X);
|
||||
_ ->
|
||||
X = fresh_name(),
|
||||
{'let', X, expr_to_fcode(Env, Cond), Switch(X)}
|
||||
@ -390,7 +393,7 @@ expr_to_fcode(Env, Type, {map, Ann, KVs}) ->
|
||||
expr_to_fcode(Env, Type, {map, Ann, {map, Ann, []}, Fields});
|
||||
expr_to_fcode(Env, _Type, {map, _, Map, KVs}) ->
|
||||
X = fresh_name(),
|
||||
Map1 = {var, [X]},
|
||||
Map1 = {var, X},
|
||||
{'let', X, expr_to_fcode(Env, Map),
|
||||
lists:foldr(fun(Fld, M) ->
|
||||
case Fld of
|
||||
@ -399,8 +402,8 @@ expr_to_fcode(Env, _Type, {map, _, Map, KVs}) ->
|
||||
{field_upd, _, [{map_get, _, K}], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} ->
|
||||
Y = fresh_name(),
|
||||
{'let', Y, expr_to_fcode(Env, K),
|
||||
{'let', Z, {map_get, Map1, {var, [Y]}},
|
||||
{map_set, M, {var, [Y]}, expr_to_fcode(Env, V)}}}
|
||||
{'let', Z, {map_get, Map1, {var, Y}},
|
||||
{map_set, M, {var, Y}, expr_to_fcode(bind_var(Env, Z), V)}}}
|
||||
end end, Map1, KVs)};
|
||||
expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) ->
|
||||
{map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)};
|
||||
@ -548,7 +551,9 @@ next_split(Pats) ->
|
||||
|
||||
-spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt().
|
||||
alt_to_fcode(Env, {'case', _, Pat, Expr}) ->
|
||||
{'case', [pat_to_fcode(Env, Pat)], expr_to_fcode(Env, Expr)}.
|
||||
FPat = pat_to_fcode(Env, Pat),
|
||||
FExpr = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Expr),
|
||||
{'case', [FPat], FExpr}.
|
||||
|
||||
-spec pat_to_fcode(env(), aeso_syntax:pat()) -> fpat().
|
||||
pat_to_fcode(Env, {typed, _, Pat, Type}) ->
|
||||
@ -618,18 +623,18 @@ decision_tree_to_fcode({'if', A, Then, Else}) ->
|
||||
|
||||
-spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
|
||||
stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) ->
|
||||
{'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)};
|
||||
{'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)};
|
||||
|
||||
stmts_to_fcode(Env, [Expr]) ->
|
||||
expr_to_fcode(Env, Expr).
|
||||
|
||||
%% -- Optimisations ----------------------------------------------------------
|
||||
|
||||
%% - Translate && and || to ifte
|
||||
%% - Deadcode elimination
|
||||
%% - Unused variable analysis (replace by _)
|
||||
%% - Case specialization
|
||||
%% - Constant propagation
|
||||
%% - Inlining
|
||||
|
||||
-spec optimize_fcode(fcode()) -> fcode().
|
||||
optimize_fcode(Code = #{ functions := Funs }) ->
|
||||
@ -722,6 +727,24 @@ lookup_con(#{ con_env := ConEnv }, Con) ->
|
||||
Tag -> Tag
|
||||
end.
|
||||
|
||||
bind_vars(Env, Xs) ->
|
||||
lists:foldl(fun(X, E) -> bind_var(E, X) end, Env, Xs).
|
||||
|
||||
bind_var(Env = #{ vars := Vars }, X) -> Env#{ vars := [X | Vars] }.
|
||||
|
||||
resolve_var(#{ vars := Vars } = Env, [X]) ->
|
||||
case lists:member(X, Vars) of
|
||||
true -> {var, X};
|
||||
false -> resolve_fun(Env, [X])
|
||||
end;
|
||||
resolve_var(Env, Q) -> resolve_fun(Env, Q).
|
||||
|
||||
resolve_fun(#{ fun_env := Funs }, Q) ->
|
||||
case maps:get(Q, Funs, not_found) of
|
||||
not_found -> fcode_error({unbound_variable, Q});
|
||||
Fun -> {def, Fun}
|
||||
end.
|
||||
|
||||
init_fresh_names() ->
|
||||
put('%fresh', 0).
|
||||
|
||||
@ -734,6 +757,17 @@ fresh_name() ->
|
||||
put('%fresh', N + 1),
|
||||
lists:concat(["%", N]).
|
||||
|
||||
-spec pat_vars(fpat()) -> [var_name()].
|
||||
pat_vars({var, X}) -> [X || X /= "_"];
|
||||
pat_vars({bool, _}) -> [];
|
||||
pat_vars({int, _}) -> [];
|
||||
pat_vars({string, _}) -> [];
|
||||
pat_vars(nil) -> [];
|
||||
pat_vars({'::', P, Q}) -> pat_vars(P) ++ pat_vars(Q);
|
||||
pat_vars({tuple, Ps}) -> pat_vars(Ps);
|
||||
pat_vars({con, _, _, Ps}) -> pat_vars(Ps);
|
||||
pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)].
|
||||
|
||||
%% -- Renaming --
|
||||
|
||||
-spec rename([{var_name(), var_name()}], fexpr()) -> fexpr().
|
||||
@ -747,8 +781,8 @@ rename(Ren, Expr) ->
|
||||
{oracle_pubkey, _} -> Expr;
|
||||
{oracle_query_id, _} -> Expr;
|
||||
nil -> nil;
|
||||
{var, [X]} -> {var, [rename_var(Ren, X)]};
|
||||
{var, _} -> Expr;
|
||||
{var, X} -> {var, rename_var(Ren, X)};
|
||||
{def, _} -> Expr;
|
||||
{con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]};
|
||||
{tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]};
|
||||
{proj, E, I} -> {proj, rename(Ren, E), I};
|
||||
@ -899,8 +933,10 @@ pp_fexpr({Tag, Lit}) when Tag == int;
|
||||
aeso_pretty:expr({Tag, [], Lit});
|
||||
pp_fexpr(nil) ->
|
||||
pp_text("[]");
|
||||
pp_fexpr({var, X}) ->
|
||||
pp_text(X);
|
||||
pp_fexpr({var, X}) -> pp_text(X);
|
||||
pp_fexpr({def, {entrypoint, E}}) -> pp_text(E);
|
||||
pp_fexpr({def, {local_fun, Q}}) -> pp_text(string:join(Q, "."));
|
||||
pp_fexpr({def, {builtin, B}}) -> pp_text(B);
|
||||
pp_fexpr({con, _, I, []}) ->
|
||||
pp_beside(pp_text("C"), pp_text(I));
|
||||
pp_fexpr({con, _, I, Es}) ->
|
||||
@ -945,9 +981,9 @@ pp_case({'case', Pat, Split}) ->
|
||||
prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")),
|
||||
prettypr:nest(2, pp_split(Split))]).
|
||||
|
||||
pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, [X]} || X <- Xs]});
|
||||
pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, [X]}, {var, [Xs]}});
|
||||
pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, [X]} || X <- Xs]});
|
||||
pp_pat({var, X}) -> pp_fexpr({var, [X]});
|
||||
pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]});
|
||||
pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, X}, {var, Xs}});
|
||||
pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]});
|
||||
pp_pat({var, X}) -> pp_fexpr({var, X});
|
||||
pp_pat(Pat) -> pp_fexpr(Pat).
|
||||
|
||||
|
||||
@ -149,7 +149,7 @@ type_to_scode(T) -> T.
|
||||
%% -- Environment functions --
|
||||
|
||||
init_env(ContractName, FunNames, Args) ->
|
||||
#env{ vars = [ {[X], {arg, I}} || {I, {X, _}} <- with_ixs(Args) ],
|
||||
#env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ],
|
||||
contract = ContractName,
|
||||
locals = FunNames,
|
||||
tailpos = true }.
|
||||
@ -158,7 +158,7 @@ next_var(#env{ vars = Vars }) ->
|
||||
1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]).
|
||||
|
||||
bind_var(Name, Var, Env = #env{ vars = Vars }) ->
|
||||
Env#env{ vars = [{[Name], Var} | Vars] }.
|
||||
Env#env{ vars = [{Name, Var} | Vars] }.
|
||||
|
||||
bind_local(Name, Env) ->
|
||||
I = next_var(Env),
|
||||
@ -168,28 +168,10 @@ notail(Env) -> Env#env{ tailpos = false }.
|
||||
|
||||
code_error(Err) -> error(Err).
|
||||
|
||||
lookup_var(Env, X = [N | _]) when is_integer(N) ->
|
||||
lookup_var(Env, [X]);
|
||||
lookup_var(Env, X) ->
|
||||
case resolve_name(Env, X) of
|
||||
{var, Var} -> Var;
|
||||
_ -> code_error({unbound_variable, X, Env})
|
||||
end.
|
||||
|
||||
resolve_name(#env{ vars = Vars, contract = Contract, locals = Funs }, X) ->
|
||||
lookup_var(#env{vars = Vars}, X) ->
|
||||
case lists:keyfind(X, 1, Vars) of
|
||||
{_, Var} -> {var, Var};
|
||||
false ->
|
||||
case X of
|
||||
[Lib, Fun] ->
|
||||
EntryPoint = Lib == Contract andalso lists:member({entrypoint, Fun}, Funs),
|
||||
LocalFun = lists:member({local_fun, X}, Funs),
|
||||
if EntryPoint -> {def, make_function_name({entrypoint, Fun})};
|
||||
LocalFun -> {def, make_function_name({local_fun, X})};
|
||||
true -> not_found end;
|
||||
_ ->
|
||||
not_found
|
||||
end
|
||||
{_, Var} -> Var;
|
||||
false -> code_error({unbound_variable, X, Vars})
|
||||
end.
|
||||
|
||||
%% -- The compiler --
|
||||
@ -278,21 +260,17 @@ to_scode(Env, {'let', X, Expr, Body}) ->
|
||||
|
||||
to_scode(Env, {funcall, Fun, Args}) ->
|
||||
case Fun of
|
||||
{var, X} ->
|
||||
case resolve_name(Env, X) of
|
||||
{def, F} ->
|
||||
Lbl = aeb_fate_data:make_string(F),
|
||||
{var, _} ->
|
||||
?TODO({funcall, Fun});
|
||||
{def, {builtin, _}} ->
|
||||
?TODO({funcall, Fun});
|
||||
{def, Def} ->
|
||||
FName = make_function_name(Def),
|
||||
Lbl = aeb_fate_data:make_string(FName),
|
||||
Call = if Env#env.tailpos -> aeb_fate_code:call_t(Lbl);
|
||||
true -> aeb_fate_code:call(Lbl) end,
|
||||
[ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)],
|
||||
Call ];
|
||||
{var, Y} ->
|
||||
?TODO({call_to_unknown_function, Y});
|
||||
not_found ->
|
||||
code_error({unbound_variable, X, Env})
|
||||
end;
|
||||
_ ->
|
||||
?TODO({funcall, Fun})
|
||||
Call ]
|
||||
end;
|
||||
|
||||
to_scode(Env, {switch, Case}) ->
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user