diff options
Diffstat (limited to 'lib/hipe')
| -rw-r--r-- | lib/hipe/cerl/erl_types.erl | 113 | ||||
| -rw-r--r-- | lib/hipe/main/hipe.erl | 70 |
2 files changed, 122 insertions, 61 deletions
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 14335cf635..e7823a596a 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -82,6 +82,8 @@ t_from_form/4, t_from_form/5, t_from_form_without_remote/2, + t_check_record_fields/4, + t_check_record_fields/5, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, @@ -747,7 +749,8 @@ t_opaque_from_records(RecDict) -> end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, {{Module, _Form, ArgNames}, _Type}) -> + dict:map(fun({opaque, Name, _Arity}, + {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), %% TmpVarDict = dict:from_list(List), @@ -4189,7 +4192,7 @@ builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> case dict:find(M, MR) of {ok, R} -> case lookup_type(Name, 0, R) of - {_, {{_M, _F, _A}, _T}} -> + {_, {{_M, _FL, _F, _A}, _T}} -> type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L); error -> {Type, L} @@ -4203,7 +4206,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), {ok, R} = dict:find(M, MR), case lookup_type(Name, ArgsLen, R) of - {type, {{Module, Form, ArgNames}, _Type}} -> + {type, {{Module, _FileName, Form, ArgNames}, _Type}} -> TypeName = {type, Module, Name, ArgsLen}, case can_unfold_more(TypeName, TypeNames) of true -> @@ -4213,7 +4216,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Module, Form, ArgNames}, Type}} -> + {opaque, {{Module, _FileName, Form, ArgNames}, Type}} -> TypeName = {opaque, Module, Name, ArgsLen}, {Rep, L2} = case can_unfold_more(TypeName, TypeNames) of @@ -4251,7 +4254,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> case sets:is_element(MFA, ET) of true -> case lookup_type(Name, ArgsLen, RemDict) of - {type, {{_Mod, Form, ArgNames}, _Type}} -> + {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} -> RemType = {type, RemMod, Name, ArgsLen}, case can_unfold_more(RemType, TypeNames) of true -> @@ -4263,7 +4266,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Mod, Form, ArgNames}, Type}} -> + {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} -> RemType = {opaque, RemMod, Name, ArgsLen}, List = lists:zip(ArgNames, ArgTypes), TmpVarDict = dict:from_list(List), @@ -4358,34 +4361,24 @@ build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) -> build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], TypeNames, ET, M, MR, V, D, L, Acc) -> {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), - %% The cached record field type (DeclType) in - %% get_mod_record_types()), was created with a similar call as TT. - %% Using T for the subtype test does not work since any() is not - %% always a subset of the field type. - TT = t_from_form(Type, ET, M, MR, V), - NewAcc = [{Name, Type, T, TT}|Acc], + NewAcc = [{Name, Type, T}|Acc], {Dict, L2} = build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc), {Dict, L2}; build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) -> {lists:keysort(1, Acc), L}. -get_mod_record_types([{FieldName, _Abstr, DeclType}|Left1], - [{FieldName, TypeForm, ModType, ModTypeTest}|Left2], +get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1], + [{FieldName, TypeForm, ModType}|Left2], Acc) -> - ModTypeNoVars = subst_all_vars_to_any(ModTypeTest), - case t_is_subtype(ModTypeNoVars, DeclType) of - false -> {error, FieldName}; - true -> get_mod_record_types(Left1, Left2, - [{FieldName, TypeForm, ModType}|Acc]) - end; + get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]); get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1], - [{FieldName2, _FormType, _ModType, _TT}|_] = List2, + [{FieldName2, _FormType, _ModType}|_] = List2, Acc) when FieldName1 < FieldName2 -> get_mod_record_types(Left1, List2, [DT|Acc]); get_mod_record_types(Left1, [], Acc) -> {ok, lists:keysort(1, Left1++Acc)}; -get_mod_record_types(_, [{FieldName2, _FormType, _ModType, _TT}|_], _Acc) -> +get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) -> {error, FieldName2}. %% It is important to create a limited version of the record type @@ -4406,6 +4399,74 @@ list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) -> {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), {[H1|T1], L2}. +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records()) -> ok. + +t_check_record_fields(Form, ExpTypes, Module, RecDict) -> + t_check_record_fields(Form, ExpTypes, Module, RecDict, dict:new()). + +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records(), var_table()) -> ok. + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called. + +t_check_record_fields({var, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({paren_type, _L, [Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, + ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({atom, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({integer, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, tuple, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, map, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, + ET, M, MR, V) -> + t_check_record_fields(Range, ET, M, MR, V); +t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, record, [Name|Fields]}, ET, M, MR, V) -> + check_record(Name, Fields, ET, M, MR, V); +t_check_record_fields({type, _L, _, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({user_type, _L, _Name, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V). + +check_record({atom, _, Name}, ModFields, ET, M, MR, V) -> + {ok, R} = dict:find(M, MR), + {ok, DeclFields} = lookup_record(Name, R), + case check_fields(ModFields, DeclFields, ET, M, MR, V) of + {error, FieldName} -> + throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", + [Name, FieldName])}); + ok -> ok + end. + +check_fields([{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], + DeclFields, ET, M, MR, V) -> + Type = t_from_form(Abstr, ET, M, MR, V), + {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields), + TypeNoVars = subst_all_vars_to_any(Type), + case t_is_subtype(TypeNoVars, DeclType) of + false -> {error, Name}; + true -> check_fields(Left, DeclFields, ET, M, MR, V) + end; +check_fields([], _Decl, _ET, _M, _MR, _V) -> + ok. + +list_check_record_fields([], _ET, _M, _MR, _V) -> + ok; +list_check_record_fields([H|Tail], ET, M, MR, V) -> + ok = t_check_record_fields(H, ET, M, MR, V), + list_check_record_fields(Tail, ET, M, MR, V). + -spec t_var_names([erl_type()]) -> [atom()]. t_var_names([{var, _, Name}|L]) when L =/= '_' -> @@ -4556,9 +4617,9 @@ is_erl_type(_) -> false. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{_Arity, Fields}]} -> + {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; - {ok, List} when is_list(List) -> + {ok, {_FileLine, List}} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. error; @@ -4571,8 +4632,8 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{Arity, Fields}]} -> {ok, Fields}; - {ok, OrdDict} -> orddict:find(Arity, OrdDict); + {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; + {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 539ce883c0..b614f5f1ab 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -649,8 +649,9 @@ run_compiler_1(DisasmFun, IcodeFun, Options) -> %% The full option expansion is not done %% until the DisasmFun returns. {Code, CompOpts} = DisasmFun(Options), - Opts0 = expand_options(Options ++ CompOpts), - Opts = + Opts0 = expand_options(Options ++ CompOpts, + get(hipe_target_arch)), + Opts = case proplists:get_bool(to_llvm, Opts0) andalso not llvm_support_available() of true -> @@ -895,8 +896,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); code:load_native_sticky(Mod, Bin, Beam); false -> %% Normal loading of a whole module - Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), + ChunkName = hipe_unified_loader:chunk_name(HostArch), {ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath), Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)], {ok, BeamPlusNative} = beam_lib:build_module(Chunks), @@ -933,9 +933,9 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% but can be overridden by passing an option {target, Target}. set_architecture(Options) -> - put(hipe_host_arch, erlang:system_info(hipe_architecture)), - put(hipe_target_arch, - proplists:get_value(target, Options, get(hipe_host_arch))), + HostArch = erlang:system_info(hipe_architecture), + put(hipe_host_arch, HostArch), + put(hipe_target_arch, proplists:get_value(target, Options, HostArch)), ok. %% This sets up some globally accessed stuff that are needed by the @@ -943,7 +943,7 @@ set_architecture(Options) -> %% Therefore, this expands the current set of options for local use. pre_init(Opts) -> - Options = expand_options(Opts), + Options = expand_options(Opts, get(hipe_target_arch)), %% Initialise some counters used for measurements and benchmarking. If %% the option 'measure_regalloc' is given the compilation will return %% a keylist with the counter values. @@ -1105,10 +1105,10 @@ help_hiper() -> -spec help_options() -> 'ok'. help_options() -> - set_architecture([]), %% needed for target-specific option expansion - O1 = expand_options([o1]), - O2 = expand_options([o2]), - O3 = expand_options([o3]), + HostArch = erlang:system_info(hipe_architecture), + O1 = expand_options([o1], HostArch), + O2 = expand_options([o2], HostArch), + O3 = expand_options([o3], HostArch), io:format("HiPE Compiler Options\n" ++ " Boolean-valued options generally have corresponding " ++ "aliases `no_...',\n" ++ @@ -1134,7 +1134,7 @@ help_options() -> [ordsets:from_list([verbose, debug, time, load, pp_beam, pp_icode, pp_rtl, pp_native, pp_asm, timeout]), - expand_options([pp_all]), + expand_options([pp_all], HostArch), O1 -- [o1], (O2 -- O1) -- [o2], (O3 -- O2) -- [o3]]), @@ -1232,8 +1232,8 @@ option_text(Opt) when is_atom(Opt) -> -spec help_option(comp_option()) -> 'ok'. help_option(Opt) -> - set_architecture([]), %% needed for target-specific option expansion - case expand_options([Opt]) of + HostArch = erlang:system_info(hipe_architecture), + case expand_options([Opt], HostArch) of [Opt] -> Name = if is_atom(Opt) -> Opt; tuple_size(Opt) =:= 2 -> element(1, Opt) @@ -1364,11 +1364,11 @@ opt_keys() -> %% verbose_spills, x87]. -%% Definitions: +%% Definitions: -o1_opts() -> +o1_opts(TargetArch) -> Common = [inline_fp, pmatch, peephole], - case get(hipe_target_arch) of + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1385,13 +1385,13 @@ o1_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o2_opts() -> +o2_opts(TargetArch) -> Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse, icode_type, icode_inline_bifs, rtl_lcm, rtl_ssa, rtl_ssa_const_prop, - spillmin_color, use_indexing, remove_comments, - concurrent_comp, binary_opt | o1_opts()], - case get(hipe_target_arch) of + spillmin_color, use_indexing, remove_comments, + concurrent_comp, binary_opt | o1_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1409,9 +1409,9 @@ o2_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o3_opts() -> - Common = [icode_range, {regalloc,coalescing} | o2_opts()], - case get(hipe_target_arch) of +o3_opts(TargetArch) -> + Common = [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1489,18 +1489,18 @@ opt_aliases() -> opt_basic_expansions() -> [{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}]. -opt_expansions() -> - [{o1, o1_opts()}, - {o2, o2_opts()}, - {o3, o3_opts()}, +opt_expansions(TargetArch) -> + [{o1, o1_opts(TargetArch)}, + {o2, o2_opts(TargetArch)}, + {o3, o3_opts(TargetArch)}, {to_llvm, llvm_opts(o3)}, {{to_llvm, o0}, llvm_opts(o0)}, {{to_llvm, o1}, llvm_opts(o1)}, {{to_llvm, o2}, llvm_opts(o2)}, {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, - {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 - x86 -> [x87, inline_fp]; %% has sse2 + {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2 + x86 -> [x87, inline_fp]; _ -> [inline_fp] end}]. llvm_opts(O) -> @@ -1523,18 +1523,18 @@ expand_kt2(Opts) -> [{use_callgraph, fixpoint}, core, {core_transform, cerl_typean}]}]}]). -%% Note that set_architecture/1 must be called first, and that the given +%% Note that the given %% list should contain the total set of options, since things like 'o2' %% are expanded here. Basic expansions are processed here also, since %% this function is called from the help functions. --spec expand_options(comp_options()) -> comp_options(). +-spec expand_options(comp_options(), hipe_architecture()) -> comp_options(). -expand_options(Opts) -> +expand_options(Opts, TargetArch) -> proplists:normalize(Opts, [{negations, opt_negations()}, {aliases, opt_aliases()}, {expand, opt_basic_expansions()}, - {expand, opt_expansions()}]). + {expand, opt_expansions(TargetArch)}]). -spec check_options(comp_options()) -> 'ok'. |