diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index c0919d1..28fe3e8 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -208,6 +208,11 @@ potential_unused_return_value(A) -> aeso_tc_warnings:potential_unused_return_val used_typedef(A, B) -> aeso_tc_warnings:used_typedef(A, B). all_warnings() -> aeso_tc_warnings:all_warnings(). +%% ------- + +desugar(A) -> aeso_tc_desugar:desugar(A). +desugar_clauses(A, B, C, D) -> aeso_tc_desugar:desugar_clauses(A, B, C, D). + %% -- New functions ---------------------------------------------------------- @@ -1731,27 +1736,6 @@ infer_letfun1(Env0 = #env{ namespace = NS }, {letfun, Attrib, Fun = {id, NameAtt get_letfun_id({fun_clauses, _, Id, _, _}) -> Id; get_letfun_id({letfun, _, Id, _, _, _}) -> Id. -desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> - NeedDesugar = - case Clauses of - [{letfun, _, _, As, _, [{guarded, _, [], _}]}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As); - _ -> true - end, - case NeedDesugar of - false -> [Clause] = Clauses, Clause; - true -> - NoAnn = [{origin, system}], - Args = [ {typed, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type} - || {I, Type} <- indexed(1, ArgTypes) ], - Tuple = fun([X]) -> X; - (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}} - end, - {letfun, Ann, Fun, Args, RetType, [{guarded, NoAnn, [], {typed, NoAnn, - {switch, NoAnn, Tuple(Args), - [ {'case', AnnC, Tuple(ArgsC), GuardedBodies} - || {letfun, AnnC, _, ArgsC, _, GuardedBodies} <- Clauses ]}, RetType}}]} - end. - print_typesig({Name, TypeSig}) -> ?PRINT_TYPES("Inferred ~s : ~s\n", [Name, pp(TypeSig)]). @@ -3246,85 +3230,3 @@ when_warning(Warn, Do) -> ok end end. - -%% -- Pre-type checking desugaring ------------------------------------------- - -%% Desugars nested record/map updates as follows: -%% { x.y = v1, x.z @ z = f(z) } becomes { x @ __x = __x { y = v1, z @ z = f(z) } } -%% { [k1].x = v1, [k2].y = v2 } becomes { [k1] @ __x = __x { x = v1 }, [k2] @ __x = __x { y = v2 } } -%% There's no comparison of k1 and k2 to group the updates if they are equal. -desugar({record, Ann, Rec, Updates}) -> - {record, Ann, Rec, desugar_updates(Updates)}; -desugar({map, Ann, Map, Updates}) -> - {map, Ann, Map, desugar_updates(Updates)}; -desugar([H|T]) -> - [desugar(H) | desugar(T)]; -desugar(T) when is_tuple(T) -> - list_to_tuple(desugar(tuple_to_list(T))); -desugar(X) -> X. - -desugar_updates([]) -> []; -desugar_updates([Upd | Updates]) -> - {Key, MakeField, Rest} = update_key(Upd), - {More, Updates1} = updates_key(Key, Updates), - %% Check conflicts - case length([ [] || [] <- [Rest | More] ]) of - N when N > 1 -> type_error({conflicting_updates_for_field, Upd, Key}); - _ -> ok - end, - [MakeField(lists:append([Rest | More])) | desugar_updates(Updates1)]. - -%% TODO: refactor representation to make this not horrible -update_key(Fld = {field, _, [Elim], _}) -> - {elim_key(Elim), fun(_) -> Fld end, []}; -update_key(Fld = {field, _, [Elim], _, _}) -> - {elim_key(Elim), fun(_) -> Fld end, []}; -update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Value}) -> - {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Value}]}; -update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Id, Value}) -> - {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Id, Value}]}; -update_key({field, Ann, [K = {map_get, _, _} | Rest], Value}) -> - {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Value}]}; -update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Value}) -> - {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Value}]}; -update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Id, Value}) -> - {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Id, Value}]}; -update_key({field, Ann, [K = {map_get, _, _} | Rest], Id, Value}) -> - {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, - desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} - end, [{field, Ann, Rest, Id, Value}]}. - -map_or_record(Ann, Val, Flds = [Fld | _]) -> - Kind = case element(3, Fld) of - [{proj, _, _} | _] -> record; - [{map_get, _, _} | _] -> map; - [{map_get, _, _, _} | _] -> map - end, - {Kind, Ann, Val, Flds}. - -elim_key({proj, _, {id, _, Name}}) -> Name; -elim_key({map_get, _, _, _}) -> map_key; %% no grouping on map keys (yet) -elim_key({map_get, _, _}) -> map_key. - -updates_key(map_key, Updates) -> {[], Updates}; -updates_key(Name, Updates) -> - Xs = [ {Upd, Name1 == Name, Rest} - || Upd <- Updates, - {Name1, _, Rest} <- [update_key(Upd)] ], - Updates1 = [ Upd || {Upd, false, _} <- Xs ], - More = [ Rest || {_, true, Rest} <- Xs ], - {More, Updates1}. - -indexed(I, Xs) -> - lists:zip(lists:seq(I, I + length(Xs) - 1), Xs). - diff --git a/src/aeso_tc_desugar.erl b/src/aeso_tc_desugar.erl new file mode 100644 index 0000000..caf3b61 --- /dev/null +++ b/src/aeso_tc_desugar.erl @@ -0,0 +1,113 @@ +-module(aeso_tc_desugar). + +-export([ desugar/1 + , desugar_clauses/4 + ]). + +%% -- Moved functions -------------------------------------------------------- + +type_error(A) -> aeso_tc_errors:type_error(A). + +%% --------------------------------------------------------------------------- + +desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> + NeedDesugar = + case Clauses of + [{letfun, _, _, As, _, [{guarded, _, [], _}]}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As); + _ -> true + end, + case NeedDesugar of + false -> [Clause] = Clauses, Clause; + true -> + NoAnn = [{origin, system}], + Args = [ {typed, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type} + || {I, Type} <- indexed(1, ArgTypes) ], + Tuple = fun([X]) -> X; + (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}} + end, + {letfun, Ann, Fun, Args, RetType, [{guarded, NoAnn, [], {typed, NoAnn, + {switch, NoAnn, Tuple(Args), + [ {'case', AnnC, Tuple(ArgsC), GuardedBodies} + || {letfun, AnnC, _, ArgsC, _, GuardedBodies} <- Clauses ]}, RetType}}]} + end. + +%% -- Pre-type checking desugaring ------------------------------------------- + +%% Desugars nested record/map updates as follows: +%% { x.y = v1, x.z @ z = f(z) } becomes { x @ __x = __x { y = v1, z @ z = f(z) } } +%% { [k1].x = v1, [k2].y = v2 } becomes { [k1] @ __x = __x { x = v1 }, [k2] @ __x = __x { y = v2 } } +%% There's no comparison of k1 and k2 to group the updates if they are equal. +desugar({record, Ann, Rec, Updates}) -> + {record, Ann, Rec, desugar_updates(Updates)}; +desugar({map, Ann, Map, Updates}) -> + {map, Ann, Map, desugar_updates(Updates)}; +desugar([H|T]) -> + [desugar(H) | desugar(T)]; +desugar(T) when is_tuple(T) -> + list_to_tuple(desugar(tuple_to_list(T))); +desugar(X) -> X. + +desugar_updates([]) -> []; +desugar_updates([Upd | Updates]) -> + {Key, MakeField, Rest} = update_key(Upd), + {More, Updates1} = updates_key(Key, Updates), + %% Check conflicts + case length([ [] || [] <- [Rest | More] ]) of + N when N > 1 -> type_error({conflicting_updates_for_field, Upd, Key}); + _ -> ok + end, + [MakeField(lists:append([Rest | More])) | desugar_updates(Updates1)]. + +%% TODO: refactor representation to make this not horrible +update_key(Fld = {field, _, [Elim], _}) -> + {elim_key(Elim), fun(_) -> Fld end, []}; +update_key(Fld = {field, _, [Elim], _, _}) -> + {elim_key(Elim), fun(_) -> Fld end, []}; +update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Value}) -> + {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Value}]}; +update_key({field, Ann, [P = {proj, _, {id, _, Name}} | Rest], Id, Value}) -> + {Name, fun(Flds) -> {field, Ann, [P], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Id, Value}]}; +update_key({field, Ann, [K = {map_get, _, _} | Rest], Value}) -> + {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Value}]}; +update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Value}) -> + {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Value}]}; +update_key({field, Ann, [K = {map_get, _, _, _} | Rest], Id, Value}) -> + {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Id, Value}]}; +update_key({field, Ann, [K = {map_get, _, _} | Rest], Id, Value}) -> + {map_key, fun(Flds) -> {field, Ann, [K], {id, [], "__x"}, + desugar(map_or_record(Ann, {id, [], "__x"}, Flds))} + end, [{field, Ann, Rest, Id, Value}]}. + +map_or_record(Ann, Val, Flds = [Fld | _]) -> + Kind = case element(3, Fld) of + [{proj, _, _} | _] -> record; + [{map_get, _, _} | _] -> map; + [{map_get, _, _, _} | _] -> map + end, + {Kind, Ann, Val, Flds}. + +elim_key({proj, _, {id, _, Name}}) -> Name; +elim_key({map_get, _, _, _}) -> map_key; %% no grouping on map keys (yet) +elim_key({map_get, _, _}) -> map_key. + +updates_key(map_key, Updates) -> {[], Updates}; +updates_key(Name, Updates) -> + Xs = [ {Upd, Name1 == Name, Rest} + || Upd <- Updates, + {Name1, _, Rest} <- [update_key(Upd)] ], + Updates1 = [ Upd || {Upd, false, _} <- Xs ], + More = [ Rest || {_, true, Rest} <- Xs ], + {More, Updates1}. + +indexed(I, Xs) -> + lists:zip(lists:seq(I, I + length(Xs) - 1), Xs).