diff options
Diffstat (limited to 'lib/compiler/src')
| -rw-r--r-- | lib/compiler/src/beam_block.erl | 15 | ||||
| -rw-r--r-- | lib/compiler/src/beam_except.erl | 10 | ||||
| -rw-r--r-- | lib/compiler/src/beam_flatten.erl | 1 | ||||
| -rw-r--r-- | lib/compiler/src/beam_jump.erl | 12 | ||||
| -rw-r--r-- | lib/compiler/src/beam_type.erl | 6 | ||||
| -rw-r--r-- | lib/compiler/src/beam_utils.erl | 6 | ||||
| -rw-r--r-- | lib/compiler/src/compile.erl | 14 | ||||
| -rw-r--r-- | lib/compiler/src/core_scan.erl | 3 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 564 | ||||
| -rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 14 | ||||
| -rw-r--r-- | lib/compiler/src/v3_codegen.erl | 3 | ||||
| -rw-r--r-- | lib/compiler/src/v3_core.erl | 128 |
12 files changed, 461 insertions, 315 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index cf5244e1ce..402fbe2e2e 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -123,15 +123,24 @@ is_last_bool([], _) -> false. collect_block(Is) -> collect_block(Is, []). +collect_block([{allocate,N,R}|Is0], Acc) -> + {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true; + (_) -> false + end, Is0), + collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]); collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{set,[],[],{alloc,R,{no_opt,Ns,Nh,[]}}}|Acc]); + collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]); collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; Instr -> collect_block(Is, [Instr|Acc]) end. +collect({allocate,N,R}) -> {set,[],[],{alloc,R,{nozero,N,0,[]}}}; collect({allocate_zero,N,R}) -> {set,[],[],{alloc,R,{zero,N,0,[]}}}; +collect({allocate_heap,Ns,Nh,R}) -> {set,[],[],{alloc,R,{nozero,Ns,Nh,[]}}}; +collect({allocate_heap_zero,Ns,Nh,R}) -> {set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}; +collect({init,D}) -> {set,[D],[],init}; collect({test_heap,N,R}) -> {set,[],[],{alloc,R,{nozero,nostack,N,[]}}}; collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}}; collect({gc_bif,N,F,R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,F}}}; @@ -144,6 +153,10 @@ collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; collect(remove_message) -> {set,[],[],remove_message}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; +collect(fclearerror) -> {set,[],[],fclearerror}; +collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; +collect({fmove,S,D}) -> {set,[D],[S],fmove}; +collect({fconv,S,D}) -> {set,[D],[S],fconv}; collect(_) -> error. %% embed_lines([Instruction]) -> [Instruction] diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index e5ec1bd904..d261809765 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -131,9 +131,13 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); -fix_block(Is0, Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0), - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. +fix_block(Is, Words) -> + fix_block_1(reverse(Is), Words). + +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> + [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([I|Is], Words) -> + [I|fix_block_1(Is, Words)]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> case dig_out_fc(Bl, Live-1, nil) of diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 25428c0c10..5603a677e8 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -51,6 +51,7 @@ norm_block([], Acc) -> Acc. norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D}; norm({set,[D],As,{alloc,R,{gc_bif,N,F}}}) -> {gc_bif,N,F,R,As,D}; +norm({set,[D],[],init}) -> {init,D}; norm({set,[D],[S],move}) -> {move,S,D}; norm({set,[D],[S],fmove}) -> {fmove,S,D}; norm({set,[D],[S],fconv}) -> {fconv,S,D}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index b29a3565e4..d57fb80ac2 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -202,19 +202,19 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End0, Acc0) -> +move_1([I|Is], Ends, Acc0) -> case is_exit_instruction(I) of false -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); true -> - case extract_seq(Acc0, [I|End0]) of + case extract_seq(Acc0, [I]) of no -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); {yes,End,Acc} -> - move_1(Is, End, Acc) + move_1(Is, [End|Ends], Acc) end end; -move_1([], End, Acc) -> reverse(Acc, End). +move_1([], Ends, Acc) -> reverse(Acc, lists:append(reverse(Ends))). extract_seq([{line,_}=Line|Is], Acc) -> extract_seq(Is, [Line|Acc]); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3ec57a67da..58c0f765ae 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -142,6 +142,12 @@ simplify_float(Is0, Ts0) -> throw:not_possible -> not_possible end. +simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, clearerror(Acc)); +simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, checkerror(Acc)); +simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> case tdb_find(A0, Ts0) of diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index e9911fefd9..36f3200d11 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -759,6 +759,12 @@ live_opt([{allocate,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); +live_opt([{'%',_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([], _, _, Acc) -> Acc. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 47d446273b..3db7ffc4d2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -417,6 +417,10 @@ pass(from_core) -> pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(asm) -> + %% TODO: remove 'asm' in R18 + io:format("compile:file/2 option 'asm' has been deprecated and will be " + "removed in R18.~n" + "Use 'from_asm' instead.~n"), pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; @@ -608,7 +612,7 @@ core_passes() -> ?pass(core_fold_module), {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, - {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1}, + {core_fold_after_inlining,fun test_core_inliner/1,fun core_fold_module_after_inlining/1}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -1130,6 +1134,12 @@ core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) -> {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), {ok,St#compile{code=Code,warnings=Warns ++ Ws}}. +core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> + %% Inlining may produce code that generates spurious warnings. + %% Ignore all warnings. + {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), + {ok,St#compile{code=Code}}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. @@ -1613,7 +1623,7 @@ compile_beam(File0, _OutFile, Opts) -> compile_asm(File0, _OutFile, Opts) -> File = shorten_filename(File0), - case file(File, [asm|make_erl_options(Opts)]) of + case file(File, [from_asm|make_erl_options(Opts)]) of {ok,_Mod} -> ok; Other -> Other end. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index c0dfecd1dc..a4fe920258 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -1,8 +1,7 @@ -%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index cda3f7d81e..a388960312 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -70,7 +70,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1]). + reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). -import(cerl, [ann_c_cons/3,ann_c_tuple/2]). @@ -302,18 +302,49 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> B1 = body(B0, value, Sub), Letrec#c_letrec{defs=Fs1,body=B1}; expr(#c_case{}=Case0, Ctxt, Sub) -> + %% Ideally, the compiler should only emit warnings when there is + %% a real mistake in the code being compiled. We use the follow + %% heuristics in an attempt to approach that ideal: + %% + %% * If the guard for a clause always fails, we will emit a + %% warning. + %% + %% * If a case expression is a literal, we will emit no warnings + %% for clauses that will not match or for clauses that are + %% shadowed after a clause that will always match. That means + %% that code such as: + %% + %% case ?DEBUG of + %% false -> ok; + %% true -> ... + %% end + %% + %% (where ?DEBUG expands to either 'true' or 'false') will not + %% produce any warnings. + %% + %% * If the case expression is not literal, warnings will be + %% emitted for every clause that don't match and for all + %% clauses following a clause that will always match. + %% + %% * If no clause will ever match, there will be a warning + %% (in addition to any warnings that may have been emitted + %% according to the rules above). + %% case opt_bool_case(Case0) of #c_case{arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), - {Arg2,Cs1} = case_opt(Arg1, Cs0), - Cs2 = clauses(Arg2, Cs1, Case1, Ctxt, Sub), - Case = eval_case(Case1#c_case{arg=Arg2,clauses=Cs2}, Sub), - bsm_an(Case); + LitExpr = cerl:is_literal(Arg1), + {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub), + Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr), + Case = Case1#c_case{arg=Arg2,clauses=Cs2}, + warn_no_clause_match(Case1, Case), + Expr = eval_case(Case, Sub), + bsm_an(Expr); Other -> expr(Other, Ctxt, Sub) end; expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> - Cs1 = clauses(#c_var{name='_'}, Cs0, Recv, Ctxt, Sub), %This is all we know + Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false), T1 = expr(T0, value, Sub), A1 = body(A0, Ctxt, Sub), Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; @@ -1452,14 +1483,14 @@ let_subst_list([], [], _) -> {[],[],[]}. %%pattern(Pat, Sub) -> pattern(Pat, Sub, Sub). -pattern(#c_var{name=V0}=Pat, Isub, Osub) -> +pattern(#c_var{}=Pat, Isub, Osub) -> case sub_is_val(Pat, Isub) of true -> V1 = make_var_name(), Pat1 = #c_var{name=V1}, {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))}; false -> - {Pat,sub_del_var(Pat, scope_add([V0], Osub))} + {Pat,sub_del_var(Pat, Osub)} end; pattern(#c_literal{}=Pat, _, Osub) -> {Pat,Osub}; pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) -> @@ -1522,6 +1553,9 @@ is_subst(_) -> false. %% chains so we never have to search more than once. Use orddict so %% we know the format. %% +%% In addition to the list of substitutions, we also keep track of +%% all variable currently live (the scope). +%% %% sub_subst_scope/1 adds dummy substitutions for all variables %% in the scope in order to force renaming if variables in the %% scope occurs as pattern variables. @@ -1548,8 +1582,17 @@ sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) -> Tdb = copy_type(V, Val, Tdb1), Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),t=Tdb}. -sub_del_var(#c_var{name=V}, #sub{v=S,t=Tdb}=Sub) -> - Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}. +sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) -> + %% Profiling shows that for programs with many record operations, + %% sub_del_var/2 is a bottleneck. Since the scope contains all + %% variables that are live, we know that V cannot be present in S + %% if it is not in the scope. + case gb_sets:is_member(V, Scope) of + false -> + Sub#sub{s=gb_sets:insert(V, Scope)}; + true -> + Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)} + end. sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) -> %% Fold chained substitutions. @@ -1559,47 +1602,50 @@ sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0, Sub#sub{v=S}. -sub_is_val(#c_var{name=V}, #sub{v=S}) -> - v_is_value(V, S). - -v_is_value(Var, Sub) -> - any(fun ({_,#c_var{name=Val}}) when Val =:= Var -> true; - (_) -> false - end, Sub). - -%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. -%% Trim the clauses by removing all clauses AFTER the first one which -%% is guaranteed to match. Also remove all trivially false clauses. - -clauses(E, Cs0, TopLevel, Ctxt, Sub) -> - Cs = clauses_1(E, Cs0, Ctxt, Sub), - - %% Here we want to warn if no clauses whatsoever will ever - %% match, because that is probably a mistake. - case all(fun is_compiler_generated/1, Cs) andalso - any(fun(C) -> not is_compiler_generated(C) end, Cs0) of +sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) -> + %% When the bottleneck in sub_del_var/2 was eliminated, this + %% became the new bottleneck. Since the scope contains all + %% live variables, a variable V can only be the target for + %% a substitution if it is in the scope. + gb_sets:is_member(V, Scope) andalso v_is_value(V, S). + +v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true; +v_is_value(Var, [_|T]) -> v_is_value(Var, T); +v_is_value(_, []) -> false. + +%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok +%% Generate a warning if none of the user-specified clauses +%% will match. + +warn_no_clause_match(CaseOrig, CaseOpt) -> + OrigCs = cerl:case_clauses(CaseOrig), + OptCs = cerl:case_clauses(CaseOpt), + case any(fun(C) -> not is_compiler_generated(C) end, OrigCs) andalso + all(fun is_compiler_generated/1, OptCs) of true -> %% The original list of clauses did contain at least one %% user-specified clause, but none of them will match. %% That is probably a mistake. - add_warning(TopLevel, no_clause_match); + add_warning(CaseOrig, no_clause_match); false -> %% Either there were user-specified clauses left in %% the transformed clauses, or else none of the original %% clauses were user-specified to begin with (as in 'andalso'). ok - end, + end. - Cs. +%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. +%% Trim the clauses by removing all clauses AFTER the first one which +%% is guaranteed to match. Also remove all trivially false clauses. -clauses_1(E, [C0|Cs], Ctxt, Sub) -> +clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub), %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]), case {will_match(E, Ps),will_succeed(G)} of {yes,yes} -> - Line = get_line(core_lib:get_anno(C1)), - case core_lib:is_literal(E) of + case LitExpr of false -> + Line = get_line(core_lib:get_anno(C1)), shadow_warning(Cs, Line); true -> %% If the case expression is a literal, @@ -1608,15 +1654,13 @@ clauses_1(E, [C0|Cs], Ctxt, Sub) -> ok end, [C1]; %Skip the rest - {no,_Suc} -> - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause - {_Mat,no} -> + {_Mat,no} -> %Guard fails. add_warning(C1, nomatch_guard), - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause + clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause {_Mat,_Suc} -> - [C1|clauses_1(E, Cs, Ctxt, Sub)] + [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)] end; -clauses_1(_, [], _, _) -> []. +clauses(_, [], _, _, _) -> []. shadow_warning([C|Cs], none) -> add_warning(C, nomatch_shadow), @@ -1634,69 +1678,18 @@ will_succeed(#c_literal{val=true}) -> yes; will_succeed(#c_literal{val=false}) -> no; will_succeed(_Guard) -> maybe. -%% will_match(Expr, [Pattern]) -> yes | maybe | no. -%% Test if we know whether a match will succeed/fail or just don't -%% know. Be conservative. +%% will_match(Expr, [Pattern]) -> yes | maybe. +%% We KNOW that this function is only used after optimizations +%% in case_opt/4. Therefore clauses that can definitely not match +%% have already been pruned. will_match(#c_values{es=Es}, Ps) -> - will_match_list(Es, Ps, yes); + will_match_1(cerl_clauses:match_list(Ps, Es)); will_match(E, [P]) -> - will_match_1(E, P). - -will_match_1(_E, #c_var{}) -> yes; %Will always match -will_match_1(E, #c_alias{pat=P}) -> %Pattern decides - will_match_1(E, P); -will_match_1(#c_var{}, _P) -> maybe; -will_match_1(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list(Es, Ps, yes); -will_match_1(#c_literal{val=Lit}, P) -> - will_match_lit(Lit, P); -will_match_1(_, _) -> maybe. - -will_match_list([E|Es], [P|Ps], M) -> - case will_match_1(E, P) of - yes -> will_match_list(Es, Ps, M); - maybe -> will_match_list(Es, Ps, maybe); - no -> no - end; -will_match_list([], [], M) -> M. - -will_match_lit(Cons, #c_cons{hd=Hp,tl=Tp}) -> - case Cons of - [H|T] -> - case will_match_lit(H, Hp) of - yes -> will_match_lit(T, Tp); - Other -> Other - end; - _ -> - no - end; -will_match_lit(Tuple, #c_tuple{es=Es}) -> - case is_tuple(Tuple) andalso tuple_size(Tuple) =:= length(Es) of - true -> will_match_lit_list(tuple_to_list(Tuple), Es); - false -> no - end; -will_match_lit(Bin, #c_binary{}) -> - case is_bitstring(Bin) of - true -> maybe; - false -> no - end; -will_match_lit(_, #c_var{}) -> - yes; -will_match_lit(Lit, #c_alias{pat=P}) -> - will_match_lit(Lit, P); -will_match_lit(Lit1, #c_literal{val=Lit2}) -> - case Lit1 =:= Lit2 of - true -> yes; - false -> no - end. + will_match_1(cerl_clauses:match(P, E)). -will_match_lit_list([H|T], [P|Ps]) -> - case will_match_lit(H, P) of - yes -> will_match_lit_list(T, Ps); - Other -> Other - end; -will_match_lit_list([], []) -> yes. +will_match_1({false,_}) -> maybe; +will_match_1({true,_}) -> yes. %% opt_bool_case(CoreExpr) - CoreExpr'. %% Do various optimizations to case statement that has a @@ -1895,166 +1888,243 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> %% last clause is guaranteed to match so if there is only one clause %% with a pattern containing only variables then rewrite to a let. -eval_case(#c_case{arg=#c_var{name=V}, - clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Case, - #sub{t=Tdb}=Sub) -> - case orddict:find(V, Tdb) of - {ok,Type} -> - case {will_match_type(P, Type),will_succeed(G)} of - {yes,yes} -> - {Ps,Es} = remove_non_vars(P, Type), - expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B}, - sub_new(Sub)); - {_,_} -> - eval_case_1(Case, Sub) - end; - error -> eval_case_1(Case, Sub) - end; -eval_case(Case, Sub) -> eval_case_1(Case, Sub). - -eval_case_1(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case, Sub) -> - case is_var_pat(Ps) of - true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new(Sub)); - false -> eval_case_2(E, Ps, B, Case) - end; -eval_case_1(Case, _) -> Case. - -eval_case_2(E, [P], B, Case) -> - %% Recall that there is only one clause and that it is guaranteed to match. - %% If E and P are literals, they must be the same literal and the body - %% can be used directly as there are no variables that need to be bound. - %% Otherwise, P could be an alias meaning that two or more variables - %% would be bound to E. We don't bother to optimize that case as it - %% is rather uncommon. - case core_lib:is_literal(E) andalso core_lib:is_literal(P) of - false -> Case; - true -> B - end; -eval_case_2(_, _, _, Case) -> Case. - -is_var_pat(Ps) -> - all(fun (#c_var{}) -> true; - (_Pat) -> false - end, Ps). - -will_match_type(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list_type(Es, Ps); -will_match_type(#c_literal{val=Atom}, #c_literal{val=Atom}) -> yes; -will_match_type(#c_var{}, #c_var{}) -> yes; -will_match_type(#c_var{}, #c_alias{}) -> yes; -will_match_type(_, _) -> no. - -will_match_list_type([E|Es], [P|Ps]) -> - case will_match_type(E, P) of - yes -> will_match_list_type(Es, Ps); - no -> no - end; -will_match_list_type([], []) -> yes; -will_match_list_type(_, _) -> no. %Different length - -remove_non_vars(Ps0, Es0) -> - {Ps,Es} = remove_non_vars(Ps0, Es0, [], []), - {reverse(Ps),reverse(Es)}. - -remove_non_vars(#c_tuple{es=Ps}, #c_tuple{es=Es}, Pacc, Eacc) -> - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars(#c_var{}=Var, #c_alias{var=Evar}, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(#c_var{}=Var, #c_var{}=Evar, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(P, E, Pacc, Eacc) -> - true = core_lib:is_literal(P) andalso core_lib:is_literal(E), %Assertion. - {Pacc,Eacc}. - -remove_non_vars_list([P|Ps], [E|Es], Pacc0, Eacc0) -> - {Pacc,Eacc} = remove_non_vars(P, E, Pacc0, Eacc0), - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars_list([], [], Pacc, Eacc) -> - {Pacc,Eacc}. +eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> + Es = case cerl:is_c_values(E) of + true -> cerl:values_es(E); + false -> [E] + end, + {true,Bs} = cerl_clauses:match_list(Ps0, Es), + {Ps,As} = unzip(Bs), + expr(#c_let{vars=Ps,arg=core_lib:make_values(As),body=B}, sub_new(Sub)); +eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. -%% Try and optimise case by avoid building a tuple in -%% the case expression. Instead of building a tuple -%% in the case expression, combine the elements into -%% multiple "values". If a clause refers to the tuple -%% in the case expression (that was not built), introduce -%% a let into the guard and/or body to build the tuple. +%% Try and optimise a case by avoid building tuples or lists +%% in the case expression. Instead combine the variable parts +%% of the case expression to multiple "values". If a clause +%% refers to the constructed term in the case expression (which +%% was not built), introduce a let into the guard and/or body to +%% build the term. %% -%% case {Expr1,Expr2} of case <Expr1,Expr2> of -%% {P1,P2} -> ... <P1,P2> -> ... +%% case {ok,[Expr1,Expr2]} of case <Expr1,Expr2> of +%% {ok,[P1,P2]} -> ... <P1,P2> -> ... %% . ==> . %% . . %% . . -%% Var -> <Var1,Var2> -> -%% ... Var ... let <Var> = {Var1,Var2} -%% in ... Var ... +%% Var -> <Var1,Var2> -> +%% ... Var ... let <Var> = {ok,[Var1,Var2]} +%% in ... Var ... %% . . %% . . %% . . -%% end. end. +%% end. end. %% -case_opt(#c_tuple{anno=A,es=Es}, Cs0) -> - Cs1 = case_opt_cs(Cs0, length(Es)), - {core_lib:set_anno(core_lib:make_values(Es), A),Cs1}; -case_opt(Arg, Cs) -> {Arg,Cs}. - -case_opt_cs([#c_clause{pats=Ps0,guard=G,body=B}=C|Cs], Arity) -> - case case_tuple_pat(Ps0, Arity) of - {ok,Ps1,Avs} -> - Flet = fun ({V,Pat}, Body) -> letify(V, Pat, Body) end, - [C#c_clause{pats=Ps1, - guard=foldl(Flet, G, Avs), - body=foldl(Flet, B, Avs)}|case_opt_cs(Cs, Arity)]; - error -> %Can't match - add_warning(C, nomatch_clause_type), - case_opt_cs(Cs, Arity) +case_opt(Arg, Cs0, Sub) -> + Cs1 = [{cerl:clause_pats(C),C,[],[]} || C <- Cs0], + Args0 = case cerl:is_c_values(Arg) of + false -> [Arg]; + true -> cerl:values_es(Arg) + end, + LitExpr = cerl:is_literal(Arg), + {Args,Cs2} = case_opt_args(Args0, Cs1, Sub, LitExpr, []), + Cs = [cerl:update_c_clause(C, + reverse(Ps), + letify(Bs, cerl:clause_guard(C)), + letify(Bs, cerl:clause_body(C))) || + {[],C,Ps,Bs} <- Cs2], + {core_lib:make_values(Args),Cs}. + +case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) -> + case case_opt_arg(A0, Sub, Cs0, LitExpr) of + error -> + %% Nothing to be done. Move on to the next argument. + Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0], + case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]); + {ok,As1,Cs} -> + %% The argument was either expanded (from tuple/list) or + %% removed (literal). + case_opt_args(As1++As0, Cs, Sub, LitExpr, Acc) + end; +case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> + {reverse(Acc),Cs}. + +%% case_opt_arg(Expr, Sub, Clauses0, LitExpr) -> +%% {ok,Args,Clauses} | error +%% Try to expand one argument to several arguments (if tuple/list) +%% or to remove a literal argument. +%% +case_opt_arg(E0, Sub, Cs, LitExpr) -> + E = maybe_replace_var(E0, Sub), + case cerl:is_data(E) of + false -> + error; + true -> + case cerl:data_type(E) of + {atomic,_} -> + case_opt_lit(E, Cs, LitExpr); + _ -> + case_opt_data(E, Cs, LitExpr) + end + end. + +%% maybe_replace_var(Expr0, Sub) -> Expr +%% If Expr0 is a variable that has been previously matched and +%% is known to be a tuple, return the tuple instead. Otherwise +%% return Expr0 unchanged. +%% +maybe_replace_var(E, Sub) -> + case cerl:is_c_var(E) of + false -> E; + true -> maybe_replace_var_1(E, Sub) + end. + +maybe_replace_var_1(E, #sub{t=Tdb}) -> + case orddict:find(cerl:var_name(E), Tdb) of + {ok,T0} -> + case cerl:is_c_tuple(T0) of + false -> + E; + true -> + cerl_trees:map(fun(C) -> + case cerl:is_c_alias(C) of + false -> C; + true -> cerl:alias_pat(C) + end + end, T0) + end; + error -> + E + end. + +%% case_opt_lit(Literal, Clauses0, LitExpr) -> +%% {ok,[],Clauses} | error +%% The current part of the case expression is a literal. That +%% means that we will know at compile-time whether a clause +%% will match, and we can remove the corresponding pattern from +%% each clause. +%% +%% The only complication is if the literal is a binary. Binary +%% pattern matching is tricky, so we will give up in that case. + +case_opt_lit(Lit, Cs0, LitExpr) -> + try case_opt_lit_1(Cs0, Lit, LitExpr) of + Cs -> + {ok,[],Cs} + catch + throw:impossible -> + error + end. + +case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the literal. Remove the clause. + %% Unless the entire case expression is a literal, also + %% emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_lit_1(Cs, E, LitExpr); + {true,Bs} -> + %% The pattern matches the literal. Remove the pattern + %% and update the bindings. + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)]; + {false,_} -> + %% Binary literal and pattern. We are not sure whether + %% the pattern will match. + throw(impossible) end; -case_opt_cs([], _) -> []. +case_opt_lit_1([], _, _) -> []. + +%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} -%% case_tuple_pat([Pattern], Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. +case_opt_data(E, Cs0, LitExpr) -> + Es = cerl:data_es(E), + Cs = case_opt_data_1(Cs0, Es, + {cerl:data_type(E),cerl:data_arity(E)}, + LitExpr), + {ok,Es,Cs}. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> + case case_data_pat(P, TypeSig) of + {ok,Ps1,Bs1} -> + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; + error -> + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_data_1(Cs, Es, TypeSig, LitExpr) + end; +case_opt_data_1([], _, _, _) -> []. + +%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. + +case_data_pat(P, TypeSig) -> + case cerl:is_data(P) of + false -> + case_data_pat_var(P, TypeSig); + true -> + case {cerl:data_type(P),cerl:data_arity(P)} of + TypeSig -> + {ok,cerl:data_es(P),[]}; + {_,_} -> + error + end + end. -case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity -> - {ok,Ps,[]}; -case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity -> - Ps = [#c_literal{val=E} || E <- tuple_to_list(T)], - {ok,Ps,[]}; -case_tuple_pat([#c_var{anno=Anno0}=V], Arity) -> - Vars = make_vars(Anno0, 1, Arity), +%% case_data_pat_var(Pattern, {DataType,ArityType}) -> +%% {ok,[Pattern],[{AliasVar,Pat}]} +case_data_pat_var(P, {Type,Arity}=TypeSig) -> %% If the entire case statement is evaluated in an effect %% context (e.g. "case {A,B} of ... end, ok"), there will %% be a warning that a term is constructed but never used. - %% To avoid that warning, we must annotate the tuple as - %% compiler generated. - - Anno = [compiler_generated|Anno0], - {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]}; -case_tuple_pat([#c_alias{var=V,pat=P}], Arity) -> - case case_tuple_pat([P], Arity) of - {ok,Ps,Avs} -> - Anno0 = core_lib:get_anno(P), - Anno = [compiler_generated|Anno0], - {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]}; - error -> + %% To avoid that warning, we must annotate the data + %% constructor as compiler generated. + Ann = [compiler_generated|cerl:get_ann(P)], + case cerl:type(P) of + var -> + Vars = make_vars(cerl:get_ann(P), Arity), + {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]}; + alias -> + V = cerl:alias_var(P), + Apat = cerl:alias_pat(P), + case case_data_pat(Apat, TypeSig) of + {ok,Ps,Bs} -> + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; + error -> + error + end; + _ -> error - end; -case_tuple_pat(_, _) -> error. + end. %% unalias_pat(Pattern) -> Pattern. %% Remove all the aliases in a pattern but using the alias variables %% instead of the values. We KNOW they will be bound. -unalias_pat(#c_alias{var=V}) -> V; -unalias_pat(#c_cons{anno=Anno,hd=H0,tl=T0}) -> - H1 = unalias_pat(H0), - T1 = unalias_pat(T0), - ann_c_cons(Anno, H1, T1); -unalias_pat(#c_tuple{anno=Anno,es=Ps}) -> - ann_c_tuple(Anno, unalias_pat_list(Ps)); -unalias_pat(Atomic) -> Atomic. +unalias_pat(P) -> + case cerl:is_c_alias(P) of + true -> + cerl:alias_var(P); + false -> + case cerl:is_data(P) of + false -> + P; + true -> + Es = unalias_pat_list(cerl:data_es(P)), + cerl:update_data(P, cerl:data_type(P), Es) + end + end. unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +make_vars(A, Max) -> + make_vars(A, 1, Max). + make_vars(A, I, Max) when I =< Max -> [make_var(A)|make_vars(A, I+1, Max)]; make_vars(_, _, _) -> []. @@ -2067,6 +2137,11 @@ make_var_name() -> put(new_var_num, N+1), list_to_atom("fol"++integer_to_list(N)). +letify(Bs, Body) -> + foldr(fun({V,Val}, B) -> + letify(V, Val, B) + end, Body, Bs). + letify(#c_var{name=Vname}=Var, Val, Body) -> case core_lib:is_var_used(Vname, Body) of true -> @@ -2087,7 +2162,7 @@ opt_case_in_let_0([#c_var{name=V}], Arg, case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - opt_bool_case(Case#c_case{arg=Arg}); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); false -> Let end; @@ -2342,6 +2417,25 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}; {_,_,_} -> impossible end; +move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, + #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> + %% + %% let <Lvars> = do <Seq-arg> + %% <Seq-body> + %% in <Let-body> + %% + %% ==> + %% + %% do <Seq-arg> + %% let <Lvars> = <Seq-body> + %% in <Let-body> + %% + Sarg = body(Sarg0, Sub0), + Sbody1 = body(Sbody0, Sub0), + {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0), + Lbody = body(Lbody0, Sub), + Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody), + body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 7d918a55ed..48d9c16718 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -344,6 +344,8 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); +expr({named_fun,Line,Name,Cs}, St) -> + fun_tq(Line, Cs, St, Name); expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), @@ -475,6 +477,11 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> Index = Uniq = 0, {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. +fun_tq(Line, Cs0, St0, Name) -> + {Cs1,St1} = fun_clauses(Cs0, St0), + {Fname,St2} = new_fun_name(St1, Name), + {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. + fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), {G,St2} = guard(G0, St1), @@ -485,9 +492,12 @@ fun_clauses([], St) -> {[],St}. %% new_fun_name(State) -> {FunName,State}. -new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> +new_fun_name(St) -> + new_fun_name(St, 'fun'). + +new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) -> Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ "-fun-" ++ integer_to_list(I) ++ "-", + ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. %% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 6a13495523..f534500671 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1466,10 +1466,11 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live), BinFlags = {field_flags,[]}, - Code = SzCode ++ + Code = [Line|SzCode] ++ [case member(single_use, Anno) of true -> {bs_private_append,Fail,Target,U,Src,BinFlags,Target}; diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 01bb8635cd..a5f31f3844 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -92,7 +92,7 @@ -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). -record(iclause, {anno=#a{},pats,pguard=[],guard,body}). --record(ifun, {anno=#a{},id,vars,clauses,fc}). +-record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}). -record(iletrec, {anno=#a{},defs,body}). -record(imatch, {anno=#a{},pat,guard=[],arg,fc}). -record(iprimop, {anno=#a{},name,args}). @@ -553,16 +553,23 @@ expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), {As1,St2} = exprs(As0, St1), - {Evs,Hs0,St3} = try_after(As1, St2), - %% We must kill the id for any funs in the duplicated after body, - %% to avoid getting two local functions having the same name. - Hs = kill_id_anns(Hs0), + {Name,St3} = new_fun_name("after", St2), {V,St4} = new_var(St3), % (must not exist in As1) - %% TODO: this duplicates the 'after'-code; should lift to function. - Lanno = lineno_anno(L, St4), - {#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=As1++[V], - evars=Evs,handler=Hs}, - [],St4}; + LA = lineno_anno(L, St4), + Lanno = #a{anno=LA}, + Fc = function_clause([], LA, {Name,0}), + Fun = #ifun{anno=Lanno,id=[],vars=[], + clauses=[#iclause{anno=Lanno,pats=[], + guard=[#c_literal{val=true}], + body=As1}], + fc=Fc}, + App = #iapply{anno=#a{anno=[compiler_generated|LA]}, + op=#c_var{anno=LA,name={Name,0}},args=[]}, + {Evs,Hs,St5} = try_after([App], St4), + Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs}, + Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}], + body=[Try]}, + {Letrec,[],St5}; expr({'try',L,Es,Cs,Ecs,As}, St0) -> %% 'try ... [of ...] [catch ...] after ... end' expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); @@ -581,7 +588,11 @@ expr({'fun',L,{function,M,F,A}}, St0) -> name=#c_literal{val=make_fun}, args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St); + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,'_',Cs,Id}, St) -> + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) -> + fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name}); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), @@ -836,9 +847,9 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> flags=#c_literal{val=Flags}}, Eps ++ Eps2,St2}. -%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. +%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. -fun_tq({_,_,Name}=Id, Cs0, L, St0) -> +fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), @@ -847,7 +858,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> Fc = function_clause(Ps, Anno, {Name,Arity}), Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! - vars=Args,clauses=Cs1,fc=Fc}, + vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, {Fun,[],St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. @@ -1135,28 +1146,13 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. -append_tail_segment(Segs, St) -> - app_tail_seg(Segs, St, []). - -app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L, - St0, Acc) -> - case Var0 of - #c_var{name='_'} -> - {Var,St} = new_var(St0), - Seg = Seg0#c_bitstr{val=Var}, - {reverse(Acc, [Seg]),Var,St}; - #c_var{} -> - {reverse(Acc, L),Var0,St0} - end; -app_tail_seg([H|T], St, Acc) -> - app_tail_seg(T, St, [H|Acc]); -app_tail_seg([], St0, Acc) -> +append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, unit=#c_literal{val=1}, type=#c_literal{val=binary}, flags=#c_literal{val=[unsigned,big]}}, - {reverse(Acc, [Tail]),Var,St}. + {Segs++[Tail],Var,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1720,13 +1716,18 @@ uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> Used = union(used_in_any(As1), used_in_any(Cs1)), New = new_in_all(Cs1), {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), - Ks1 = union(Avs, Ks0), - {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), - {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; + Ks1 = case Name of + unnamed -> Ks0; + {named,FName} -> union(subtract([FName], Avs), Ks0) + end, + Ks2 = union(Avs, Ks1), + {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0), + {Fc1,St2} = ufun_clause(Fc0, Ks2, St1), + Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs), + A1 = A0#a{us=Used,ns=[]}, + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> Used = union(lit_vars(Op), lit_list_vars(As)), {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; @@ -2021,15 +2022,24 @@ cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> cexpr(#icatch{anno=A,body=Les}, _As, St0) -> {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! {#c_catch{body=Ces},[],A#a.us,St1}; -cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> - {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! - {Cfc,St2} = cclause(Lfc, [], St1), - Anno = A#a.anno, - {#c_fun{anno=Id++Anno,vars=Args, - body=#c_case{anno=Anno, - arg=set_anno(core_lib:make_values(Args), Anno), - clauses=Ccs ++ [Cfc]}}, - [],A#a.us,St2}; +cexpr(#ifun{name=unnamed}=Fun, As, St0) -> + cfun(Fun, As, St0); +cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, + As, St0) -> + case is_element(Name, Us0) of + false -> + cfun(Fun0, As, St0); + true -> + A1 = A0#a{us=del_element(Name, Us0)}, + Fun1 = Fun0#ifun{anno=A1}, + {#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0), + RecVar = #c_var{name={Name,length(Ps)}}, + Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body}, + CFun1 = CFun0#c_fun{body=Let}, + Letrec = #c_letrec{defs=[{RecVar,CFun1}], + body=RecVar}, + {Letrec,[],Us1,St1} + end; cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> @@ -2056,23 +2066,15 @@ cexpr(Lit, _As, St) -> %%Vs = lit_vars(Lit), {set_anno(Lit, Anno#a.anno),[],Vs,St}. -%% Kill the id annotations for any fun inside the expression. -%% Necessary when duplicating code in try ... after. - -kill_id_anns(#ifun{clauses=Cs0}=Fun) -> - Cs = kill_id_anns(Cs0), - Fun#ifun{clauses=Cs,id=[]}; -kill_id_anns(#a{}=A) -> - %% Optimization: Don't waste time searching for funs inside annotations. - A; -kill_id_anns([H|T]) -> - [kill_id_anns(H)|kill_id_anns(T)]; -kill_id_anns([]) -> []; -kill_id_anns(Tuple) when is_tuple(Tuple) -> - L0 = tuple_to_list(Tuple), - L = kill_id_anns(L0), - list_to_tuple(L); -kill_id_anns(Other) -> Other. +cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> + {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! + {Cfc,St2} = cclause(Lfc, [], St1), + Anno = A#a.anno, + {#c_fun{anno=Id++Anno,vars=Args, + body=#c_case{anno=Anno, + arg=set_anno(core_lib:make_values(Args), Anno), + clauses=Ccs ++ [Cfc]}}, + [],A#a.us,St2}. %% lit_vars(Literal) -> [Var]. |