diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/cerl.erl | 23 | ||||
-rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 42 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 51 |
3 files changed, 103 insertions, 13 deletions
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 54eac20ac4..9d6768b157 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -126,9 +126,11 @@ map_es/1, map_arg/1, update_c_map/3, + c_map/1, is_c_map_empty/1, ann_c_map/2, ann_c_map/3, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, + c_map_pair/2, ann_c_map_pair/4 ]). @@ -1582,9 +1584,20 @@ map_es(#c_map{es = Es}) -> -spec map_arg(c_map()) -> c_map() | c_literal(). -map_arg(#c_map{arg = M}) -> +map_arg(#c_map{arg=M}) -> M. +-spec c_map([c_map_pair()]) -> c_map(). + +c_map(Pairs) -> + #c_map{es=Pairs}. + +-spec is_c_map_empty(c_map() | c_literal()) -> boolean(). + +is_c_map_empty(#c_map{ es=[] }) -> true; +is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; +is_c_map_empty(_) -> false. + -spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). ann_c_map(As,Es) -> @@ -1644,6 +1657,11 @@ map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. map_pair_op(#c_map_pair{op=Op}) -> Op. +-spec c_map_pair(cerl(), cerl()) -> c_map_pair(). + +c_map_pair(Key,Val) -> + #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). @@ -4245,6 +4263,9 @@ ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) -> ann_c_bitstr(As, V, S, U, T, Fs); ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T); ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es); +ann_make_tree(As, map, [Es]) -> ann_c_map(As, Es); +ann_make_tree(As, map, [[A], Es]) -> ann_c_map(As, A, Es); +ann_make_tree(As, map_pair, [[Op], [K], [V]]) -> ann_c_map_pair(As, Op, K, V); ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B); ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B); ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es); diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 761ae8409c..6410b73941 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -33,12 +33,15 @@ -include("../include/erl_bits.hrl"). +-type fa() :: {atom(), arity()}. + -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks + optional_callbacks=[] :: [fa()], %Optional callbacks defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function @@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) -> module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], - {Attrs,St#expand{callbacks=Callbacks}}. + OptionalCallbacks = get_optional_callbacks(Attrs), + {Attrs,St#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks}}. + +get_optional_callbacks(Attrs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Attrs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), @@ -108,19 +125,24 @@ module_predef_funcs(St) -> module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; -module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, +module_predef_func_beh_info(#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks, + defined=Defined, exports=Exports}=St) -> PreDef=[{behaviour_info,1}], PreExp=PreDef, - {[gen_beh_info(Callbacks)], + {[gen_beh_info(Callbacks, OptionalCallbacks)], St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), exports=union(from_list(PreExp), Exports)}}. -gen_beh_info(Callbacks) -> +gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), + OptionalList = make_optional_list(OptionalCallbacks), {function,0,behaviour_info,1, [{clause,0,[{atom,0,callbacks}],[], - [List]}]}. + [List]}, + {clause,0,[{atom,0,optional_callbacks}],[], + [OptionalList]}]}. make_list([]) -> {nil,0}; make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> @@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> {integer,0,Arity}]}, make_list(Rest)}. +make_optional_list([]) -> {nil,0}; +make_optional_list([{Name,Arity}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_optional_list(Rest)}. + module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 8c18f6a9f7..83cf76f241 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -82,6 +82,8 @@ -include("core_parse.hrl"). +-define(REC_OFFSET, 100000000). % Also in erl_expand_records. + %% Internal core expressions and help functions. %% N.B. annotations fields in place as normal Core expressions. @@ -501,7 +503,7 @@ expr({cons,L,H0,T0}, St0) -> {H1,Hps,St1} = safe(H0, St0), {T1,Tps,St2} = safe(T0, St1), A = lineno_anno(L, St2), - {ann_c_cons(A, H1, T1),Hps ++ Tps,St2}; + {annotate_cons(A, H1, T1, St2),Hps ++ Tps,St2}; expr({lc,L,E,Qs0}, St0) -> {Qs1,St1} = preprocess_quals(L, Qs0, St0), lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); @@ -509,8 +511,8 @@ expr({bc,L,E,Qs}, St) -> bc_tq(L, E, Qs, {nil,L}, St); expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), - A = lineno_anno(L, St1), - {ann_c_tuple(A, Es1),Eps,St1}; + A = record_anno(L, St1), + {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> % erl_lint should make sure only #{ K => V } are allowed % in map construction. @@ -1557,9 +1559,9 @@ pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A}; pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S}; pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]}; pattern({cons,L,H,T}, St) -> - ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St)); + annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St); pattern({tuple,L,Ps}, St) -> - ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); + annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St); pattern({map,L,Ps}, St) -> #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; pattern({bin,L,Ps}, St) -> @@ -1721,6 +1723,26 @@ fail_clause(Pats, Anno, Arg) -> body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail}, args=[Arg]}]}. +annotate_tuple(A, Es, St) -> + case member(dialyzer, St#core.opts) of + true -> + %% Do not coalesce constant tuple elements. A Hack. + Node = cerl:ann_c_tuple(A, [cerl:c_var(any)]), + cerl:update_c_tuple_skel(Node, Es); + false -> + ann_c_tuple(A, Es) + end. + +annotate_cons(A, H, T, St) -> + case member(dialyzer, St#core.opts) of + true -> + %% Do not coalesce constant conses. A Hack. + Node= cerl:ann_c_cons(A, cerl:c_var(any), cerl:c_var(any)), + cerl:update_c_cons_skel(Node, H, T); + false -> + ann_c_cons(A, H, T) + end. + ubody(B, St) -> uexpr(B, [], St). %% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}. @@ -2238,6 +2260,23 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). +record_anno(L, St) when L >= ?REC_OFFSET -> + case member(dialyzer, St#core.opts) of + true -> + [record | lineno_anno(L - ?REC_OFFSET, St)]; + false -> + lineno_anno(L, St) + end; +record_anno(L, St) when L < -?REC_OFFSET -> + case member(dialyzer, St#core.opts) of + true -> + [record | lineno_anno(L + ?REC_OFFSET, St)]; + false -> + lineno_anno(L, St) + end; +record_anno(L, St) -> + lineno_anno(L, St). + lineno_anno(L, St) -> {line, Line} = erl_parse:get_attribute(L, line), if |