aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe')
-rw-r--r--lib/hipe/cerl/erl_types.erl213
1 files changed, 141 insertions, 72 deletions
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 14335cf635..d39f350c0f 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,
@@ -581,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().
@@ -747,14 +747,15 @@ 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),
%% 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)].
@@ -2605,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).
@@ -2624,13 +2625,13 @@ combine(S, T1, T2) ->
#opaque{mod = Mod1, name = Name1, args = Args1} = T1,
#opaque{mod = Mod2, name = Name2, args = Args2} = T2,
Comb1 = comb(Mod1, Name1, Args1, S, T1),
- case is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) of
+ 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
+ case can_combine_opaque_names(Mod, Name, Args, S) of
true ->
?opaque(Set) = S,
Set;
@@ -2638,17 +2639,17 @@ comb(Mod, Name, Args, S, T) ->
[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,
@@ -2659,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,
@@ -2675,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) ->
@@ -2785,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.
@@ -2797,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) ->
@@ -2807,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};
@@ -4189,7 +4205,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 +4219,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 +4229,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
@@ -4224,17 +4240,19 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) ->
false -> {t_any(), L1}
end,
Rep1 = choose_opaque_type(Rep, Type),
- Args2 = [subst_all_vars_to_any(ArgType) || ArgType <- ArgTypes],
- {skip_opaque_alias(Rep1, Module, Name, Args2), L2};
+ 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.
-skip_opaque_alias(?opaque(_) = T, _Mod, _Name, _Args) -> T;
-skip_opaque_alias(T, Module, Name, Args) ->
- t_opaque(Module, Name, Args, T).
-
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
@@ -4251,7 +4269,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 +4281,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),
@@ -4277,7 +4295,11 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) ->
{t_any(), L1}
end,
NewRep1 = choose_opaque_type(NewRep, Type),
- {skip_opaque_alias(NewRep1, Mod, Name, ArgTypes), L2};
+ 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]),
@@ -4358,34 +4380,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 +4418,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 +4636,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 +4651,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.
@@ -4619,17 +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(_ModNameArgs1, _ModNameArgs2) ->
- false.
-
-all_any([]) -> true;
-all_any([T|L]) ->
- t_is_any(T) andalso all_any(L);
-all_any(_) -> false.
-
map_keys(?map(Pairs)) ->
[K || {K, _} <- Pairs].
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-27 14:17:20 +0000