diff options
Diffstat (limited to 'lib/compiler/src')
| -rw-r--r-- | lib/compiler/src/v3_codegen.erl | 138 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel.erl | 92 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel.hrl | 4 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel_pp.erl | 17 | ||||
| -rw-r--r-- | lib/compiler/src/v3_life.erl | 14 | 
5 files changed, 121 insertions, 144 deletions
| diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index c8735a76e8..4d155c0fd0 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -459,7 +459,7 @@ basic_block([Le|Les], Acc) ->  %% sets that may garbage collect are not allowed in basic blocks.  collect_block({set,_,{binary,_}})    -> no_block; -collect_block({set,_,{map,_,_}})     -> no_block; +collect_block({set,_,{map,_,_,_}})   -> no_block;  collect_block({set,_,_})             -> include;  collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]};  collect_block({call,Func,As,_Rs})   -> {block_end,As++func_vars(Func)}; @@ -928,7 +928,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->  select_map(Scs, V, Tf, Vf, Bef, St0) ->      Reg = fetch_var(V, Bef),      {Is,Aft,St1} = -	match_fmf(fun(#l{ke={val_clause,{map,Es},B},i=I,vdb=Vdb}, Fail, St1) -> +	match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->  			  select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)  		  end, Vf, St0, Scs),      {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. @@ -1488,55 +1488,35 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef,      %% Now generate the complete code for constructing the binary.      Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),      {Sis++Code,Aft,St}; -set_cg([{var,R}], {map,SrcMap,Es0}, Le, Vdb, Bef, +set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,         #cg{in_catch=InCatch,bfail=Bfail}=St) -> +      Fail = {f,Bfail},      {Sis,Int0} =  	case InCatch of  	    true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);  	    false -> {[],Bef}  	end, +    SrcReg = cg_reg_arg(Map,Int0),      Line = line(Le#l.a), -    SrcReg = case SrcMap of -		 {var,SrcVar} -> fetch_var(SrcVar, Int0); -		 _ -> SrcMap -	     end, -    {Assoc,Exact} = -	try -	    cg_map_pairs(Es0) -	catch -	    throw:badarg -> -		{[],[{{float,0.0},{atom,badarg}}, -		     {{integer,0},{atom,badarg}}]} -	end, -    F = fun ({K,{var,V}}) -> [K,fetch_var(V, Int0)]; -	    ({K,E}) -> [K,E] -	end, -    AssocList = flatmap(F, Assoc), -    ExactList = flatmap(F, Exact), -    Live0 = max_reg(Bef#sr.reg), -    Int1 = clear_dead(Int0, Le#l.i, Vdb), -    Aft = Bef#sr{reg=put_reg(R, Int1#sr.reg)}, -    Target = fetch_reg(R, Aft#sr.reg), -    Code = [Line] ++ -	case {AssocList,ExactList} of -	    {[_|_],[]} -> -		[{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}]; -	    {[_|_],[_|_]} -> -		Live = case Target of -			   {x,TargetX} when TargetX =:= Live0 -> -			       Live0 + 1; -			   _ -> -			       Live0 -		       end, -		[{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}, -		 {put_map_exact,Fail,Target,Target,Live,{list,ExactList}}]; -	    {[],[_|_]} -> -		[{put_map_exact,Fail,SrcReg,Target,Live0,{list,ExactList}}]; -	    {[],[]} -> -		[{put_map_assoc,Fail,SrcReg,Target,Live0,{list,[]}}] -	end, -    {Sis++Code,Aft,St}; + +    %% The instruction needs to store keys in term sorted order +    %% All keys has to be unique here +    Pairs = map_pair_strip_and_termsort(Es), + +    %% fetch registers for values to be put into the map +    List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + +    Live = max_reg(Bef#sr.reg), +    Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, +    Aft = clear_dead(Int1, Le#l.i, Vdb), +    Target = fetch_reg(R, Int1#sr.reg), + +    I = case Op of +	assoc -> put_map_assoc; +	exact -> put_map_exact +    end, +    {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St};  set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->      %% Find a place for the return register first.      Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1549,70 +1529,12 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->  	  end,      {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -%% cg_map_pairs(MapPairs) -> {Assoc,Exact} -%%  Assoc = Exact = [{K,V}] -%% -%%  Remove multiple assignments to the same key, and return -%%  one list key-value list with all keys that may or may not exist -%%  (Assoc), and one with keys that must exist (Exact). -%% - -cg_map_pairs(Es0) -> -    Es = cg_map_pairs_1(Es0, 0), -    R0 = sofs:relation(Es), -    R1 = sofs:relation_to_family(R0), -    R2 = sofs:to_external(R1), - -    %% R2 is now [{KeyValue,[{Order,Op,OriginalKey,Value}]}] -    R3 = [begin -	      %% The value for the last pair determines the value. -	      {_,_,_,V} = lists:last(Vs), -	      {Op,{_,SortOrder}=K} = map_pair_op_and_key(Vs), -	      {Op,{SortOrder,K,V}} -	  end || {_,Vs} <- R2], - -    %% R3 is now [{Op,{Key,Value}}] -    R = termsort(R3), - -    %% R4 is now sorted with all alloc first in the list, followed by -    %% all exact. -    {Assoc,Exact} = lists:partition(fun({Op,_}) -> Op =:= assoc end, R), -    {[{K,V} || {_,{_,K,V}} <- Assoc], -     [{K,V} || {_,{_,K,V}} <- Exact]}. - -cg_map_pairs_1([{map_pair_assoc,{_,Kv}=K,V}|T], Order) -> -    [{Kv,{Order,assoc,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([{map_pair_exact,{_,Kv}=K,V}|T], Order) -> -    [{Kv,{Order,exact,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([], _) -> []. - -%% map_pair_op_and_key({_,Op,K,_}) -> {Operator,Key} -%%  Determine the operator and key to use. Throw a 'badarg' -%%  exception if there are contradictory exact updates. - -map_pair_op_and_key(L) -> -    case [K || {_,exact,K,_} <- L] of -	[K] -> -	    %% There is a single ':=' operator. Use that key. -	    {exact,K}; -	[K|T] -> -	    %% There is more than one ':=' operator. All of them -	    %% must have the same key. -	    case lists:all(fun(E) -> E =:= K end, T) of -		true -> -		    {exact,K}; -		false -> -		    %% Some keys are different, e.g. 1 and 1.0. -		    throw(badarg) -	    end; -	[] -> -	    %% Only '=>' operators. Use the first key in the list. -	    [{_,assoc,K,_}|_] = L, -	    {assoc,K} -    end. - -termsort(Ls) -> -    lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Ls). +map_pair_strip_and_termsort(Es) -> +    %% format in +    %%    [{map_pair,K,V}] +    %% where K is for example {integer, 1} and we want to sort on 1. +    Ls = [{K,V}||{_,K,V}<-Es], +    lists:sort(fun({{_,A},_},{{_,B},_}) -> erts_internal:cmp_term(A,B) < 0 end, Ls).  %%%  %%% Code generation for constructing binaries. @@ -2085,7 +2007,7 @@ load_vars(Vs, Regs) ->      foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).  %% put_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> ok{r{R}} | error. +%% find_reg(Val, Regs) -> {ok,r{R}} | error.  %% fetch_reg(Val, Regs) -> r{R}.  %%  Functions to interface the registers. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 6c8089e61d..bc5ca0314a 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -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} -> @@ -497,15 +496,71 @@ 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). +    %{Kes,Ep,St2} = map_pairs(Ces, Sub, St1), +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. @@ -664,11 +719,11 @@ pattern(#c_tuple{anno=A,es=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}; +    {#k_map{anno=A,op=exact,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}; +    {#k_map_pair{anno=A,key=Kk,val=Kv},Osub2,St2};  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}; @@ -1356,9 +1411,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 @@ -1458,9 +1512,9 @@ 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 @@ -1876,7 +1930,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) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index c7886a070d..ab66445f73 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,8 +38,8 @@  -record(k_nil, {anno=[]}).  -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,es}). --record(k_map_pair, {anno=[],op,key,val}). +-record(k_map, {anno=[],var,op,es}). +-record(k_map_pair, {anno=[],key,val}).  -record(k_cons, {anno=[],hd,tl}).  -record(k_binary, {anno=[],segs}).  -record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index edbd3f74f8..639c6737e2 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -110,15 +110,18 @@ format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) ->       " | ",format_1(Var, Ctxt),       $},$~      ]; -format_1(#k_map{es=Es}, Ctxt) -> -    [$~,${, +format_1(#k_map{op=assoc,es=Es}, Ctxt) -> +    ["~{",       format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), -     $},$~ +     "}~" +    ]; +format_1(#k_map{op=exact,es=Es}, Ctxt) -> +    ["::{", +     format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), +     "}::"      ]; -format_1(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> -    ["~<",format(K, Ctxt),",",format(V, Ctxt),">"]; -format_1(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> -    ["::<",format(K, Ctxt),",",format(V, Ctxt),">"]; +format_1(#k_map_pair{key=K,val=V}, Ctxt) -> +    ["<",format(K, Ctxt),",",format(V, Ctxt),">"];  format_1(#k_binary{segs=S}, Ctxt) ->      ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"];  format_1(#k_bin_seg{next=Next}=S, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index ae928e955c..c4f54a7970 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -367,12 +367,10 @@ literal(#k_bin_end{}, Ctxt) ->      {bin_end,Ctxt};  literal(#k_tuple{es=Es}, Ctxt) ->      {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{var=Var,es=Es}, Ctxt) -> -    {map,literal(Var, Ctxt),literal_list(Es, Ctxt)}; -literal(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> -    {map_pair_assoc,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> -    {map_pair_exact,literal(K, Ctxt),literal(V, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> +    {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map_pair{key=K,val=V}, Ctxt) -> +    {map_pair,literal(K, Ctxt),literal(V, Ctxt)};  literal(#k_literal{val=V}, _Ctxt) ->      {literal,V}. @@ -402,8 +400,8 @@ literal2(#k_bin_end{}, Ctxt) ->      {bin_end,Ctxt};  literal2(#k_tuple{es=Es}, Ctxt) ->      {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{es=Es}, Ctxt) -> -    {map,literal_list2(Es, Ctxt)}; +literal2(#k_map{op=Op,es=Es}, Ctxt) -> +    {map,Op,literal_list2(Es, Ctxt)};  literal2(#k_map_pair{key=K,val=V}, Ctxt) ->      {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. | 
