QPQ-AG/sophia
10
0
Fork 0
Code Issues 41 Pull Requests 5 Actions Packages Projects Releases 16 Wiki Activity

Further generalise used names computation

Browse Source
This commit is contained in:
Ulf Norell 2019-02-08 11:47:54 +01:00
parent 2ac47059c1
commit 27cbedc7ab
1 changed files with 66 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
src/aeso_syntax_utils.erl
View File

@ -6,15 +6,15 @@
%%%-------------------------------------------------------------------
-module(aeso_syntax_utils).
-export([used_ids/1, used_types/1, fold/4]).
-export([used_ids/1, used_types/1, used/1]).
-record(alg, {zero, plus, minus}). %% minus for variable binding
-record(alg, {zero, plus, scoped}).
-type alg(A) :: #alg{ zero :: A
, plus :: fun((A, A) -> A)
, minus :: fun((A, A) -> A) }.
-type alg(A) :: #alg{ zero :: A
, plus :: fun((A, A) -> A)
, scoped :: fun((A, A) -> A) }.
-type kind() :: decl | type | expr | pat.
-type kind() :: decl | type | bind_type | expr | bind_expr.
-spec fold(alg(A), fun((kind(), _) -> A), kind(), E | [E]) -> A
when E :: aeso_syntax:decl()
@ -30,31 +30,32 @@
| aeso_syntax:arg_expr()
| aeso_syntax:field(aeso_syntax:expr())
| aeso_syntax:stmt().
fold(Alg, Fun, K, Xs) when is_list(Xs) ->
lists:foldl(fun(X, A) -> (Alg#alg.plus)(A, fold(Alg, Fun, K, X)) end,
Alg#alg.zero, Xs);
fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) ->
fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) ->
Sum = fun(Xs) -> lists:foldl(Plus, Zero, Xs) end,
Same = fun(A) -> fold(Alg, Fun, K, A) end,
Decl = fun(D) -> fold(Alg, Fun, decl, D) end,
Type = fun(T) -> fold(Alg, Fun, type, T) end,
Expr = fun(E) -> fold(Alg, Fun, expr, E) end,
Pat = fun(P) -> fold(Alg, Fun, pat, P) end,
BindExpr = fun(P) -> fold(Alg, Fun, bind_expr, P) end,
BindType = fun(T) -> fold(Alg, Fun, bind_type, T) end,
Top = Fun(K, X),
LetBound = fun LB ({letval, _, Y, _, _}) -> Expr(Y);
LB ({letfun, _, F, _, _, _}) -> Expr(F);
LB ({letrec, _, Ds}) -> Sum(lists:map(LB, Ds));
LB (_) -> Zero
end,
Bound = fun LB ({letval, _, Y, _, _}) -> BindExpr(Y);
LB ({letfun, _, F, _, _, _}) -> BindExpr(F);
LB ({letrec, _, Ds}) -> Sum(lists:map(LB, Ds));
LB (_) -> Zero
end,
Rec = case X of
%% lists (bound things in head scope over tail)
[A | As] -> Scoped(Same(A), Same(As));
%% decl()
{contract, _, _, Ds} -> Decl(Ds);
{namespace, _, _, Ds} -> Decl(Ds);
{type_decl, _, _, _} -> Zero;
{type_def, _, _, _, D} -> Decl(D);
{type_decl, _, I, _} -> BindType(I);
{type_def, _, I, _, D} -> Plus(BindType(I), Decl(D));
{fun_decl, _, _, T} -> Type(T);
{letval, _, _, T, E} -> Plus(Type(T), Expr(E));
{letfun, _, _, Xs, T, E} -> Plus(Type(T), Minus(Expr(E), Expr(Xs)));
{letrec, _, Ds} -> Decl(Ds);
{letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]);
{letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Scoped(BindExpr(Xs), Expr(E))]);
{letrec, _, Ds} -> Plus(Bound(Ds), Decl(Ds));
%% typedef()
{alias_t, T} -> Type(T);
{record_t, Fs} -> Type(Fs);
@ -64,12 +65,12 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) ->
{constr_t, _, _, Ts} -> Type(Ts);
%% type()
{fun_t, _, Named, Args, Ret} -> Type([Named, Args, Ret]);
{app_t, _, T, Ts} -> Type([T | Ts]);
{tuple_t, _, Ts} -> Type(Ts);
{app_t, _, T, Ts} -> Type([T | Ts]);
{tuple_t, _, Ts} -> Type(Ts);
%% named_arg_t()
{named_arg_t, _, _, T, E} -> Plus(Type(T), Expr(E));
%% expr()
{lam, _, Args, E} -> Minus(Expr(E), Expr(Args));
{lam, _, Args, E} -> Scoped(BindExpr(Args), Expr(E));
{'if', _, A, B, C} -> Expr([A, B, C]);
{switch, _, E, Alts} -> Expr([E, Alts]);
{app, _, A, As} -> Expr([A | As]);
@ -83,15 +84,14 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) ->
{map, _, KVs} -> Sum([Expr([Key, Val]) || {Key, Val} <- KVs]);
{map_get, _, A, B} -> Expr([A, B]);
{map_get, _, A, B, C} -> Expr([A, B, C]);
{block, Ann, [S | Ss]} -> Plus(Expr(S), Minus(Expr({block, Ann, Ss}), LetBound(S)));
{block, _, []} -> Zero;
{block, _, Ss} -> Expr(Ss);
%% field()
{field, _, LV, E} -> Expr([LV, E]);
{field, _, LV, _, E} -> Expr([LV, E]);
%% arg()
{arg, _, X, T} -> Plus(Expr(X), Type(T));
%% alt()
{'case', _, P, E} -> Minus(Expr(E), Pat(P));
{'case', _, P, E} -> Scoped(BindExpr(P), Expr(E));
%% elim()
{proj, _, _} -> Zero;
{map_get, _, E} -> Expr(E);
@ -101,19 +101,47 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) ->
end,
(Alg#alg.plus)(Top, Rec).
%% Var set combinators
-spec ulist_alg() -> alg([any()]).
ulist_alg() -> #alg{ zero = [], plus = fun lists:umerge/2, minus = fun erlang:'--'/2 }.
%% Name dependencies
used_ids(E) ->
fold(ulist_alg(),
fun(expr, {id, _, X}) -> [X];
(pat, {id, _, X}) -> [X];
(_, _) -> [] end, decl, E).
[ X || {term, [X]} <- used(E) ].
used_types(T) ->
fold(ulist_alg(),
fun(type, {id, _, X}) -> [X];
(_, _) -> [] end, decl, T).
[ X || {type, [X]} <- used(T) ].
-type entity() :: {term, [string()]}
| {type, [string()]}
| {namespace, [string()]}.
-spec entity_alg() -> alg([entity()]).
entity_alg() ->
IsBound = fun({K, _}) -> lists:member(K, [bound_term, bound_type]) end,
Unbind = fun(bound_term) -> term; (bound_type) -> type end,
Scoped = fun(Xs, Ys) ->
{Bound, Others} = lists:partition(IsBound, Ys),
Bound1 = [ {Unbind(Tag), X} || {Tag, X} <- Bound ],
lists:umerge(Xs -- Bound1, Others)
end,
#alg{ zero = []
, plus = fun lists:umerge/2
, scoped = Scoped }.
-spec used(_) -> [entity()].
used(D) ->
Kind = fun(expr) -> term;
(bind_expr) -> bound_term;
(type) -> type;
(bind_type) -> bound_type
end,
NS = fun(Xs) -> {namespace, lists:droplast(Xs)} end,
NotBound = fun({Tag, _}) -> not lists:member(Tag, [bound_term, bound_type]) end,
Xs =
fold(entity_alg(),
fun(K, {id, _, X}) -> [{Kind(K), [X]}];
(K, {qid, _, Xs}) -> [{Kind(K), Xs}, NS(Xs)];
(K, {con, _, X}) -> [{Kind(K), [X]}];
(K, {qcon, _, Xs}) -> [{Kind(K), Xs}, NS(Xs)];
(_, _) -> []
end, decl, D),
lists:filter(NotBound, Xs).