aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe')
-rw-r--r--lib/hipe/cerl/cerl_pmatch.erl10
-rw-r--r--lib/hipe/cerl/cerl_to_icode.erl4
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl18
-rw-r--r--lib/hipe/cerl/erl_types.erl1183
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl15
-rw-r--r--lib/hipe/llvm/hipe_llvm_main.erl2
-rw-r--r--lib/hipe/main/hipe.app.src6
-rw-r--r--lib/hipe/main/hipe.erl70
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl11
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_match.erl14
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_size.erl6
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl31
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl2
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl4
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl2
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_exact.erl10
-rw-r--r--lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl6
-rw-r--r--lib/hipe/tools/hipe_timer.erl18
-rw-r--r--lib/hipe/vsn.mk2
19 files changed, 686 insertions, 728 deletions
diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl
index 3bc93e80dd..4f04b0a7ed 100644
--- a/lib/hipe/cerl/cerl_pmatch.erl
+++ b/lib/hipe/cerl/cerl_pmatch.erl
@@ -31,7 +31,7 @@
-module(cerl_pmatch).
--define(NO_UNUSED, true).
+%%-define(NO_UNUSED, true).
-export([clauses/2]).
-ifndef(NO_UNUSED).
@@ -59,6 +59,8 @@
%% @see transform/2
-ifndef(NO_UNUSED).
+-spec core_transform(cerl:c_module(), [_]) -> cerl:c_module().
+
core_transform(M, Opts) ->
cerl:to_records(transform(cerl:from_records(M), Opts)).
-endif. % NO_UNUSED
@@ -76,6 +78,8 @@ core_transform(M, Opts) ->
%% @see core_transform/2
-ifndef(NO_UNUSED).
+-spec transform(cerl:cerl(), [_]) -> cerl:cerl().
+
transform(M, _Opts) ->
expr(M, env__empty()).
-endif. % NO_UNUSED
@@ -109,7 +113,7 @@ transform(M, _Opts) ->
%% @see expr/2
%% @see transform/2
--spec clauses([cerl:cerl()], rec_env:environment()) ->
+-spec clauses([cerl:cerl(),...], rec_env:environment()) ->
{cerl:cerl(), [cerl:cerl()]}.
clauses(Cs, Env) ->
@@ -406,6 +410,8 @@ make_let(Vs, A, B) ->
%% @see rec_env
-ifndef(NO_UNUSED).
+-spec expr(cerl:cerl(), rec_env:environment()) -> cerl:cerl().
+
expr(E, Env) ->
case cerl:type(E) of
literal ->
diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl
index 2645056be1..f98aaa12f3 100644
--- a/lib/hipe/cerl/cerl_to_icode.erl
+++ b/lib/hipe/cerl/cerl_to_icode.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2015. 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
@@ -110,7 +110,7 @@
effect = false :: boolean(),
fail = [], % [] or fail-to label
class = expr :: 'expr' | 'guard',
- line = 0 :: erl_scan:line(), % current line number
+ line = 0 :: erl_anno:line(), % current line number
'receive' :: 'undefined' | #'receive'{}
}).
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 74e93bf098..ee77d65932 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -1070,9 +1070,6 @@ type(hipe_bifs, find_na_or_make_stub, 2, Xs, Opaques) ->
type(hipe_bifs, fun_to_address, 1, Xs, Opaques) ->
strict(hipe_bifs, fun_to_address, 1, Xs,
fun (_) -> t_integer() end, Opaques);
-%% type(hipe_bifs, get_emu_address, 1, Xs, Opaques) ->
-%% strict(hipe_bifs, get_emu_address, 1, Xs,
-%% fun (_) -> t_integer() end, Opaques); % address
type(hipe_bifs, get_fe, 2, Xs, Opaques) ->
strict(hipe_bifs, get_fe, 2, Xs, fun (_) -> t_integer() end, Opaques);
type(hipe_bifs, get_rts_param, 1, Xs, Opaques) ->
@@ -1081,9 +1078,6 @@ type(hipe_bifs, get_rts_param, 1, Xs, Opaques) ->
type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, Opaques) ->
strict(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs,
fun (_) -> t_nil() end, Opaques);
-%% type(hipe_bifs, make_native_stub, 2, Xs, Opaques) ->
-%% strict(hipe_bifs, make_native_stub, 2, Xs,
-%% fun (_) -> t_integer() end, Opaques); % address
type(hipe_bifs, mark_referred_from, 1, Xs, Opaques) ->
strict(hipe_bifs, mark_referred_from, 1, Xs,
fun (_) -> t_nil() end, Opaques);
@@ -1119,8 +1113,8 @@ type(hipe_bifs, set_native_address, 3, Xs, Opaques) ->
type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) ->
strict(hipe_bifs, set_native_address_in_fe, 2, Xs,
fun (_) -> t_atom('true') end, Opaques);
-type(hipe_bifs, system_crc, 1, Xs, Opaques) ->
- strict(hipe_bifs, system_crc, 1, Xs, fun (_) -> t_crc32() end, Opaques);
+type(hipe_bifs, system_crc, 0, _, _Opaques) ->
+ t_crc32();
type(hipe_bifs, term_to_word, 1, Xs, Opaques) ->
strict(hipe_bifs, term_to_word, 1, Xs,
fun (_) -> t_integer() end, Opaques);
@@ -2462,16 +2456,12 @@ arg_types(hipe_bifs, find_na_or_make_stub, 2) ->
[t_mfa(), t_boolean()];
arg_types(hipe_bifs, fun_to_address, 1) ->
[t_mfa()];
-%% arg_types(hipe_bifs, get_emu_address, 1) ->
-%% [t_mfa()];
arg_types(hipe_bifs, get_fe, 2) ->
[t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])];
arg_types(hipe_bifs, get_rts_param, 1) ->
[t_fixnum()];
arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) ->
[t_list(t_mfa())];
-%% arg_types(hipe_bifs, make_native_stub, 2) ->
-%% [t_integer(), t_arity()];
arg_types(hipe_bifs, mark_referred_from, 1) ->
[t_mfa()];
arg_types(hipe_bifs, merge_term, 1) ->
@@ -2500,8 +2490,8 @@ arg_types(hipe_bifs, set_native_address, 3) ->
[t_mfa(), t_integer(), t_boolean()];
arg_types(hipe_bifs, set_native_address_in_fe, 2) ->
[t_integer(), t_integer()];
-arg_types(hipe_bifs, system_crc, 1) ->
- [t_crc32()];
+arg_types(hipe_bifs, system_crc, 0) ->
+ [];
arg_types(hipe_bifs, term_to_word, 1) ->
[t_any()];
arg_types(hipe_bifs, update_code_size, 3) ->
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 4215448c61..d39f350c0f 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -40,7 +40,6 @@
any_none_or_unit/1,
lookup_record/3,
max/2,
- module_builtin_opaques/1,
min/2,
number_max/1, number_max/2,
number_min/1, number_min/2,
@@ -68,7 +67,6 @@
t_cons/2,
t_cons_hd/1, t_cons_hd/2,
t_cons_tl/1, t_cons_tl/2,
- t_constant/0,
t_contains_opaque/1, t_contains_opaque/2,
t_decorate_with_opaque/3,
t_elements/1,
@@ -79,10 +77,13 @@
t_non_neg_fixnum/0,
t_pos_fixnum/0,
t_float/0,
+ t_var_names/1,
t_form_to_string/1,
- t_from_form/1,
- t_from_form/2,
- t_from_form/3,
+ 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,
@@ -118,7 +119,6 @@
%% t_is_byte/1,
%% t_is_char/1,
t_is_cons/1, t_is_cons/2,
- t_is_constant/1,
t_is_equal/2,
t_is_fixnum/1,
t_is_float/1, t_is_float/2,
@@ -182,13 +182,11 @@
t_remote/3,
t_string/0,
t_struct_from_opaque/2,
- t_solve_remote/3,
t_subst/2,
t_subtract/2,
t_subtract_list/2,
t_sup/1,
t_sup/2,
- t_tid/0,
t_timeout/0,
t_to_string/1,
t_to_string/2,
@@ -250,6 +248,8 @@
%%
-define(REC_TYPE_LIMIT, 2).
+-define(EXPAND_DEPTH, 16).
+-define(EXPAND_LIMIT, 10000).
-define(TUPLE_TAG_LIMIT, 5).
-define(TUPLE_ARITY_LIMIT, 8).
@@ -368,7 +368,7 @@
-type record_key() :: {'record', atom()}.
-type type_key() :: {'type' | 'opaque', atom(), arity()}.
--type record_value() :: orddict:orddict(). % XXX. To be refined
+-type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}].
-type type_value() :: {module(), erl_type(), atom()}.
-type type_table() :: dict:dict(record_key(), record_value())
| dict:dict(type_key(), type_value()).
@@ -466,16 +466,6 @@ has_opaque_subtype(T) ->
t_opaque_structure(?opaque(Elements)) ->
t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]).
--spec t_opaque_modules(erl_type()) -> [module()].
-
-t_opaque_modules(?opaque(Elements)) ->
- case ordsets:size(Elements) of
- 1 ->
- [#opaque{mod = Mod}] = set_to_list(Elements),
- [Mod];
- _ -> throw({error, "Unexpected multiple opaque types"})
- end.
-
-spec t_contains_opaque(erl_type()) -> boolean().
t_contains_opaque(Type) ->
@@ -593,13 +583,11 @@ t_find_opaque_mismatch_list([H|T]) ->
%% calling t_contains_opaque/2 is that the traversal stops when
%% there is a mismatch which means that unknown opaque types "below"
%% the mismatch are not found.
-%% XXX. Returns one element even if both oparands contain opaque types.
-%% XXX. Slow since t_inf() is called but the results are ignored.
t_find_unknown_opaque(_T1, _T2, 'universe') -> [];
t_find_unknown_opaque(T1, T2, Opaques) ->
try t_inf(T1, T2, {match, Opaques}) of
_ -> []
- catch throw:N when is_integer(N) -> [N]
+ catch throw:{pos, Ns} -> Ns
end.
-spec t_decorate_with_opaque(erl_type(), erl_type(), [erl_type()]) -> erl_type().
@@ -759,14 +747,15 @@ t_opaque_from_records(RecDict) ->
end
end, RecDict),
OpaqueTypeDict =
- dict:map(fun({opaque, Name, _Arity}, {Module, _Type, ArgNames}) ->
+ 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),
%% Rep = t_from_form(Type, RecDict, TmpVarDict),
- Rep = t_none(), % not used for anything right now
+ Rep = t_any(), % not used for anything right now
Args = [t_any() || _ <- ArgNames],
- skip_opaque_alias(Rep, Module, Name, Args)
+ t_opaque(Module, Name, Args, Rep)
end, OpaqueRecDict),
[OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)].
@@ -801,11 +790,6 @@ t_struct_from_opaque(Type, _Opaques) -> Type.
list_struct_from_opaque(Types, Opaques) ->
[t_struct_from_opaque(Type, Opaques) || Type <- Types].
--spec module_builtin_opaques(module()) -> [erl_type()].
-
-module_builtin_opaques(Module) ->
- [O || O <- all_opaque_builtins(), lists:member(Module, t_opaque_modules(O))].
-
%%-----------------------------------------------------------------------------
%% Remote types: these types are used for preprocessing;
%% they should never reach the analysis stage.
@@ -825,134 +809,6 @@ is_remote(_) -> false.
-type mod_records() :: dict:dict(module(), type_table()).
--spec t_solve_remote(erl_type(), sets:set(mfa()), mod_records()) -> erl_type().
-
-t_solve_remote(Type, ExpTypes, Records) ->
- {RT, _RR} = t_solve_remote(Type, ExpTypes, Records, []),
- RT.
-
-t_solve_remote(?function(Domain, Range), ET, R, C) ->
- {RT1, RR1} = t_solve_remote(Domain, ET, R, C),
- {RT2, RR2} = t_solve_remote(Range, ET, R, C),
- {?function(RT1, RT2), RR1 ++ RR2};
-t_solve_remote(?list(Types, Term, Size), ET, R, C) ->
- {RT1, RR1} = t_solve_remote(Types, ET, R, C),
- {RT2, RR2} = t_solve_remote(Term, ET, R, C),
- {?list(RT1, RT2, Size), RR1 ++ RR2};
-t_solve_remote(?product(Types), ET, R, C) ->
- {RL, RR} = list_solve_remote(Types, ET, R, C),
- {?product(RL), RR};
-t_solve_remote(?opaque(Set), ET, R, C) ->
- List = ordsets:to_list(Set),
- {NewList, RR} = opaques_solve_remote(List, ET, R, C),
- {?opaque(ordsets:from_list(NewList)), RR};
-t_solve_remote(?tuple(?any, _, _) = T, _ET, _R, _C) -> {T, []};
-t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) ->
- {RL, RR} = list_solve_remote(Types, ET, R, C),
- {t_tuple(RL), RR};
-t_solve_remote(?tuple_set(Set), ET, R, C) ->
- {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C),
- {t_sup(NewTuples), RR};
-t_solve_remote(?remote(Set), ET, R, C) ->
- RemoteList = ordsets:to_list(Set),
- {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C),
- {t_sup(RL), RR};
-t_solve_remote(?union(List), ET, R, C) ->
- {RL, RR} = list_solve_remote(List, ET, R, C),
- {t_sup(RL), RR};
-t_solve_remote(T, _ET, _R, _C) -> {T, []}.
-
-t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args0} = RemType,
- ET, R, C) ->
- Args = lists:map(fun(A) ->
- {Arg, _} = t_solve_remote(A, ET, R, C),
- Arg
- end, Args0),
- ArgsLen = length(Args),
- case dict:find(RemMod, R) of
- error ->
- self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
- {t_any(), []};
- {ok, RemDict} ->
- MFA = {RemMod, Name, ArgsLen},
- case sets:is_element(MFA, ET) of
- true ->
- case lookup_type(Name, ArgsLen, RemDict) of
- {type, {_Mod, Type, ArgNames}} ->
- {NewType, NewCycle, NewRR} =
- case can_unfold_more(RemType, C) of
- true ->
- List = lists:zip(ArgNames, Args),
- TmpVarDict = dict:from_list(List),
- {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []};
- false ->
- {t_any(), C, [RemType]}
- end,
- {RT, RR} = t_solve_remote(NewType, ET, R, NewCycle),
- RetRR = NewRR ++ RR,
- RT1 =
- case lists:member(RemType, RetRR) of
- true -> t_limit(RT, ?REC_TYPE_LIMIT);
- false -> RT
- end,
- {RT1, RetRR};
- {opaque, {Mod, Type, ArgNames}} ->
- List = lists:zip(ArgNames, Args),
- TmpVarDict = dict:from_list(List),
- {Rep, NewCycle, NewRR} =
- case can_unfold_more(RemType, C) of
- true ->
- {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []};
- false ->
- {t_any(), C, [RemType]}
- end,
- {NewRep, RR} = t_solve_remote(Rep, ET, R, NewCycle),
- RetRR = NewRR ++ RR,
- RT1 =
- case lists:member(RemType, RetRR) of
- true -> t_limit(NewRep, ?REC_TYPE_LIMIT);
- false -> NewRep
- end,
- {skip_opaque_alias(RT1, Mod, Name, Args), RetRR};
- error ->
- Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
- [RemMod, Name]),
- throw({error, Msg})
- end;
- false ->
- self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
- {t_any(), []}
- end
- end.
-
-list_solve_remote([], _ET, _R, _C) ->
- {[], []};
-list_solve_remote([Type|Types], ET, R, C) ->
- {RT, RR1} = t_solve_remote(Type, ET, R, C),
- {RL, RR2} = list_solve_remote(Types, ET, R, C),
- {[RT|RL], RR1 ++ RR2}.
-
-list_solve_remote_type([], _ET, _R, _C) ->
- {[], []};
-list_solve_remote_type([Type|Types], ET, R, C) ->
- {RT, RR1} = t_solve_remote_type(Type, ET, R, C),
- {RL, RR2} = list_solve_remote_type(Types, ET, R, C),
- {[RT|RL], RR1 ++ RR2}.
-
-opaques_solve_remote([], _ET, _R, _C) ->
- {[], []};
-opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) ->
- {RT, RR1} = t_solve_remote(Struct, ET, R, C),
- {LOp, RR2} = opaques_solve_remote(Tail, ET, R, C),
- {[Remote#opaque{struct = RT}|LOp], RR1 ++ RR2}.
-
-tuples_solve_remote([], _ET, _R, _C) ->
- {[], []};
-tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) ->
- {RL, RR1} = list_solve_remote(Tuples, ET, R, C),
- {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C),
- {RL ++ LSzTpls, RR1 ++ RR2}.
-
%%-----------------------------------------------------------------------------
%% Unit type. Signals non termination.
%%
@@ -1891,17 +1747,6 @@ is_tuple1(_) -> false.
t_bitstrlist() ->
t_iolist(1, t_bitstr()).
-%% XXX. To be removed.
--spec t_constant() -> erl_type().
-
-t_constant() ->
- t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]).
-
--spec t_is_constant(erl_type()) -> boolean().
-
-t_is_constant(X) ->
- t_is_subtype(X, t_constant()).
-
-spec t_arity() -> erl_type().
t_arity() ->
@@ -1987,82 +1832,6 @@ t_parameterized_module() ->
t_timeout() ->
t_sup(t_non_neg_integer(), t_atom('infinity')).
-%%-----------------------------------------------------------------------------
-%% Some built-in opaque types
-%%
-
--spec t_array() -> erl_type().
-
-t_array() ->
- t_opaque(array, array, [t_any()],
- t_tuple([t_atom('array'),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_any(),
- t_any()])).
-
--spec t_dict() -> erl_type().
-
-t_dict() ->
- t_opaque(dict, dict, [t_any(), t_any()],
- t_tuple([t_atom('dict'),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_tuple()]),
- t_sup([t_atom('undefined'), t_tuple()])])).
-
--spec t_digraph() -> erl_type().
-
-t_digraph() ->
- t_opaque(digraph, digraph, [],
- t_tuple([t_atom('digraph'),
- t_sup(t_atom(), t_tid()),
- t_sup(t_atom(), t_tid()),
- t_sup(t_atom(), t_tid()),
- t_boolean()])).
-
--spec t_gb_set() -> erl_type().
-
-t_gb_set() ->
- t_opaque(gb_sets, gb_set, [],
- t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])).
-
--spec t_gb_tree() -> erl_type().
-
-t_gb_tree() ->
- t_opaque(gb_trees, gb_tree, [],
- t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])).
-
--spec t_queue() -> erl_type().
-
-t_queue() ->
- t_opaque(queue, queue, [t_any()], t_tuple([t_list(), t_list()])).
-
--spec t_set() -> erl_type().
-
-t_set() ->
- t_opaque(sets, set, [t_any()],
- t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(),
- t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(),
- t_non_neg_integer(),
- t_sup([t_atom('undefined'), t_tuple()]),
- t_sup([t_atom('undefined'), t_tuple()])])).
-
--spec t_tid() -> erl_type().
-
-t_tid() ->
- t_opaque(ets, tid, [], t_integer()).
-
--spec all_opaque_builtins() -> [erl_type(),...].
-
-all_opaque_builtins() ->
- [t_array(), t_dict(), t_digraph(), t_gb_set(),
- t_gb_tree(), t_queue(), t_set(), t_tid()].
-
%%------------------------------------
%% ?none is allowed in products. A product of size 1 is not a product.
@@ -2357,14 +2126,19 @@ expand_range_from_set(Range = ?int_range(From, To), Set) ->
-spec t_sup([erl_type()]) -> erl_type().
-t_sup([?any|_]) ->
- ?any;
-t_sup([H1, H2|T]) ->
- t_sup([t_sup(H1, H2)|T]);
-t_sup([H]) ->
- subst_all_vars_to_any(H);
-t_sup([]) ->
- ?none.
+t_sup([]) -> ?none;
+t_sup(Ts) ->
+ case lists:any(fun is_any/1, Ts) of
+ true -> ?any;
+ false ->
+ t_sup1(Ts, [])
+ end.
+
+t_sup1([H1, H2|T], L) ->
+ t_sup1(T, [t_sup(H1, H2)|L]);
+t_sup1([T], []) -> subst_all_vars_to_any(T);
+t_sup1(Ts, L) ->
+ t_sup1(Ts++L, []).
-spec t_sup(erl_type(), erl_type()) -> erl_type().
@@ -2832,7 +2606,7 @@ inf_opaque1(T1, ?opaque(Set2)=T2, Pos, Opaques) ->
end.
inf_is_opaque_type(T, Pos, {match, Opaques}) ->
- is_opaque_type(T, Opaques) orelse throw(Pos);
+ is_opaque_type(T, Opaques) orelse throw({pos, [Pos]});
inf_is_opaque_type(T, _Pos, Opaques) ->
is_opaque_type(T, Opaques).
@@ -2850,28 +2624,32 @@ inf_collect(_T1, [], _Opaques, OpL) ->
combine(S, T1, T2) ->
#opaque{mod = Mod1, name = Name1, args = Args1} = T1,
#opaque{mod = Mod2, name = Name2, args = Args2} = T2,
- case is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) of
- true -> [comb(Mod1, Name1, Args1, S, T1)];
- false -> [comb(Mod1, Name1, Args1, S, T1), comb(Mod2, Name2, Args2, S, T2)]
+ Comb1 = comb(Mod1, Name1, Args1, S, T1),
+ case is_compat_opaque_names({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) of
+ true -> Comb1;
+ false -> Comb1 ++ comb(Mod2, Name2, Args2, S, T2)
end.
comb(Mod, Name, Args, S, T) ->
- case is_same_name(Mod, Name, Args, S) of
- true -> S;
- false -> T#opaque{struct = S}
+ case can_combine_opaque_names(Mod, Name, Args, S) of
+ true ->
+ ?opaque(Set) = S,
+ Set;
+ false ->
+ [T#opaque{struct = S}]
end.
-is_same_name(Mod1, Name1, Args1,
- ?opaque([#opaque{mod = Mod2, name = Name2, args = Args2}])) ->
- is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2});
-is_same_name(_, _, _, _) -> false.
+can_combine_opaque_names(Mod1, Name1, Args1,
+ ?opaque([#opaque{mod = Mod2, name = Name2, args = Args2}])) ->
+ is_compat_opaque_names({Mod1, Name1, Args1}, {Mod2, Name2, Args2});
+can_combine_opaque_names(_, _, _, _) -> false.
%% Combining two lists this way can be very time consuming...
%% Note: two parameterized opaque types are not the same if their
%% actual parameters differ
inf_opaque(Set1, Set2, Opaques) ->
- List1 = inf_look_up(Set1, 1, Opaques),
- List2 = inf_look_up(Set2, 2, Opaques),
+ List1 = inf_look_up(Set1, Opaques),
+ List2 = inf_look_up(Set2, Opaques),
List0 = [combine(Inf, T1, T2) ||
{Is1, ModNameArgs1, T1} <- List1,
{Is2, ModNameArgs2, T2} <- List2,
@@ -2882,14 +2660,14 @@ inf_opaque(Set1, Set2, Opaques) ->
sup_opaque(List).
%% Optimization: do just one lookup.
-inf_look_up(Set, Pos, Opaques) ->
- [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Pos, Opaques),
+inf_look_up(Set, Opaques) ->
+ [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Opaques),
{M, N, Args}, T} ||
#opaque{mod = M, name = N, args = Args} = T <- set_to_list(Set)].
-inf_is_opaque_type2(T, Pos, {match, Opaques}) ->
- is_opaque_type2(T, Opaques) orelse throw(Pos);
-inf_is_opaque_type2(T, _Pos, Opaques) ->
+inf_is_opaque_type2(T, {match, Opaques}) ->
+ is_opaque_type2(T, Opaques);
+inf_is_opaque_type2(T, Opaques) ->
is_opaque_type2(T, Opaques).
inf_opaque_types(IsOpaque1, ModNameArgs1, T1,
@@ -2898,18 +2676,33 @@ inf_opaque_types(IsOpaque1, ModNameArgs1, T1,
#opaque{struct = S2}=T2,
case
Opaques =:= 'universe' orelse
- is_same_type_name(ModNameArgs1, ModNameArgs2)
+ is_compat_opaque_names(ModNameArgs1, ModNameArgs2)
of
true -> t_inf(S1, S2, Opaques);
false ->
case {IsOpaque1, IsOpaque2} of
- {true, true} -> t_inf(S1, S2, Opaques);
- {true, false} -> t_inf(S1, ?opaque(set_singleton(T2)), Opaques);
- {false, true} -> t_inf(?opaque(set_singleton(T1)), S2, Opaques);
+ {true, true} -> t_inf(S1, S2, Opaques);
+ {true, false} -> t_inf(S1, ?opaque(set_singleton(T2)), Opaques);
+ {false, true} -> t_inf(?opaque(set_singleton(T1)), S2, Opaques);
+ {false, false} when element(1, Opaques) =:= match ->
+ throw({pos, [1, 2]});
{false, false} -> t_none()
end
end.
+is_compat_opaque_names(ModNameArgs, ModNameArgs) -> true;
+is_compat_opaque_names({Mod,Name,Args1}, {Mod,Name,Args2}) ->
+ is_compat_args(Args1, Args2);
+is_compat_opaque_names(_, _) -> false.
+
+is_compat_args([A1|Args1], [A2|Args2]) ->
+ is_compat_arg(A1, A2) andalso is_compat_args(Args1, Args2);
+is_compat_args([], []) -> true;
+is_compat_args(_, _) -> false.
+
+is_compat_arg(A, A) -> true;
+is_compat_arg(A1, A2) -> t_is_any(A1) orelse t_is_any(A2).
+
-spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()].
t_inf_lists(L1, L2) ->
@@ -3008,7 +2801,7 @@ inf_union(U1, U2, Opaques) ->
{Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques),
ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3),
case t_sup([O1, O2, Union]) of
- ?none when ThrowList =/= [] -> throw(hd(ThrowList));
+ ?none when ThrowList =/= [] -> throw({pos, lists:usort(ThrowList)});
Sup -> Sup
end.
@@ -3020,8 +2813,8 @@ inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) ->
try InfFun(E, Opaque)of
Inf ->
inf_union_collect(L, Opaque, InfFun, [Inf|InfList], ThrowList)
- catch throw:N when is_integer(N) ->
- inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList])
+ catch throw:{pos, Ns} ->
+ inf_union_collect(L, Opaque, InfFun, InfList, Ns ++ ThrowList)
end.
inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) ->
@@ -3030,8 +2823,8 @@ inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) ->
try t_inf(T1, T2, Opaques) of
?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques);
T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques)
- catch throw:N when is_integer(N) ->
- inf_union(Left1, Left2, N, [?none|Acc], [N|ThrowList], Opaques)
+ catch throw:{pos, Ns} ->
+ inf_union(Left1, Left2, N, [?none|Acc], Ns ++ ThrowList, Opaques)
end;
inf_union([], [], N, Acc, ThrowList, _Opaques) ->
if N =:= 0 -> {?none, ThrowList};
@@ -3182,12 +2975,12 @@ t_subst_aux(T, _VarMap) ->
subst_all_remote(Type0, Substitute) ->
Map =
fun(Type) ->
- case erl_types:t_is_remote(Type) of
+ case t_is_remote(Type) of
true -> Substitute;
false -> Type
end
end,
- erl_types:t_map(Map, Type0).
+ t_map(Map, Type0).
%%-----------------------------------------------------------------------------
%% Unification
@@ -3317,8 +3110,8 @@ is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) ->
is_type_name(Mod, Name, Args1, Mod, Name, Args2) ->
length(Args1) =:= length(Args2);
-is_type_name(Mod1, Name1, Args1, Mod2, Name2, Args2) ->
- is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2).
+is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) ->
+ false.
%% Two functions since t_unify is not symmetric.
unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]),
@@ -3869,7 +3662,7 @@ t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) ->
[TagAtom] = atom_vals(Tag),
case lookup_record(TagAtom, Arity - 1, RecDict) of
error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
- {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]])
+ {ok, Fields} -> t_tuple([Tag|[T || {_Name, _Abstr, T} <- Fields]])
end;
t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) ->
t_tuple([t_abstract_records(E, RecDict) || E <- Elements]);
@@ -4090,7 +3883,8 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) ->
FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []),
"#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}".
-record_fields_to_string([F|Fs], [{FName, _DefType}|FDefs], RecDict, Acc) ->
+record_fields_to_string([F|Fs], [{FName, _Abstr, _DefType}|FDefs],
+ RecDict, Acc) ->
NewAcc =
case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of
true -> Acc;
@@ -4116,7 +3910,7 @@ record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) ->
FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []),
string:join(FieldDiffs, " and ").
-field_diffs([F|Fs], [{FName, DefType}|FDefs], RecDict, Acc) ->
+field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) ->
%% Don't care about opaqueness for now.
NewAcc =
case not t_is_none(t_inf(F, DefType)) of
@@ -4156,15 +3950,7 @@ opaque_name(Mod, Name, Extra) ->
flat_format("~s(~s)", [S, Extra]).
mod_name(Mod, Name) ->
- case is_obsolete_opaque_builtin(Mod, Name) of
- true -> flat_format("~w", [Name]);
- false -> flat_format("~w:~w", [Mod, Name])
- end.
-
-is_obsolete_opaque_builtin(digraph, digraph) -> true;
-is_obsolete_opaque_builtin(gb_sets, gb_set) -> true;
-is_obsolete_opaque_builtin(gb_trees, gb_tree) -> true;
-is_obsolete_opaque_builtin(_, _) -> false.
+ flat_format("~w:~w", [Mod, Name]).
%%=============================================================================
%%
@@ -4172,374 +3958,540 @@ is_obsolete_opaque_builtin(_, _) -> false.
%%
%%=============================================================================
--spec t_from_form(parse_form()) -> erl_type().
+-type type_names() :: [type_key() | record_key()].
+
+-spec t_from_form(parse_form(), sets:set(mfa()),
+ module(), mod_records()) -> erl_type().
-t_from_form(Form) ->
- t_from_form(Form, dict:new()).
+t_from_form(Form, ExpTypes, Module, RecDict) ->
+ t_from_form(Form, ExpTypes, Module, RecDict, dict:new()).
--spec t_from_form(parse_form(), type_table()) -> erl_type().
+-spec t_from_form(parse_form(), sets:set(mfa()),
+ module(), mod_records(), var_table()) -> erl_type().
-t_from_form(Form, RecDict) ->
- t_from_form(Form, RecDict, dict:new()).
+t_from_form(Form, ExpTypes, Module, RecDict, VarDict) ->
+ {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, VarDict),
+ T.
--spec t_from_form(parse_form(), type_table(), var_table()) -> erl_type().
+%% Replace external types with with none().
+-spec t_from_form_without_remote(parse_form(), type_table()) -> erl_type().
-t_from_form(Form, RecDict, VarDict) ->
- {T, _R} = t_from_form(Form, [], RecDict, VarDict),
+t_from_form_without_remote(Form, TypeTable) ->
+ Module = mod,
+ RecDict = dict:from_list([{Module, TypeTable}]),
+ ExpTypes = replace_by_none,
+ {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, dict:new()),
T.
--type type_names() :: [type_key() | record_key()].
+%% REC_TYPE_LIMIT is used for limiting the depth of recursive types.
+%% EXPAND_LIMIT is used for limiting the size of types by
+%% limiting the number of elements of lists within one type form.
+%% EXPAND_DEPTH is used in conjunction with EXPAND_LIMIT to make the
+%% types balanced (unions will otherwise collapse to any()) by limiting
+%% the depth the same way as t_limit/2 does.
+
+-type expand_limit() :: integer().
--spec t_from_form(parse_form(), type_names(), type_table(), var_table()) ->
- {erl_type(), type_names()}.
+-type expand_depth() :: integer().
-t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) ->
- {t_any(), []};
-t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) ->
- case dict:find(Name, VarDict) of
- error -> {t_var(Name), []};
- {ok, Val} -> {Val, []}
+t_from_form1(Form, TypeNames, ET, M, MR, V) ->
+ t_from_form1(Form, TypeNames, ET, M, MR, V, ?EXPAND_DEPTH).
+
+t_from_form1(Form, TypeNames, ET, M, MR, V, D) ->
+ L = ?EXPAND_LIMIT,
+ {T, L1} = t_from_form(Form, TypeNames, ET, M, MR, V, D, L),
+ if
+ L1 =< 0, D > 1 ->
+ D1 = D div 2,
+ t_from_form1(Form, TypeNames, ET, M, MR, V, D1);
+ true ->
+ {T, L1}
+ end.
+
+-spec t_from_form(parse_form(), type_names(),
+ sets:set(mfa()) | 'replace_by_none',
+ module(), mod_records(), var_table(),
+ expand_depth(), expand_limit())
+ -> {erl_type(), expand_limit()}.
+
+%% If there is something wrong with parse_form()
+%% throw({error, io_lib:chars()} is called;
+%% for unknown remote types
+%% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}
+%% is called, unless 'replace_by_none' is given.
+%%
+%% It is assumed that M can be found in MR.
+
+t_from_form(_, _TypeNames, _ET, _M, _MR, _V, D, L) when D =< 0 ; L =< 0 ->
+ {t_any(), L};
+t_from_form({var, _L, '_'}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_any(), L};
+t_from_form({var, _L, Name}, _TypeNames, _ET, _M, _MR, V, _D, L) ->
+ case dict:find(Name, V) of
+ error -> {t_var(Name), L};
+ {ok, Val} -> {Val, L}
end;
-t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) ->
- t_from_form(Type, TypeNames, RecDict, VarDict);
-t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) ->
- t_from_form(Type, TypeNames, RecDict, VarDict);
+t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, M, MR, V, D, L) ->
+ t_from_form(Type, TypeNames, ET, M, MR, V, D, L);
+t_from_form({paren_type, _L, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
+ t_from_form(Type, TypeNames, ET, M, MR, V, D, L);
t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
- TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
- {t_remote(Module, Type, L), R};
-t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) ->
- {t_atom(Atom), []};
-t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) ->
- {t_integer(Int), []};
-t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _RecDict, _VarDict) ->
+ TypeNames, ET, M, MR, V, D, L) ->
+ remote_from_form(Module, Type, Args, TypeNames, ET, M, MR, V, D, L);
+t_from_form({atom, _L, Atom}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_atom(Atom), L};
+t_from_form({integer, _L, Int}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_integer(Int), L};
+t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
- {t_integer(Val), []};
+ {t_integer(Val), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames,
- _RecDict, _VarDict) ->
+ _ET, _M, _MR, _V, _D, L) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
- {t_integer(Val), []};
+ {t_integer(Val), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
-t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_any(), []};
-t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_arity(), []};
-t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(array, t_array(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_atom(), []};
-t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_binary(), []};
+t_from_form({type, _L, any, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_any(), L};
+t_from_form({type, _L, arity, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_arity(), L};
+t_from_form({type, _L, atom, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_atom(), L};
+t_from_form({type, _L, binary, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_binary(), L};
t_from_form({type, _L, binary, [Base, Unit]} = Type,
- _TypeNames, _RecDict, _VarDict) ->
+ _TypeNames, _ET, _M, _MR, _V, _D, L) ->
case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
{{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 ->
- {t_bitstr(U, B), []};
+ {t_bitstr(U, B), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_bitstr(), []};
-t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_boolean(), []}; % XXX: Temporarily
-t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_boolean(), []};
-t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_byte(), []};
-t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_char(), []};
-t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(dict, t_dict(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(digraph, t_digraph(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_float(), []};
-t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_fun(), []};
-t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) ->
- {t_fun(), []};
+t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_bitstr(), L};
+t_from_form({type, _L, bool, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_boolean(), L}; % XXX: Temporarily
+t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_boolean(), L};
+t_from_form({type, _L, byte, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_byte(), L};
+t_from_form({type, _L, char, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_char(), L};
+t_from_form({type, _L, float, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_float(), L};
+t_from_form({type, _L, function, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_fun(), L};
+t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_fun(), L};
t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames,
- RecDict, VarDict) ->
- {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict),
- {t_fun(T), R};
+ ET, M, MR, V, D, L) ->
+ {T, L1} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L - 1),
+ {t_fun(T), L1};
t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
- TypeNames, RecDict, VarDict) ->
- {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict),
- {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict),
- {t_fun(L, T), R1 ++ R2};
-t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(gb_set, t_gb_set(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(gb_tree, t_gb_tree(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_identifier(), []};
-t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_integer(), []};
-t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_iodata(), []};
-t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_iolist(), []};
-t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_list(), []};
-t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) ->
- {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict),
- {t_list(T), R};
-t_from_form({type, _L, map, As0}, TypeNames, RecDict, VarDict) ->
- As = case is_list(As0) of
- true -> As0;
- false -> []
- end,
- builtin_type(map, t_map([]), As, TypeNames, RecDict, VarDict);
-t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_mfa(), []};
-t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_module(), []};
-t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_nil(), []};
-t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_neg_integer(), []};
-t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict,
- _VarDict) ->
- {t_non_neg_integer(), []};
-t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_unit(), []};
-t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_node(), []};
-t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_none(), []};
-t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_nonempty_list(), []};
-t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) ->
- {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict),
- {t_nonempty_list(T), R};
+ TypeNames, ET, M, MR, V, D, L) ->
+ {Dom1, L1} = list_from_form(Domain, TypeNames, ET, M, MR, V, D, L),
+ {Ran1, L2} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L1),
+ {t_fun(Dom1, Ran1), L2};
+t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_identifier(), L};
+t_from_form({type, _L, integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_integer(), L};
+t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_iodata(), L};
+t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_iolist(), L};
+t_from_form({type, _L, list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_list(), L};
+t_from_form({type, _L, list, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
+ {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D - 1, L - 1),
+ {t_list(T), L1};
+t_from_form({type, _L, map, _}, TypeNames, ET, M, MR, V, D, L) ->
+ builtin_type(map, t_map([]), TypeNames, ET, M, MR, V, D, L);
+t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_mfa(), L};
+t_from_form({type, _L, module, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_module(), L};
+t_from_form({type, _L, nil, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_nil(), L};
+t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_neg_integer(), L};
+t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _M, _MR,
+ _V, _D, L) ->
+ {t_non_neg_integer(), L};
+t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_unit(), L};
+t_from_form({type, _L, node, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_node(), L};
+t_from_form({type, _L, none, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_none(), L};
+t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_nonempty_list(), L};
+t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
+ {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1),
+ {t_nonempty_list(T), L1};
t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames,
- RecDict, VarDict) ->
- {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict),
- {t_cons(T1, T2), R1 ++ R2};
+ ET, M, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1),
+ {t_cons(T1, T2), L2};
t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames,
- _RecDict, _VarDict) ->
- {t_cons(?any, ?any), []};
+ _ET, _M, _MR, _V, _D, L) ->
+ {t_cons(?any, ?any), L};
t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]},
- TypeNames, RecDict, VarDict) ->
- {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict),
- {t_cons(T1, T2), R1 ++ R2};
-t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict,
- _VarDict) ->
- {t_nonempty_string(), []};
-t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_number(), []};
-t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_pid(), []};
-t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_port(), []};
-t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_pos_integer(), []};
+ TypeNames, ET, M, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1),
+ {t_cons(T1, T2), L2};
+t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_nonempty_string(), L};
+t_from_form({type, _L, number, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_number(), L};
+t_from_form({type, _L, pid, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_pid(), L};
+t_from_form({type, _L, port, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_port(), L};
+t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_pos_integer(), L};
t_from_form({type, _L, maybe_improper_list, []}, _TypeNames,
- _RecDict, _VarDict) ->
- {t_maybe_improper_list(), []};
+ _ET, _M, _MR, _V, _D, L) ->
+ {t_maybe_improper_list(), L};
t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
- TypeNames, RecDict, VarDict) ->
- {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict),
- {t_maybe_improper_list(T1, T2), R1 ++ R2};
-t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict),
- {t_product(L), R};
-t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(queue, t_queue(), [], TypeNames, RecDict, VarDict);
+ TypeNames, ET, M, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Content, TypeNames, ET, M, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Termination, TypeNames, ET, M, MR, V, D, L1),
+ {t_maybe_improper_list(T1, T2), L2};
+t_from_form({type, _L, product, Elements}, TypeNames, ET, M, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Elements, TypeNames, ET, M, MR, V, D - 1, L),
+ {t_product(Lst), L1};
t_from_form({type, _L, range, [From, To]} = Type,
- _TypeNames, _RecDict, _VarDict) ->
+ _TypeNames, _ET, _M, _MR, _V, _D, L) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
{{integer, _, FromVal}, {integer, _, ToVal}} ->
- {t_from_range(FromVal, ToVal), []};
+ {t_from_range(FromVal, ToVal), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) ->
- record_from_form(Name, Fields, TypeNames, RecDict, VarDict);
-t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_reference(), []};
-t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(set, t_set(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_string(), []};
-t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_any(), []};
-t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(tid, t_tid(), [], TypeNames, RecDict, VarDict);
-t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_timeout(), []};
-t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) ->
- {t_tuple(), []};
-t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
- {t_tuple(L), R};
-t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
- {t_sup(L), R};
-t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
- type_from_form(Name, Args, TypeNames, RecDict, VarDict);
+t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, M, MR, V, D, L) ->
+ record_from_form(Name, Fields, TypeNames, ET, M, MR, V, D, L);
+t_from_form({type, _L, reference, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_reference(), L};
+t_from_form({type, _L, string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_string(), L};
+t_from_form({type, _L, term, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_any(), L};
+t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_timeout(), L};
+t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {t_tuple(), L};
+t_from_form({type, _L, tuple, Args}, TypeNames, ET, M, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D - 1, L),
+ {t_tuple(Lst), L1};
+t_from_form({type, _L, union, Args}, TypeNames, ET, M, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L),
+ {t_sup(Lst), L1};
+t_from_form({user_type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) ->
+ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L);
+t_from_form({type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
+ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L);
t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames,
- _RecDict, _VarDict) ->
- {t_opaque(Mod, Name, Args, Rep), []}.
-
-builtin_type(Name, Type, Args, TypeNames, RecDict, VarDict) ->
- case lookup_type(Name, length(Args), RecDict) of
- {_, {_M, _T, _A}} ->
- type_from_form(Name, Args, TypeNames, RecDict, VarDict);
+ _ET, _M, _MR, _V, _D, L) ->
+ %% XXX. To be removed.
+ {t_opaque(Mod, Name, Args, Rep), L}.
+
+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, _FL, _F, _A}, _T}} ->
+ type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L);
+ error ->
+ {Type, L}
+ end;
error ->
- {Type, []}
+ {Type, L}
end.
-type_from_form(Name, Args, TypeNames, RecDict, VarDict) ->
+type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) ->
ArgsLen = length(Args),
- ArgTypes = forms_to_types(Args, TypeNames, RecDict, VarDict),
- case lookup_type(Name, ArgsLen, RecDict) of
- {type, {_Module, Type, ArgNames}} ->
- TypeName = {type, Name, ArgsLen},
+ {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, _FileName, Form, ArgNames}, _Type}} ->
+ TypeName = {type, Module, Name, ArgsLen},
case can_unfold_more(TypeName, TypeNames) of
true ->
List = lists:zip(ArgNames, ArgTypes),
- TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [TypeName|TypeNames],
- RecDict, TmpVarDict),
- case lists:member(TypeName, R) of
- true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
- false -> {T, R}
- end;
- false -> {t_any(), [TypeName]}
+ TmpV = dict:from_list(List),
+ t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1);
+ false ->
+ {t_any(), L1}
end;
- {opaque, {Module, Type, ArgNames}} ->
- TypeName = {opaque, Name, ArgsLen},
- {Rep, Rret} =
+ {opaque, {{Module, _FileName, Form, ArgNames}, Type}} ->
+ TypeName = {opaque, Module, Name, ArgsLen},
+ {Rep, L2} =
case can_unfold_more(TypeName, TypeNames) of
true ->
List = lists:zip(ArgNames, ArgTypes),
- TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [TypeName|TypeNames],
- RecDict, TmpVarDict),
- case lists:member(TypeName, R) of
- true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
- false -> {T, R}
- end;
- false -> {t_any(), [TypeName]}
+ TmpV = dict:from_list(List),
+ t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1);
+ false -> {t_any(), L1}
end,
- Args2 = [subst_all_vars_to_any(ArgType) || ArgType <- ArgTypes],
- {skip_opaque_alias(Rep, Module, Name, Args2), Rret};
+ Rep1 = choose_opaque_type(Rep, Type),
+ Rep2 = case t_is_none(Rep1) of
+ true -> Rep1;
+ false ->
+ Args2 = [subst_all_vars_to_any(ArgType) ||
+ ArgType <- ArgTypes],
+ t_opaque(Module, Name, Args2, Rep1)
+ end,
+ {Rep2, L2};
error ->
Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]),
throw({error, Msg})
end.
-forms_to_types(Forms, TypeNames, RecDict, VarDict) ->
- {Types, _} = list_from_form(Forms, TypeNames, RecDict, VarDict),
- Types.
+remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) ->
+ {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L),
+ if
+ ET =:= replace_by_none ->
+ {t_none(), L1};
+ true ->
+ ArgsLen = length(Args),
+ case dict:find(RemMod, MR) of
+ error ->
+ self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
+ {t_any(), L1};
+ {ok, RemDict} ->
+ MFA = {RemMod, Name, ArgsLen},
+ case sets:is_element(MFA, ET) of
+ true ->
+ case lookup_type(Name, ArgsLen, RemDict) of
+ {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} ->
+ RemType = {type, RemMod, Name, ArgsLen},
+ case can_unfold_more(RemType, TypeNames) of
+ true ->
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpVarDict = dict:from_list(List),
+ NewTypeNames = [RemType|TypeNames],
+ t_from_form(Form, NewTypeNames, ET,
+ RemMod, MR, TmpVarDict, D, L1);
+ false ->
+ {t_any(), L1}
+ end;
+ {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} ->
+ RemType = {opaque, RemMod, Name, ArgsLen},
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpVarDict = dict:from_list(List),
+ {NewRep, L2} =
+ case can_unfold_more(RemType, TypeNames) of
+ true ->
+ NewTypeNames = [RemType|TypeNames],
+ t_from_form(Form, NewTypeNames, ET, RemMod, MR,
+ TmpVarDict, D, L1);
+ false ->
+ {t_any(), L1}
+ end,
+ NewRep1 = choose_opaque_type(NewRep, Type),
+ NewRep2 = case t_is_none(NewRep1) of
+ true -> NewRep1;
+ false -> t_opaque(Mod, Name, ArgTypes, NewRep1)
+ end,
+ {NewRep2, L2};
+ error ->
+ Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
+ [RemMod, Name]),
+ throw({error, Msg})
+ end;
+ false ->
+ self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
+ {t_any(), L1}
+ end
+ end
+ end.
-skip_opaque_alias(?opaque(_) = T, _Mod, _Name, _Args) -> T;
-skip_opaque_alias(T, Module, Name, Args) ->
- t_opaque(Module, Name, Args, T).
+%% Opaque types (both local and remote) are problematic when it comes
+%% to the limits (TypeNames, D, and L). The reason is that if any() is
+%% substituted for a more specialized subtype of an opaque type, the
+%% property stated along with decorate_with_opaque() (the type has to
+%% be a subtype of the declared type) no longer holds.
+%%
+%% The less than perfect remedy: if the opaque type created from a
+%% form is not a subset of the declared type, the declared type is
+%% used instead, effectively bypassing the limits, and potentially
+%% resulting in huge types.
+choose_opaque_type(Type, DeclType) ->
+ case
+ t_is_subtype(subst_all_vars_to_any(Type),
+ subst_all_vars_to_any(DeclType))
+ of
+ true -> Type;
+ false -> DeclType
+ end.
-record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) ->
+record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) ->
case can_unfold_more({record, Name}, TypeNames) of
true ->
- case lookup_record(Name, RecDict) of
+ {ok, R} = dict:find(M, MR),
+ case lookup_record(Name, R) of
{ok, DeclFields} ->
- TypeNames1 = [{record, Name}|TypeNames],
- AreTyped = [is_erl_type(FieldType)
- || {_FieldName, FieldType} <- DeclFields],
- {DeclFields1, R1} =
- case lists:all(fun(Elem) -> Elem end, AreTyped) of
- true -> {DeclFields, []};
- false -> fields_from_form(DeclFields, TypeNames1,
- RecDict, dict:new())
- end,
- {GetModRec, R2} = get_mod_record(ModFields, DeclFields1,
- TypeNames1,
- RecDict, VarDict),
+ NewTypeNames = [{record, Name}|TypeNames],
+ {GetModRec, L1} = get_mod_record(ModFields, DeclFields,
+ NewTypeNames, ET, M, MR, V, D, L),
case GetModRec of
{error, FieldName} ->
throw({error, io_lib:format("Illegal declaration of #~w{~w}\n",
[Name, FieldName])});
{ok, NewFields} ->
- {t_tuple(
- [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]]),
- R1 ++ R2}
+ {NewFields1, L2} =
+ fields_from_form(NewFields, NewTypeNames, ET, M, MR,
+ dict:new(), D, L1),
+ Rec = t_tuple(
+ [t_atom(Name)|[Type
+ || {_FieldName, Type} <- NewFields1]]),
+ {Rec, L2}
end;
error ->
throw({error, io_lib:format("Unknown record #~w{}\n", [Name])})
end;
- false -> {t_any(), []}
+ false ->
+ {t_any(), L}
end.
-get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) ->
- {{ok, DeclFields}, []};
-get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) ->
- DeclFieldsDict = orddict:from_list(DeclFields),
- {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames,
- RecDict, VarDict),
- case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of
- {error, _FieldName} = Error -> {Error, R};
- {ok, FinalOrdDict} ->
- {{ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)}
- || {FieldName, _} <- DeclFields]},
- R}
+get_mod_record([], DeclFields, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {{ok, DeclFields}, L};
+get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) ->
+ DeclFieldsDict = lists:keysort(1, DeclFields),
+ {ModFieldsDict, L1} =
+ build_field_dict(ModFields, TypeNames, ET, M, MR, V, D, L),
+ case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of
+ {error, _FieldName} = Error -> {Error, L1};
+ {ok, FinalKeyDict} ->
+ Fields = [lists:keyfind(FieldName, 1, FinalKeyDict)
+ || {FieldName, _, _} <- DeclFields],
+ {{ok, Fields}, L1}
end.
-build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) ->
- build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []).
-
-build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left],
- TypeNames, RecDict, VarDict, Acc) ->
- {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict),
- NewAcc = [{Name, T}|Acc],
- {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc),
- {D, R1 ++ R2};
-build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) ->
- {orddict:from_list(Acc), []}.
-
-get_mod_record([{FieldName, DeclType}|Left1],
- [{FieldName, ModType}|Left2], Acc) ->
- ModTypeNoVars = subst_all_vars_to_any(ModType),
- case
- contains_remote(ModTypeNoVars)
- orelse contains_remote(DeclType)
- orelse t_is_subtype(ModTypeNoVars, DeclType)
- of
- false -> {error, FieldName};
- true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
- end;
-get_mod_record([{FieldName1, _DeclType} = DT|Left1],
- [{FieldName2, _ModType}|_] = List2,
- Acc) when FieldName1 < FieldName2 ->
- get_mod_record(Left1, List2, [DT|Acc]);
-get_mod_record(DeclFields, [], Acc) ->
- {ok, orddict:from_list(Acc ++ DeclFields)};
-get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
+build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) ->
+ 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),
+ 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}|Left2],
+ Acc) ->
+ get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]);
+get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1],
+ [{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}|_], _Acc) ->
{error, FieldName2}.
-contains_remote(Type) ->
- TypeNoRemote = subst_all_remote(Type, t_none()),
- not t_is_equal(Type, TypeNoRemote).
-
-fields_from_form([], _TypeNames, _RecDict, _VarDict) ->
- {[], []};
-fields_from_form([{Name, Type}|Tail], TypeNames, RecDict,
- VarDict) ->
- {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict),
- {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict),
- {[{Name, T}|F], R1 ++ R2}.
-
-list_from_form([], _TypeNames, _RecDict, _VarDict) ->
- {[], []};
-list_from_form([H|Tail], TypeNames, RecDict, VarDict) ->
- {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict),
- {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict),
- {[T|L], R1 ++ R2}.
+%% It is important to create a limited version of the record type
+%% since nested record types can otherwise easily result in huge
+%% terms.
+fields_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {[], L};
+fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, M, MR,
+ V, D, L) ->
+ {T, L1} = t_from_form(Abstr, TypeNames, ET, M, MR, V, D, L),
+ {F, L2} = fields_from_form(Tail, TypeNames, ET, M, MR, V, D, L1),
+ {[{Name, T}|F], L2}.
+
+list_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ {[], L};
+list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) ->
+ {H1, L1} = t_from_form(H, TypeNames, ET, M, MR, V, D, L - 1),
+ {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 =/= '_' ->
+ [Name|t_var_names(L)];
+t_var_names([]) ->
+ [].
-spec t_form_to_string(parse_form()) -> string().
@@ -4592,7 +4544,7 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()";
t_form_to_string({type, _L, iolist, []}) -> "iolist()";
t_form_to_string({type, _L, list, [Type]}) ->
"[" ++ t_form_to_string(Type) ++ "]";
-t_form_to_string({type, _L, map, Args}) when not is_list(Args) ->
+t_form_to_string({type, _L, map, _}) ->
"#{}";
t_form_to_string({type, _L, mfa, []}) -> "mfa()";
t_form_to_string({type, _L, module, []}) -> "module()";
@@ -4623,12 +4575,21 @@ t_form_to_string({type, _L, tuple, Args}) ->
t_form_to_string({type, _L, union, Args}) ->
string:join(t_form_to_string_list(Args), " | ");
t_form_to_string({type, _L, Name, []} = T) ->
- try t_to_string(t_from_form(T))
+ try
+ M = mod,
+ D0 = dict:new(),
+ MR = dict:from_list([{M, D0}]),
+ {T1, _} =
+ t_from_form(T, [], sets:new(), M, MR, D0, _Deep=1000, _ALot=100000),
+ t_to_string(T1)
catch throw:{error, _} -> atom_to_string(Name) ++ "()"
end;
-t_form_to_string({type, _L, Name, List}) ->
+t_form_to_string({user_type, _L, Name, List}) ->
flat_format("~w(~s)",
- [Name, string:join(t_form_to_string_list(List), ",")]).
+ [Name, string:join(t_form_to_string_list(List), ",")]);
+t_form_to_string({type, L, Name, List}) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
+ t_form_to_string({user_type, L, Name, List}).
t_form_to_string_list(List) ->
t_form_to_string_list(List, []).
@@ -4671,13 +4632,13 @@ is_erl_type(#c{}) -> true;
is_erl_type(_) -> false.
-spec lookup_record(atom(), type_table()) ->
- 'error' | {'ok', [{atom(), parse_form() | erl_type()}]}.
+ 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
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;
@@ -4686,12 +4647,12 @@ lookup_record(Tag, RecDict) when is_atom(Tag) ->
end.
-spec lookup_record(atom(), arity(), type_table()) ->
- 'error' | {'ok', [{atom(), erl_type()}]}.
+ 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}.
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.
@@ -4738,30 +4699,6 @@ do_opaque(?union(List) = Type, Opaques, Pred) ->
do_opaque(Type, _Opaques, Pred) ->
Pred(Type).
-is_same_type_name(ModNameArgs, ModNameArgs) -> true;
-is_same_type_name({Mod, Name, Args1}, {Mod, Name, Args2}) ->
- all_any(Args1) orelse all_any(Args2);
-is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) ->
- is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2).
-
-all_any([]) -> true;
-all_any([T|L]) ->
- t_is_any(T) andalso all_any(L);
-all_any(_) -> false.
-
-%% Compatibility. In Erlang/OTP 17 the pre-defined opaque types
-%% digraph() and so on can be used, but there are also new types such
-%% as digraph:graph() with the exact same meaning. In Erlang/OTP R18.0
-%% all but the last clause can be removed.
-
-is_same_type_name2(digraph, digraph, [], digraph, graph, []) -> true;
-is_same_type_name2(digraph, graph, [], digraph, digraph, []) -> true;
-is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [_]) -> true;
-is_same_type_name2(gb_sets, set, [_], gb_sets, gb_set, []) -> true;
-is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true;
-is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true;
-is_same_type_name2(_, _, _, _, _, _) -> false.
-
map_keys(?map(Pairs)) ->
[K || {K, _} <- Pairs].
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 4691662f9f..3e099fcc25 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -1584,11 +1584,7 @@ gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) ->
end,
{[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1};
gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) ->
- TrueLabel = mk_label(new),
FailLbl = mk_label(new),
- IsMapCode = hipe_icode:mk_type([TempMapVar], map,
- hipe_icode:label_name(TrueLabel),
- hipe_icode:label_name(FailLbl)),
DstMapVar = mk_var(Dst),
{ReturnLbl, PutInstructions, Env1}
= case Op of
@@ -1596,10 +1592,10 @@ gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) ->
trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []);
exact ->
trans_put_map_exact(TempMapVar, DstMapVar,
- hipe_icode:label_name(FailLbl), Pairs, Env, [])
+ none, Pairs, Env, [])
end,
Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error),
- {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}.
+ {[PutInstructions, FailLbl, Fail, ReturnLbl], Env1}.
%%-----------------------------------------------------------------------
%% This function generates the instructions needed to insert several
@@ -1629,6 +1625,13 @@ trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) ->
ReturnLbl = mk_label(new),
GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)),
{ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env};
+trans_put_map_exact(MapVar, DestMapVar, none, [Key, Value | Rest], Env, Acc) ->
+ {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
+ {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1),
+ BifCallPut = hipe_icode:mk_call([MapVar], maps, update,
+ [KeyVar, ValVar, MapVar], remote),
+ Acc1 = [BifCallPut, MoveVal, MoveKey | Acc],
+ trans_put_map_exact(MapVar, DestMapVar, none, Rest, Env2, Acc1);
trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) ->
SuccLbl = mk_label(new),
{MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env),
diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl
index 0e50c9539b..3c24425828 100644
--- a/lib/hipe/llvm/hipe_llvm_main.erl
+++ b/lib/hipe/llvm/hipe_llvm_main.erl
@@ -465,7 +465,7 @@ remove_temp_folder(Dir, Options) ->
end.
unique_id(FunName, Arity) ->
- integer_to_list(erlang:phash2({FunName, Arity, now()})).
+ integer_to_list(erlang:phash2({FunName, Arity, erlang:unique_integer()})).
unique_folder(FunName, Arity, Options) ->
DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/",
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index e81212d4dc..7b6d9e30e3 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2015. 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
@@ -223,5 +223,5 @@
{registered,[]},
{applications, [kernel,stdlib]},
{env, []},
- {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","kernel-3.0",
- "erts-6.0","compiler-5.0"]}]}.
+ {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.5","kernel-3.0",
+ "erts-7.0","compiler-5.0"]}]}.
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'.
diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl
index af8903904b..a36a024980 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_match.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl
@@ -697,13 +697,22 @@ get_binary_bytes(Binary, BinSize, Base, Offset, Orig,
%%%%%%%%%%%%%%%%%%%%%%%%% UTILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
get_base(Orig,Base) ->
- [HeapLbl,REFCLbl,EndLbl] = create_lbls(3),
+ [HeapLbl,REFCLbl,WritableLbl,NotWritableLbl,EndLbl] = create_lbls(5),
+ Flags = hipe_rtl:mk_new_reg_gcsafe(),
+
[hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl),
hipe_rtl:label_name(REFCLbl)),
HeapLbl,
hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)),
hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)),
REFCLbl,
+ get_field_from_term({proc_bin, flags}, Orig, Flags),
+ hipe_rtl:mk_branch(Flags, 'ne', hipe_rtl:mk_imm(0),
+ hipe_rtl:label_name(WritableLbl),
+ hipe_rtl:label_name(NotWritableLbl)),
+ WritableLbl,
+ hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'),
+ NotWritableLbl,
hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)),
EndLbl].
diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl
index 8194d878b8..7bc93a316b 100644
--- a/lib/hipe/test/bs_SUITE_data/bs_match.erl
+++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl
@@ -12,7 +12,8 @@
test() ->
Funs = [fun test_aligned/0, fun test_unaligned/0,
- fun test_zero_tail/0, fun test_integer_matching/0],
+ fun test_zero_tail/0, fun test_integer_matching/0,
+ fun test_writable_bin/0],
lists:foreach(fun (F) -> ok = F() end, Funs).
%%-------------------------------------------------------------------
@@ -173,3 +174,14 @@ test_dynamic_integer_matching(N) ->
<<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>,
<<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>,
ok.
+
+test_writable_bin() ->
+ test_writable_bin(<<>>, 0),
+ ok.
+
+test_writable_bin(Bin, 128) ->
+ Bin;
+test_writable_bin(Bin0, N) when N < 128 ->
+ Bin1 = <<Bin0/binary, N>>,
+ <<_/utf8, _/binary>> = Bin1,
+ test_writable_bin(Bin1, N+1).
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
index 25c8e5d4c7..3cd2d90dfb 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl
@@ -17,9 +17,9 @@ test() ->
false = map_is_size(M#{ "c" => 2}, 2),
%% Error cases.
- {'EXIT',{badarg,_}} = (catch map_size([])),
- {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)),
- {'EXIT',{badarg,_}} = (catch map_size(1)),
+ {'EXIT',{{badmap,[]},_}} = (catch map_size([])),
+ {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_size(<<1,2,3>>)),
+ {'EXIT',{{badmap,1},_}} = (catch map_size(1)),
ok.
map_is_size(M,N) when map_size(M) =:= N -> true;
diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
index 31abf15d49..ccacbfe5c8 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl
@@ -10,23 +10,25 @@ test() ->
false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}),
%% key order
- true = id(#{ a => 1 }) < id(#{ b => 1}),
- false = id(#{ b => 1 }) < id(#{ a => 1}),
- true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}),
- true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}),
- true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}),
- true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}),
- false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}),
- false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}),
- false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}),
+ true = #{ a => 1 } < id(#{ b => 1}),
+ false = #{ b => 1 } < id(#{ a => 1}),
+ true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}),
+ true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}),
+ true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}),
+ true = #{ "a" => 1 } < id(#{ <<"a">> => 1}),
+ false = #{ <<"a">> => 1 } < id(#{ "a" => 1}),
+ true = #{ 1 => 1 } < id(#{ 1.0 => 1}),
+ false = #{ 1.0 => 1 } < id(#{ 1 => 1}),
%% value order
- true = id(#{ a => 1 }) < id(#{ a => 2}),
- false = id(#{ a => 2 }) < id(#{ a => 1}),
- false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}),
- true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}),
+ true = #{ a => 1 } < id(#{ a => 2}),
+ false = #{ a => 2 } < id(#{ a => 1}),
+ false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}),
+ true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}),
+ false = #{ a => 1 } < id(#{ a => 1.0}),
+ false = #{ a => 1.0 } < id(#{ a => 1}),
- true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}),
+ true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}),
%% lists:sort
@@ -34,7 +36,6 @@ test() ->
[#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs),
[#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)),
-
ok.
%% Use this function to avoid compile-time evaluation of an expression.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
index 72ac9ce078..2fe4f204d1 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl
@@ -8,7 +8,7 @@ test() ->
true = assoc_guard(#{}),
false = assoc_guard(not_a_map),
#{a := true} = assoc_update(#{}),
- {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}}
+ {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}}
= (catch assoc_update(not_a_map)),
ok = assoc_guard_clause(#{}),
{'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}}
diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
index 1cfcd80180..3c85289a36 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl
@@ -9,9 +9,9 @@ test() ->
false = exact_guard(not_a_map),
true = exact_guard(#{a => false}),
#{a := true} = exact_update(#{a => false}),
- {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ {'EXIT', {{badmap, not_a_map}, [{?MODULE, exact_update, 1, _}|_]}}
= (catch exact_update(not_a_map)),
- {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}}
+ {'EXIT', {{badkey, a}, [{?MODULE, exact_update, 1, _}|_]}}
= (catch exact_update(#{})),
ok = exact_guard_clause(#{a => yes}),
{'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}}
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
index cc7c1353de..99228a1927 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl
@@ -14,7 +14,7 @@ test() ->
%% Errors cases.
BadMap = id(badmap),
- {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+ {'EXIT',{{badmap,badmap},_}} = (catch BadMap#{nonexisting=>val}),
ok.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
index 6e5acb3283..1c38820a7c 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl
@@ -21,11 +21,11 @@ test() ->
1.0 => new_val4 },
%% Errors cases.
- {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })),
- {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
- {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
- {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
- {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ {'EXIT',{{badmap,nil},_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{{badkey,_},_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{{badkey,_},_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
ok.
%% Use this function to avoid compile-time evaluation of an expression.
diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
index 181e3f18f7..213fc33d97 100644
--- a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
+++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl
@@ -23,9 +23,9 @@ test() ->
#{ "a" := b } = F(),
- %% Error cases, FIXME: should be 'badmap'?
- {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
- {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }),
+ %% Error cases.
+ {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }),
+ {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }),
ok.
%% Use this function to avoid compile-time evaluation of an expression.
diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl
index 03cc358f17..5f44bc066d 100644
--- a/lib/hipe/tools/hipe_timer.erl
+++ b/lib/hipe/tools/hipe_timer.erl
@@ -46,27 +46,27 @@ tr(F) ->
{R,{WT-EWT,(RT-ERT)/1000}}.
empty_time() ->
- {WT1,WT2,WT3} = erlang:now(),
+ WTA = erlang:monotonic_time(),
{A,_} = erlang:statistics(runtime),
- {WT12,WT22,WT32} = erlang:now(),
+ WTB = erlang:monotonic_time(),
{B,_} = erlang:statistics(runtime),
- {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+ {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}.
time(F) ->
- {WT1,WT2,WT3} = erlang:now(),
+ WTA = erlang:monotonic_time(),
{A,_} = erlang:statistics(runtime),
F(),
- {WT12,WT22,WT32} = erlang:now(),
+ WTB = erlang:monotonic_time(),
{B,_} = erlang:statistics(runtime),
- {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}.
+ {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}.
timer(F) ->
- {WT1,WT2,WT3} = erlang:now(),
+ WTA = erlang:monotonic_time(),
{A,_} = erlang:statistics(runtime),
R = F(),
- {WT12,WT22,WT32} = erlang:now(),
+ WTB = erlang:monotonic_time(),
{B,_} = erlang:statistics(runtime),
- {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}.
+ {R,{(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}}.
advanced(_Fun, I) when I < 2 -> false;
advanced(Fun, Iterations) ->
diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk
index 60b4e0559b..e507ae933f 100644
--- a/lib/hipe/vsn.mk
+++ b/lib/hipe/vsn.mk
@@ -1 +1 @@
-HIPE_VSN = 3.11.3
+HIPE_VSN = 3.12
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-01 01:21:34 +0000