aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/cerl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe/cerl')
-rw-r--r--lib/hipe/cerl/cerl_cconv.erl2
-rw-r--r--lib/hipe/cerl/erl_types.erl105
2 files changed, 77 insertions, 30 deletions
diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl
index 122e6ef039..2cd0e261d5 100644
--- a/lib/hipe/cerl/cerl_cconv.erl
+++ b/lib/hipe/cerl/cerl_cconv.erl
@@ -258,7 +258,7 @@ bind_module_defs([], Env, S) ->
check_function_name(Name, S) ->
case s__is_function_name(Name, S) of
true ->
- error_msg("multiple definitions of function `~w'.", [Name]),
+ error_msg("multiple definitions of function `~tw'.", [Name]),
exit(error);
false ->
ok
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 0883a69918..abb6c259f6 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -74,6 +74,7 @@
t_form_to_string/1,
t_from_form/6,
t_from_form_without_remote/3,
+ t_from_form_check_remote/4,
t_check_record_fields/6,
t_from_range/2,
t_from_range_unsafe/2,
@@ -1629,8 +1630,8 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) ->
%% * The keys in Pairs are singleton types.
%% * The values of Pairs must not be unit, and may only be none if the
%% mandatoriness tag is 'optional'.
-%% * Optional must contain no pair {K,V} s.t. K is a subtype of DefaultKey and
-%% V is equal to DefaultKey.
+%% * There is no pair {K, 'optional', V} in Pairs s.t.
+%% K is a subtype of DefaultKey and V is equal to DefaultValue.
%% * DefaultKey must be the empty type iff DefaultValue is the empty type.
%% * DefaultKey must not be a singleton type.
%% * For every key K in Pairs, DefaultKey - K must not be representable; i.e.
@@ -4471,7 +4472,7 @@ t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) ->
%% Replace external types with with none().
-spec t_from_form_without_remote(parse_form(), site(), type_table()) ->
- {erl_type(), cache()}.
+ erl_type().
t_from_form_without_remote(Form, Site, TypeTable) ->
Module = site_module(Site),
@@ -4480,38 +4481,57 @@ t_from_form_without_remote(Form, Site, TypeTable) ->
VarTab = var_table__new(),
Cache0 = cache__new(),
Cache = Cache0#cache{mod_recs = {mrecs, ModRecs}},
- t_from_form1(Form, ExpTypes, Site, undefined, VarTab, Cache).
-
-%% 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, _} = t_from_form1(Form, ExpTypes, Site, undefined, VarTab, Cache),
+ Type.
-type expand_limit() :: integer().
-type expand_depth() :: integer().
--record(from_form, {site :: site(),
+-record(from_form, {site :: site() | {'check', mta()},
xtypes :: sets:set(mfa()) | 'replace_by_none',
mrecs :: 'undefined' | mod_type_table(),
vtab :: var_table(),
tnames :: type_names()}).
+-spec t_from_form_check_remote(parse_form(), sets:set(mfa()), mta(),
+ mod_type_table()) -> 'ok'.
+t_from_form_check_remote(Form, ExpTypes, MTA, RecDict) ->
+ State = #from_form{site = {check, MTA},
+ xtypes = ExpTypes,
+ mrecs = RecDict,
+ vtab = var_table__new(),
+ tnames = []},
+ D = (1 bsl 25), % unlimited
+ L = (1 bsl 25),
+ Cache0 = cache__new(),
+ _ = t_from_form2(Form, State, D, L, Cache0),
+ ok.
+
+%% 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.
+
-spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none',
site(), 'undefined' | mod_type_table(), var_table(),
cache()) -> {erl_type(), cache()}.
t_from_form1(Form, ET, Site, MR, V, C) ->
TypeNames = initial_typenames(Site),
+ D = ?EXPAND_DEPTH,
+ L = ?EXPAND_LIMIT,
State = #from_form{site = Site,
xtypes = ET,
mrecs = MR,
vtab = V,
tnames = TypeNames},
- L = ?EXPAND_LIMIT,
- {T0, L0, C0} = from_form(Form, State, ?EXPAND_DEPTH, L, C),
+ t_from_form2(Form, State, D, L, C).
+
+t_from_form2(Form, State, D, L, C) ->
+ {T0, L0, C0} = from_form(Form, State, D, L, C),
if
L0 =< 0 ->
{T1, _, C1} = from_form(Form, State, 1, L, C0),
@@ -4655,7 +4675,8 @@ from_form({type, _L, map, List}, S, D0, L, C) ->
end
end(List, L, C),
try
- {Pairs, DefK, DefV} = map_from_form(Pairs1, [], [], [], ?none, ?none),
+ Pairs2 = singleton_elements(Pairs1),
+ {Pairs, DefK, DefV} = map_from_form(Pairs2, [], [], [], ?none, ?none),
{t_map(Pairs, DefK, DefV), L5, C5}
catch none -> {t_none(), L5, C5}
end;
@@ -4767,14 +4788,18 @@ type_from_form(Name, Args, S, D, L, C) ->
case can_unfold_more(TypeName, TypeNames) of
true ->
{R, C1} = lookup_module_types(Module, MR, C),
- type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames,
+ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site,
S, D, L, C1);
false ->
{t_any(), L, C}
end.
-type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) ->
+type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site,
+ S, D, L, C) ->
case lookup_type(Name, ArgsLen, R) of
+ {_, {_, _}} when element(1, Site) =:= check ->
+ {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C),
+ {t_any(), L1, C1};
{Tag, {{Module, _FileName, Form, ArgNames}, Type}} ->
NewTypeNames = [TypeName|TypeNames],
S1 = S#from_form{tnames = NewTypeNames},
@@ -4813,7 +4838,7 @@ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) ->
end.
remote_from_form(RemMod, Name, Args, S, D, L, C) ->
- #from_form{xtypes = ET, mrecs = MR, tnames = TypeNames} = S,
+ #from_form{site = Site, xtypes = ET, mrecs = MR, tnames = TypeNames} = S,
if
ET =:= replace_by_none ->
{t_none(), L, C};
@@ -4831,7 +4856,7 @@ remote_from_form(RemMod, Name, Args, S, D, L, C) ->
case can_unfold_more(RemType, TypeNames) of
true ->
remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict,
- RemType, TypeNames, S, D, L, C1);
+ RemType, TypeNames, Site, S, D, L, C1);
false ->
{t_any(), L, C1}
end;
@@ -4843,14 +4868,16 @@ remote_from_form(RemMod, Name, Args, S, D, L, C) ->
end.
remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames,
- S, D, L, C) ->
+ Site, S, D, L, C) ->
case lookup_type(Name, ArgsLen, RemDict) of
+ {_, {_, _}} when element(1, Site) =:= check ->
+ {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C),
+ {t_any(), L1, C1};
{Tag, {{Mod, _FileLine, Form, ArgNames}, Type}} ->
NewTypeNames = [RemType|TypeNames],
S1 = S#from_form{tnames = NewTypeNames},
{ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C),
CKey = cache_key(RemMod, Name, ArgTypes, TypeNames, D),
- %% case error of
case cache_find(CKey, C) of
{CachedType, DeltaL} ->
{CachedType, L - DeltaL, C};
@@ -4914,6 +4941,8 @@ record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) ->
M = site_module(Site),
{R, C1} = lookup_module_types(M, MR, C),
case lookup_record(Name, R) of
+ {ok, _} when element(1, Site) =:= check ->
+ {t_any(), L0, C1};
{ok, DeclFields} ->
NewTypeNames = [RecordType|TypeNames],
Site1 = {record, {M, Name, length(DeclFields)}},
@@ -4998,6 +5027,30 @@ list_from_form([H|Tail], S, D, L, C) ->
{T1, L2, C2} = list_from_form(Tail, S, D, L1, C1),
{[H1|T1], L2, C2}.
+%% Separates singleton types in keys (see is_singleton_type/1).
+singleton_elements([]) ->
+ [];
+singleton_elements([{K,?mand,V}=Pair|Pairs]) ->
+ case is_singleton_type(K) of
+ true ->
+ [Pair|singleton_elements(Pairs)];
+ false ->
+ singleton_elements([{K,?opt,V}|Pairs])
+ end;
+singleton_elements([{Key0,MNess,Val}|Pairs]) ->
+ [{Key,MNess,Val} || Key <- separate_key(Key0)] ++ singleton_elements(Pairs).
+
+%% To be in sync with is_singleton_type/1.
+%% Does not separate tuples and maps as doing that has potential
+%% to be very expensive.
+separate_key(?atom(Atoms)) when Atoms =/= ?any ->
+ [t_atom(A) || A <- Atoms];
+separate_key(?number(_, _) = T) ->
+ t_elements(T);
+separate_key(?union(List)) ->
+ lists:append([separate_key(K) || K <- List, not t_is_none(K)]);
+separate_key(Key) -> [Key].
+
%% Sorts, combines non-singleton pairs, and applies precendence and
%% mandatoriness rules.
map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) ->
@@ -5447,7 +5500,8 @@ t_is_singleton(Type) ->
t_is_singleton(Type, Opaques) ->
do_opaque(Type, Opaques, fun is_singleton_type/1).
-%% Incomplete; not all representable singleton types are included.
+%% To be in sync with separate_key/1.
+%% Used to also recognize maps and tuples.
is_singleton_type(?nil) -> true;
is_singleton_type(?atom(?any)) -> false;
is_singleton_type(?atom(Set)) ->
@@ -5455,13 +5509,6 @@ is_singleton_type(?atom(Set)) ->
is_singleton_type(?int_range(V, V)) -> true;
is_singleton_type(?int_set(Set)) ->
ordsets:size(Set) =:= 1;
-is_singleton_type(?tuple(Types, Arity, _)) when is_integer(Arity) ->
- lists:all(fun is_singleton_type/1, Types);
-is_singleton_type(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) ->
- is_singleton_type(OnlyTuple);
-is_singleton_type(?map(Pairs, ?none, ?none)) ->
- lists:all(fun({_,MNess,V}) -> MNess =:= ?mand andalso is_singleton_type(V)
- end, Pairs);
is_singleton_type(_) ->
false.
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-04 14:49:48 +0000