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.erl236
1 files changed, 120 insertions, 116 deletions
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 40d2f72b4c..7dff58582e 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -131,12 +131,12 @@ module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
-attributes([{#c_literal{val=Name},Val}|As]) ->
+attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) ->
case include_attribute(Name) of
false ->
attributes(As);
true ->
- [{Name,core_lib:literal_value(Val)}|attributes(As)]
+ [{Name,Val}|attributes(As)]
end;
attributes([]) -> [].
@@ -273,17 +273,7 @@ expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
{Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
{#k_tuple{anno=A,es=Kes},Ep,St1};
expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) ->
- try expr_map(A,Var,Ces,Sub,St0) of
- {_,_,_}=Res -> Res
- catch
- throw:bad_map ->
- St1 = add_warning(get_line(A), bad_map, A, St0),
- Erl = #c_literal{val=erlang},
- Name = #c_literal{val=error},
- Args = [#c_literal{val=badarg}],
- Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
- expr(Error, Sub, St1)
- end;
+ expr_map(A, Var, Ces, Sub, St0);
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -506,82 +496,87 @@ translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
expr_map(A,Var0,Ces,Sub,St0) ->
- %% An extra pass of validation of Map src because of inlining
{Var,Mps,St1} = expr(Var0, Sub, St0),
- case is_valid_map_src(Var) of
- true ->
- {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
- {Km,Eps++Mps,St2};
- false -> throw(bad_map)
- end.
-
-is_valid_map_src(#k_map{}) -> true;
-is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true;
-is_valid_map_src(#k_var{}) -> true;
-is_valid_map_src(_) -> false.
+ {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
+ {Km,Eps++Mps,St2}.
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],
+ %% 1. Force variables.
+ %% 2. Group adjacent pairs with literal keys.
+ %% 3. Within each such group, remove multiple assignments to the same key.
+ %% 4. Partition each group according to operator ('=>' and ':=').
+ 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}
+ {K,Eps1,Sti1} = atomic(K0, Sub, Sti0),
+ {V,Eps2,Sti2} = atomic(V0, Sub, Sti1),
+ {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ 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},Esp ++ Em,St2}
-
+ map_split_pairs_1(A, Var, Pairs, Esp, St1).
+
+map_split_pairs_1(A, Map0, [{Op,Key,Val}|Pairs1]=Pairs0, Esp0, St0) ->
+ {Map1,Em,St1} = force_atomic(Map0, St0),
+ case Key of
+ #k_var{} ->
+ %% Don't combine variable keys with other keys.
+ Kes = [#k_map_pair{key=Key,val=Val}],
+ Map = #k_map{anno=A,op=Op,var=Map1,es=Kes},
+ map_split_pairs_1(A, Map, Pairs1, Esp0 ++ Em, St1);
+ _ ->
+ %% Literal key. Split off all literal keys.
+ {L,Pairs} = splitwith(fun({_,#k_var{},_}) -> false;
+ ({_,_,_}) -> true
+ end, Pairs0),
+ {Map,Esp,St2} = map_group_pairs(A, Map1, L, Esp0 ++ Em, St1),
+ map_split_pairs_1(A, Map, Pairs, Esp, St2)
+ end;
+map_split_pairs_1(_, Map, [], Esp, St0) ->
+ {Map,Esp,St0}.
+
+map_group_pairs(A, Var, Pairs0, Esp, St0) ->
+ Pairs = map_remove_dup_keys(Pairs0),
+ Assoc = [#k_map_pair{key=K,val=V} || {_,{assoc,K,V}} <- Pairs],
+ Exact = [#k_map_pair{key=K,val=V} || {_,{exact,K,V}} <- Pairs],
+ case {Assoc,Exact} of
+ {[_|_],[]} ->
+ {#k_map{anno=A,op=assoc,var=Var,es=Assoc},Esp,St0};
+ {[],[_|_]} ->
+ {#k_map{anno=A,op=exact,var=Var,es=Exact},Esp,St0};
+ {[_|_],[_|_]} ->
+ Map = #k_map{anno=A,op=assoc,var=Var,es=Assoc},
+ {Mvar,Em,St1} = force_atomic(Map, St0),
+ {#k_map{anno=A,op=exact,var=Mvar,es=Exact},Esp ++ Em,St1}
end.
-%% Group map by Assoc operations and Exact operations
+map_remove_dup_keys(Es) ->
+ dict:to_list(map_remove_dup_keys(Es, dict:new())).
-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).
+map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) ->
+ K = map_key_clean(K0),
+ Op = case dict:find(K, Used0) of
+ {ok,{exact,_,_}} -> exact;
+ _ -> assoc
+ end,
+ Used1 = dict:store(K, {Op,K0,V}, Used0),
+ map_remove_dup_keys(Es0, Used1);
+map_remove_dup_keys([{exact,K0,V}|Es0],Used0) ->
+ K = map_key_clean(K0),
+ Op = case dict:find(K, Used0) of
+ {ok,{assoc,_,_}} -> assoc;
+ _ -> exact
+ end,
+ Used1 = dict:store(K, {Op,K0,V}, Used0),
+ map_remove_dup_keys(Es0, Used1);
+map_remove_dup_keys([], Used) -> 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.
+%% Be explicit instead of using set_kanno(K, []).
+map_key_clean(#k_var{name=V}) -> {var,V};
+map_key_clean(#k_literal{val=V}) -> {lit,V};
+map_key_clean(#k_int{val=V}) -> {lit,V};
+map_key_clean(#k_float{val=V}) -> {lit,V};
+map_key_clean(#k_atom{val=V}) -> {lit,V};
+map_key_clean(#k_nil{}) -> {lit,[]}.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
@@ -660,12 +655,12 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0],
{E,Ap1,St1} = atomic(E0, Sub, St0),
{S1,Ap2,St2} = atomic(S0, Sub, St1),
validate_bin_element_size(S1),
- U1 = core_lib:literal_value(U0),
- Fs1 = core_lib:literal_value(Fs0),
+ U1 = cerl:concrete(U0),
+ Fs1 = cerl:concrete(Fs0),
{Es,Ap3,St3} = atomic_bin(Es0, Sub, St2),
{#k_bin_seg{anno=A,size=S1,
unit=U1,
- type=core_lib:literal_value(T),
+ type=cerl:concrete(T),
flags=Fs1,
seg=E,next=Es},
Ap1++Ap2++Ap3,St3};
@@ -757,23 +752,22 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
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),
+ {Kk,[],Sti1} = expr(Ck, Isub, Sti0),
+ {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1),
{#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
- end, {Osub0, St0}, Ces1),
- {Kes,Osub1,St1}.
+ end, {Osub0, St0}, Ces0),
+ %% It is later assumed that these keys are term sorted
+ %% so we need to sort them here
+ Kes1 = lists:sort(fun
+ (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) ->
+ A = map_key_clean(KkA),
+ B = map_key_clean(KkB),
+ erts_internal:cmp_term(A,B) < 0
+ end, Kes),
+ {Kes1,Osub1,St1}.
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
@@ -793,8 +787,8 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0],
%% problems.
#k_atom{val=bad_size}
end,
- U0 = core_lib:literal_value(U),
- Fs0 = core_lib:literal_value(Fs),
+ U0 = cerl:concrete(U),
+ Fs0 = cerl:concrete(Fs),
%%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]),
{E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1),
Isub1 = case E0 of
@@ -805,7 +799,7 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0],
{Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2),
{#k_bin_seg{anno=A,size=S,
unit=U0,
- type=core_lib:literal_value(T),
+ type=cerl:concrete(T),
flags=Fs0,
seg=E,next=Es},
{Isub,Osub},St3};
@@ -842,12 +836,23 @@ get_vsub(V, Vsub) ->
set_vsub(V, S, Vsub) ->
orddict:store(V, S, Vsub).
-subst_vsub(V, S, Vsub0) ->
- %% Fold chained substitutions.
- Vsub1 = orddict:map(fun (_, V1) when V1 =:= V -> S;
- (_, V1) -> V1
- end, Vsub0),
- orddict:store(V, S, Vsub1).
+subst_vsub(Key, New, [{K,Key}|Dict]) ->
+ %% Fold chained substitution.
+ [{K,New}|subst_vsub(Key, New, Dict)];
+subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ %% Insert the new substitution here, and continue
+ %% look for chained substitutions.
+ [{Key,New}|subst_vsub_1(Key, New, Dict)];
+subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K ->
+ [E|subst_vsub(Key, New, Dict)];
+subst_vsub(Key, New, []) -> [{Key,New}].
+
+subst_vsub_1(V, S, [{K,V}|Dict]) ->
+ %% Fold chained substitution.
+ [{K,S}|subst_vsub_1(V, S, Dict)];
+subst_vsub_1(V, S, [E|Dict]) ->
+ [E|subst_vsub_1(V, S, Dict)];
+subst_vsub_1(_, _, []) -> [].
get_fsub(F, A, Fsub) ->
case orddict:find({F,A}, Fsub) of
@@ -1550,13 +1555,11 @@ arg_val(Arg, C) ->
{set_kanno(S, []),U,T,Fs}
end;
#k_map{op=exact,es=Es} ->
- Keys = [begin
- #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(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
+ lists:sort(fun(A,B) ->
+ %% on the form K :: {'lit' | 'var', term()}
+ %% lit < var as intended
+ erts_internal:cmp_term(A,B) < 0
+ end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es])
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1943,6 +1946,7 @@ lit_list_vars(Ps) ->
%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}.
%% Return variables in a pattern. All variables are new variables
%% except those in the size field of binary segments.
+%% and map_pair keys
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
@@ -1967,8 +1971,10 @@ 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{val=V}) ->
- pat_vars(V).
+pat_vars(#k_map_pair{key=K,val=V}) ->
+ {U1,New} = pat_vars(V),
+ {[], U2} = pat_vars(K),
+ {union(U1,U2),New}.
pat_list_vars(Ps) ->
foldl(fun (P, {Used0,New0}) ->
@@ -2009,9 +2015,7 @@ format_error(nomatch_shadow) ->
format_error(bad_call) ->
"invalid module and/or function name; this call will always fail";
format_error(bad_segment_size) ->
- "binary construction will fail because of a type mismatch";
-format_error(bad_map) ->
- "map construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch".
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),