aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src/v3_kernel.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src/v3_kernel.erl')
-rw-r--r--lib/compiler/src/v3_kernel.erl133
1 files changed, 96 insertions, 37 deletions
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 9a2b1605ad..5675572092 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -81,7 +81,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keymember/3,keyfind/3,partition/2]).
+ keymember/3,keyfind/3,partition/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
@@ -274,8 +274,7 @@ expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
{#k_tuple{anno=A,es=Kes},Ep,St1};
expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) ->
{Var,[],St1} = expr(Var0, Sub, St0),
- {Kes,Ep,St2} = map_pairs(Ces, Sub, St1),
- {#k_map{anno=A,var=Var,es=Kes},Ep,St2};
+ map_split_pairs(A, Var, Ces, Sub, St1);
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -351,7 +350,7 @@ expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) ->
{Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here!
{Km,St3} = kmatch(Kvs, Ccs, Sub, St2),
Match = flatten_seq(build_match(Kvs, Km)),
- {last(Match),Pa ++ Pv ++ first(Match),St3};
+ {last(Match),Pa ++ Pv ++ droplast(Match),St3};
expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) ->
{Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic!
{Rvar,St2} = new_var(St1),
@@ -497,15 +496,70 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
-%% FIXME: Not completed
-map_pairs(Es, Sub, St) ->
- foldr(fun
- (#c_map_pair{op=#c_literal{val=Op},key=K0,val=V0}, {Kes,Esp,St0}) when
- Op =:= assoc; Op =:= exact -> %% assert Op
- {K,[],St1} = expr(K0, Sub, St0),
- {V,Ep,St2} = atomic(V0, Sub, St1),
- {[#k_map_pair{op=Op,key=K,val=V}|Kes],Ep ++ Esp,St2}
- end, {[],[],St}, Es).
+map_split_pairs(A, Var, Ces, Sub, St0) ->
+ %% two steps
+ %% 1. force variables
+ %% 2. remove multiples
+ Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
+ {Pairs,Esp,St1} = foldr(fun
+ ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact ->
+ {K,[],Sti1} = expr(K0, Sub, Sti0),
+ {V,Ep,Sti2} = atomic(V0, Sub, Sti1),
+ {[{Op,K,V}|Ops],Ep ++ Espi,Sti2}
+ end, {[],[],St0}, Pairs0),
+
+ case map_group_pairs(Pairs) of
+ {Assoc,[]} ->
+ Kes = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc],
+ {#k_map{anno=A,op=assoc,var=Var,es=Kes},Esp,St1};
+ {[],Exact} ->
+ Kes = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact],
+ {#k_map{anno=A,op=exact,var=Var,es=Kes},Esp,St1};
+ {Assoc,Exact} ->
+ Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc],
+ {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1),
+ Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact],
+ {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Em ++ Esp,St2}
+
+ end.
+
+%% Group map by Assoc operations and Exact operations
+
+map_group_pairs(Es) ->
+ Groups = dict:to_list(map_group_pairs(Es,dict:new())),
+ partition(fun({_,{Op,_,_}}) -> Op =:= assoc end, Groups).
+
+map_group_pairs([{assoc,K,V}|Es0],Used0) ->
+ Used1 = case map_key_is_used(K,Used0) of
+ {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0);
+ {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0);
+ _ -> map_key_set_used(K,{assoc,K,V},Used0)
+ end,
+ map_group_pairs(Es0,Used1);
+map_group_pairs([{exact,K,V}|Es0],Used0) ->
+ Used1 = case map_key_is_used(K,Used0) of
+ {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0);
+ {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0);
+ _ -> map_key_set_used(K,{exact,K,V},Used0)
+ end,
+ map_group_pairs(Es0,Used1);
+map_group_pairs([],Used) ->
+ Used.
+
+map_key_set_used(K,How,Used) ->
+ dict:store(map_key_clean(K),How,Used).
+
+map_key_is_used(K,Used) ->
+ dict:find(map_key_clean(K),Used).
+
+%% Be explicit instead of using set_kanno(K,[])
+map_key_clean(#k_literal{val=V}) -> {k_literal,V};
+map_key_clean(#k_int{val=V}) -> {k_int,V};
+map_key_clean(#k_float{val=V}) -> {k_float,V};
+map_key_clean(#k_atom{val=V}) -> {k_atom,V};
+map_key_clean(#k_nil{}) -> k_nil;
+map_key_clean(#k_var{name=V}) -> {k_var,V}.
+
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
%% Classify the call.
@@ -663,12 +717,8 @@ pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) ->
{Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0),
{#k_tuple{anno=A,es=Kes},Osub1,St1};
pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) ->
- {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0),
- {#k_map{anno=A,es=Kes},Osub1,St1};
-pattern(#c_map_pair{op=#c_literal{val=exact},anno=A,key=Ck,val=Cv},Isub, Osub0, St0) ->
- {Kk,Osub1,St1} = pattern(Ck, Isub, Osub0, St0),
- {Kv,Osub2,St2} = pattern(Cv, Isub, Osub1, St1),
- {#k_map_pair{anno=A,op=exact,key=Kk,val=Kv},Osub2,St2};
+ {Kes,Osub1,St1} = pattern_map_pairs(Ces, Isub, Osub0, St0),
+ {#k_map{anno=A,op=exact,es=Kes},Osub1,St1};
pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) ->
{Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0),
{#k_binary{anno=A,segs=Kv},Osub1,St1};
@@ -683,6 +733,25 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
{[V|Vs],Pat};
flatten_alias(Pat) -> {[],Pat}.
+pattern_map_pairs(Ces0, Isub, Osub0, St0) ->
+ %% It is assumed that all core keys are literals
+ %% It is later assumed that these keys are term sorted
+ %% so we need to sort them here
+ Ces1 = lists:sort(fun
+ (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) ->
+ A = core_lib:literal_value(CkA),
+ B = core_lib:literal_value(CkB),
+ erts_internal:cmp_term(A,B) < 0
+ end, Ces0),
+ %% pattern the pair keys and values as normal
+ {Kes,{Osub1,St1}} = lists:mapfoldl(fun
+ (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) ->
+ {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0),
+ {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1),
+ {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
+ end, {Osub0, St0}, Ces1),
+ {Kes,Osub1,St1}.
+
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
{Kbin,Osub,St}.
@@ -847,15 +916,6 @@ foldr2(Fun, Acc0, [E1|L1], [E2|L2]) ->
foldr2(Fun, Acc1, L1, L2);
foldr2(_, Acc, [], []) -> Acc.
-%% first([A]) -> [A].
-%% last([A]) -> A.
-
-last([L]) -> L;
-last([_|T]) -> last(T).
-
-first([_]) -> [];
-first([H|T]) -> [H|first(T)].
-
%% This code implements the algorithm for an optimizing compiler for
%% pattern matching given "The Implementation of Functional
%% Programming Languages" by Simon Peyton Jones. The code is much
@@ -1342,13 +1402,13 @@ get_match(#k_bin_int{}=BinInt, St0) ->
get_match(#k_tuple{es=Es}, St0) ->
{Mes,St1} = new_vars(length(Es), St0),
{#k_tuple{es=Mes},Mes,St1};
-get_match(#k_map{es=Es0}, St0) ->
+get_match(#k_map{op=exact,es=Es0}, St0) ->
{Mes,St1} = new_vars(length(Es0), St0),
{Es,_} = mapfoldl(fun
(#k_map_pair{}=Pair, [V|Vs]) ->
{Pair#k_map_pair{val=V},Vs}
end, Mes, Es0),
- {#k_map{es=Es},Mes,St1};
+ {#k_map{op=exact,es=Es},Mes,St1};
get_match(M, St) ->
{M,[],St}.
@@ -1365,9 +1425,8 @@ new_clauses(Cs0, U, St) ->
[S,N|As];
#k_bin_int{next=N} ->
[N|As];
- #k_map{es=Es} ->
- Vals = [V ||
- #k_map_pair{op=exact,val=V} <- Es],
+ #k_map{op=exact,es=Es} ->
+ Vals = [V || #k_map_pair{val=V} <- Es],
Vals ++ As;
_Other ->
As
@@ -1467,14 +1526,14 @@ arg_val(Arg, C) ->
_ ->
{set_kanno(S, []),U,T,Fs}
end;
- #k_map{es=Es} ->
+ #k_map{op=exact,es=Es} ->
Keys = [begin
- #k_map_pair{op=exact,key=#k_literal{val=Key}} = Pair,
+ #k_map_pair{key=#k_literal{val=Key}} = Pair,
Key
end || Pair <- Es],
%% multiple keys may have the same name
%% do not use ordsets
- lists:sort(Keys)
+ lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1885,7 +1944,7 @@ pat_vars(#k_tuple{es=Es}) ->
pat_list_vars(Es);
pat_vars(#k_map{es=Es}) ->
pat_list_vars(Es);
-pat_vars(#k_map_pair{op=exact,val=V}) ->
+pat_vars(#k_map_pair{val=V}) ->
pat_vars(V).
pat_list_vars(Ps) ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-10 11:59:06 +0000