From 27cbedc7abc1ae29bebc886beaf000dbc8765d4b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 11:47:54 +0100 Subject: [PATCH] Further generalise used names computation --- src/aeso_syntax_utils.erl | 104 ++++++++++++++++++++++++-------------- 1 file changed, 66 insertions(+), 38 deletions(-) diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index 94e89aa..a8aceea 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -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).