%% -*- erlang-indent-level: 2 -*- %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% %% @copyright 2000-2003 Richard Carlsson, 2006-2009 Tobias Lindahl %% @author Richard Carlsson %% @author Tobias Lindahl %% @author Kostis Sagonas %% @author Manouk Manoukian %% @doc Provides a representation of Erlang types. %% The initial author of this file is Richard Carlsson (2000-2004). %% In July 2006, the type representation was totally re-designed by %% Tobias Lindahl. This is the representation which is used currently. %% In late 2008, Manouk Manoukian and Kostis Sagonas added support for %% opaque types to the structure-based representation of types. %% During February and March 2009, Kostis Sagonas significantly %% cleaned up the type representation and added spec declarations. -module(erl_types). -export([any_none/1, any_none_or_unit/1, lookup_record/3, max/2, min/2, number_max/1, number_max/2, number_min/1, number_min/2, t_abstract_records/2, t_any/0, t_arity/0, t_atom/0, t_atom/1, t_atoms/1, t_atom_vals/1, t_atom_vals/2, t_binary/0, t_bitstr/0, t_bitstr/2, t_bitstr_base/1, t_bitstr_concat/1, t_bitstr_concat/2, t_bitstr_match/2, t_bitstr_unit/1, t_bitstrlist/0, t_boolean/0, t_byte/0, t_char/0, t_collect_vars/1, t_cons/0, t_cons/2, t_cons_hd/1, t_cons_hd/2, t_cons_tl/1, t_cons_tl/2, t_contains_opaque/1, t_contains_opaque/2, t_decorate_with_opaque/3, t_elements/1, t_find_opaque_mismatch/3, t_find_unknown_opaque/3, t_fixnum/0, t_non_neg_fixnum/0, t_pos_fixnum/0, t_float/0, t_var_names/1, 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, t_from_term/1, t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_args/2, t_fun_arity/1, t_fun_arity/2, t_fun_range/1, t_fun_range/2, t_has_opaque_subtype/2, t_has_var/1, t_identifier/0, %% t_improper_list/2, t_inf/1, t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, t_integer/0, t_integer/1, t_non_neg_integer/0, t_pos_integer/0, t_integers/1, t_iodata/0, t_iolist/0, t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_any_atom/2, t_is_any_atom/3, t_is_binary/1, t_is_binary/2, t_is_bitstr/1, t_is_bitstr/2, t_is_bitwidth/1, t_is_boolean/1, t_is_boolean/2, t_is_byte/1, t_is_char/1, t_is_cons/1, t_is_cons/2, t_is_equal/2, t_is_fixnum/1, t_is_float/1, t_is_float/2, t_is_fun/1, t_is_fun/2, t_is_identifier/1, t_is_instance/2, t_is_integer/1, t_is_integer/2, t_is_list/1, t_is_map/1, t_is_map/2, t_is_matchstate/1, t_is_nil/1, t_is_nil/2, t_is_non_neg_integer/1, t_is_none/1, t_is_none_or_unit/1, t_is_number/1, t_is_number/2, t_is_opaque/1, t_is_opaque/2, t_is_pid/1, t_is_pid/2, t_is_port/1, t_is_port/2, t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, t_is_reference/1, t_is_reference/2, t_is_singleton/1, t_is_singleton/2, t_is_string/1, t_is_subtype/2, t_is_tuple/1, t_is_tuple/2, t_is_unit/1, t_is_var/1, t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_list_elements/2, t_list_termination/1, t_list_termination/2, t_map/0, t_map/1, t_map/3, t_map_entries/2, t_map_entries/1, t_map_def_key/2, t_map_def_key/1, t_map_def_val/2, t_map_def_val/1, t_map_get/2, t_map_get/3, t_map_is_key/2, t_map_is_key/3, t_map_update/2, t_map_update/3, t_map_pairwise_merge/4, t_map_put/2, t_map_put/3, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, t_matchstate_slot/2, t_matchstate_slots/1, t_matchstate_update_present/2, t_matchstate_update_slot/3, t_mfa/0, t_module/0, t_nil/0, t_node/0, t_none/0, t_nonempty_list/0, t_nonempty_list/1, t_nonempty_string/0, t_number/0, t_number/1, t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, t_opaque_structure/1, t_pid/0, t_port/0, t_maybe_improper_list/0, %% t_maybe_improper_list/2, t_product/1, t_reference/0, t_singleton_to_term/2, t_string/0, t_struct_from_opaque/2, t_subst/2, t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2, t_timeout/0, t_to_string/1, t_to_string/2, t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_args/2, t_tuple_size/1, t_tuple_size/2, t_tuple_sizes/1, t_tuple_subtypes/1, t_tuple_subtypes/2, t_unify/2, t_unit/0, t_unopaque/1, t_unopaque/2, t_var/1, t_var_name/1, t_widen_to_number/1, %% t_assign_variables_to_subtype/2, type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, atom_to_string/1, var_table__new/0, cache__new/0 ]). -compile({no_auto_import,[min/2,max/2,map_get/2]}). -export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). %%-define(DEBUG, true). -ifdef(DEBUG). -define(debug(__A), __A). -else. -define(debug(__A), ok). -endif. %%============================================================================= %% %% Definition of the type structure %% %%============================================================================= %%----------------------------------------------------------------------------- %% Limits %% -define(REC_TYPE_LIMIT, 2). -define(EXPAND_DEPTH, 16). -define(EXPAND_LIMIT, 10000). -define(TUPLE_TAG_LIMIT, 5). -define(TUPLE_ARITY_LIMIT, 8). -define(SET_LIMIT, 13). -define(MAX_BYTE, 255). -define(MAX_CHAR, 16#10ffff). -define(UNIT_MULTIPLIER, 8). -define(TAG_IMMED1_SIZE, 4). -define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE). -define(MAX_TUPLE_SIZE, (1 bsl 10)). %%----------------------------------------------------------------------------- %% Type tags and qualifiers %% -define(atom_tag, atom). -define(binary_tag, binary). -define(function_tag, function). -define(identifier_tag, identifier). -define(list_tag, list). -define(map_tag, map). -define(matchstate_tag, matchstate). -define(nil_tag, nil). -define(number_tag, number). -define(opaque_tag, opaque). -define(product_tag, product). -define(tuple_set_tag, tuple_set). -define(tuple_tag, tuple). -define(union_tag, union). -define(var_tag, var). -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag | ?opaque_tag | ?product_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. -define(float_qual, float). -define(integer_qual, integer). -define(nonempty_qual, nonempty). -define(pid_qual, pid). -define(port_qual, port). -define(reference_qual, reference). -define(unknown_qual, unknown). -type qual() :: ?float_qual | ?integer_qual | ?nonempty_qual | ?pid_qual | ?port_qual | ?reference_qual | ?unknown_qual | {_, _}. %%----------------------------------------------------------------------------- %% The type representation %% -define(any, any). -define(none, none). -define(unit, unit). %% Generic constructor - elements can be many things depending on the tag. -record(c, {tag :: tag(), elements = [] :: term(), qualifier = ?unknown_qual :: qual()}). -opaque erl_type() :: ?any | ?none | ?unit | #c{}. %%----------------------------------------------------------------------------- %% Auxiliary types and convenient macros %% -type parse_form() :: erl_parse:abstract_type(). -type rng_elem() :: 'pos_inf' | 'neg_inf' | integer(). -record(int_set, {set :: [integer()]}). -record(int_rng, {from :: rng_elem(), to :: rng_elem()}). %% Note: the definition of #opaque{} was changed to 'mod' and 'name'; %% it used to be an ordsets of {Mod, Name} pairs. The Dialyzer version %% was updated to 2.7 due to this change. -record(opaque, {mod :: module(), name :: atom(), args = [] :: [erl_type()], struct :: erl_type()}). -define(atom(Set), #c{tag=?atom_tag, elements=Set}). -define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}). -define(float, ?number(?any, ?float_qual)). -define(function(Domain, Range), #c{tag=?function_tag, elements=[Domain, Range]}). -define(identifier(Types), #c{tag=?identifier_tag, elements=Types}). -define(integer(Types), ?number(Types, ?integer_qual)). -define(int_range(From, To), ?integer(#int_rng{from=From, to=To})). -define(int_set(Set), ?integer(#int_set{set=Set})). -define(list(Types, Term, Size), #c{tag=?list_tag, elements=[Types,Term], qualifier=Size}). -define(nil, #c{tag=?nil_tag}). -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, qualifier=Qualifier}). -define(map(Pairs,DefKey,DefVal), #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, qualifier={Arity, Qual}}). -define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}). -define(var(Id), #c{tag=?var_tag, elements=Id}). -define(matchstate(P, Slots), #c{tag=?matchstate_tag, elements=[P,Slots]}). -define(any_matchstate, ?matchstate(t_bitstr(), ?any)). -define(byte, ?int_range(0, ?MAX_BYTE)). -define(char, ?int_range(0, ?MAX_CHAR)). -define(integer_pos, ?int_range(1, pos_inf)). -define(integer_non_neg, ?int_range(0, pos_inf)). -define(integer_neg, ?int_range(neg_inf, -1)). -type opaques() :: [erl_type()] | 'universe'. -type file_line() :: {file:name(), erl_anno:line()}. -type record_key() :: {'record', atom()}. -type type_key() :: {'type' | 'opaque', mfa()}. -type field() :: {atom(), erl_parse:abstract_expr(), erl_type()}. -type record_value() :: {file_line(), [{RecordSize :: non_neg_integer(), [field()]}]}. -type type_value() :: {{module(), file_line(), erl_parse:abstract_type(), ArgNames :: [atom()]}, erl_type()}. -type type_table() :: #{record_key() | type_key() => record_value() | type_value()}. -opaque var_table() :: #{atom() => erl_type()}. %%----------------------------------------------------------------------------- %% Unions %% -define(union(List), #c{tag=?union_tag, elements=[_,_,_,_,_,_,_,_,_,_]=List}). -define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none,?none])). -define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none,?none])). -define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none,?none])). -define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none,?none])). -define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none,?none])). -define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none,?none])). -define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). -define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). -define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). -define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). %%============================================================================= %% %% Primitive operations such as type construction and type tests %% %%============================================================================= %%----------------------------------------------------------------------------- %% Top and bottom %% -spec t_any() -> erl_type(). t_any() -> ?any. -spec t_is_any(erl_type()) -> boolean(). t_is_any(Type) -> do_opaque(Type, 'universe', fun is_any/1). is_any(?any) -> true; is_any(_) -> false. -spec t_none() -> erl_type(). t_none() -> ?none. -spec t_is_none(erl_type()) -> boolean(). t_is_none(?none) -> true; t_is_none(_) -> false. %%----------------------------------------------------------------------------- %% Opaque types %% -spec t_opaque(module(), atom(), [_], erl_type()) -> erl_type(). t_opaque(Mod, Name, Args, Struct) -> O = #opaque{mod = Mod, name = Name, args = Args, struct = Struct}, ?opaque(set_singleton(O)). -spec t_is_opaque(erl_type(), [erl_type()]) -> boolean(). t_is_opaque(?opaque(_) = Type, Opaques) -> not is_opaque_type(Type, Opaques); t_is_opaque(_Type, _Opaques) -> false. -spec t_is_opaque(erl_type()) -> boolean(). t_is_opaque(?opaque(_)) -> true; t_is_opaque(_) -> false. -spec t_has_opaque_subtype(erl_type(), opaques()) -> boolean(). t_has_opaque_subtype(Type, Opaques) -> do_opaque(Type, Opaques, fun has_opaque_subtype/1). has_opaque_subtype(?union(Ts)) -> lists:any(fun t_is_opaque/1, Ts); has_opaque_subtype(T) -> t_is_opaque(T). -spec t_opaque_structure(erl_type()) -> erl_type(). t_opaque_structure(?opaque(Elements)) -> t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]). -spec t_contains_opaque(erl_type()) -> boolean(). t_contains_opaque(Type) -> t_contains_opaque(Type, []). %% Returns 'true' iff there is an opaque type that is *not* one of %% the types of the second argument. -spec t_contains_opaque(erl_type(), [erl_type()]) -> boolean(). t_contains_opaque(?any, _Opaques) -> false; t_contains_opaque(?none, _Opaques) -> false; t_contains_opaque(?unit, _Opaques) -> false; t_contains_opaque(?atom(_Set), _Opaques) -> false; t_contains_opaque(?bitstr(_Unit, _Base), _Opaques) -> false; t_contains_opaque(?float, _Opaques) -> false; t_contains_opaque(?function(Domain, Range), Opaques) -> t_contains_opaque(Domain, Opaques) orelse t_contains_opaque(Range, Opaques); t_contains_opaque(?identifier(_Types), _Opaques) -> false; t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?integer(_Types), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); t_contains_opaque(?map(_, _, _) = Map, Opaques) -> list_contains_opaque(map_all_types(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; t_contains_opaque(?opaque(_)=T, Opaques) -> not is_opaque_type(T, Opaques) orelse t_contains_opaque(t_opaque_structure(T)); t_contains_opaque(?product(Types), Opaques) -> list_contains_opaque(Types, Opaques); t_contains_opaque(?tuple(?any, _, _), _Opaques) -> false; t_contains_opaque(?tuple(Types, _, _), Opaques) -> list_contains_opaque(Types, Opaques); t_contains_opaque(?tuple_set(_Set) = T, Opaques) -> list_contains_opaque(t_tuple_subtypes(T), Opaques); t_contains_opaque(?union(List), Opaques) -> list_contains_opaque(List, Opaques); t_contains_opaque(?var(_Id), _Opaques) -> false. -spec list_contains_opaque([erl_type()], [erl_type()]) -> boolean(). list_contains_opaque(List, Opaques) -> lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List). %% t_find_opaque_mismatch/2 of two types should only be used if their %% t_inf is t_none() due to some opaque type violation. However, %% 'error' is returned if a structure mismatch is found. %% %% The first argument of the function is the pattern and its second %% argument the type we are matching against the pattern. -spec t_find_opaque_mismatch(erl_type(), erl_type(), [erl_type()]) -> 'error' | {'ok', erl_type(), erl_type()}. t_find_opaque_mismatch(T1, T2, Opaques) -> try t_find_opaque_mismatch(T1, T2, T2, Opaques) catch throw:error -> error end. t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error; t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error); t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) -> t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques); t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) -> case is_opaque_type(T2, Opaques) of false -> case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of true -> error; false -> {ok, TopType, T2} end; true -> t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques) end; t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) -> %% The generated message is somewhat misleading: case is_opaque_type(T1, Opaques) of false -> case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of true -> error; false -> {ok, TopType, T1} end; true -> t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques) end; t_find_opaque_mismatch(?product(T1), ?product(T2), TopType, Opaques) -> t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), TopType, Opaques) -> t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, TopType, Opaques) -> Tuples1 = t_tuple_subtypes(T1), Tuples2 = t_tuple_subtypes(T2), t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques); t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) -> t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques); t_find_opaque_mismatch(T1, T2, _TopType, Opaques) -> case t_is_none(t_inf(T1, T2, Opaques)) of false -> error; true -> throw(error) end. t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> List = lists:zipwith(fun(T1, T2) -> t_find_opaque_mismatch(T1, T2, TopType, Opaques) end, L1, L2), t_find_opaque_mismatch_list(List). t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) -> List = [try t_find_opaque_mismatch(T1, T2, T2, Opaques) catch throw:error -> error end || T1 <- L1, T2 <- L2], t_find_opaque_mismatch_list(List). t_find_opaque_mismatch_list([]) -> throw(error); t_find_opaque_mismatch_list([H|T]) -> case H of {ok, _T1, _T2} -> H; error -> t_find_opaque_mismatch_list(T) end. -spec t_find_unknown_opaque(erl_type(), erl_type(), opaques()) -> [pos_integer()]. %% The nice thing about using two types and t_inf() as compared to %% 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. t_find_unknown_opaque(_T1, _T2, 'universe') -> []; t_find_unknown_opaque(T1, T2, Opaques) -> try t_inf(T1, T2, {match, Opaques}) of _ -> [] catch throw:{pos, Ns} -> Ns end. -spec t_decorate_with_opaque(erl_type(), erl_type(), [erl_type()]) -> erl_type(). %% The first argument can contain opaque types. The second argument %% is assumed to be taken from the contract. t_decorate_with_opaque(T1, T2, Opaques) -> case Opaques =:= [] orelse t_is_equal(T1, T2) orelse not t_contains_opaque(T2) of true -> T1; false -> T = t_inf(T1, T2), case t_contains_opaque(T) of false -> T1; true -> R = decorate(T1, T, Opaques), ?debug(case catch not t_is_equal(t_unopaque(R), t_unopaque(T1)) orelse t_is_equal(T1, T) andalso not t_is_equal(T1, R) of false -> ok; _ -> io:format("T1 = ~p,\n", [T1]), io:format("T2 = ~p,\n", [T2]), io:format("O = ~p,\n", [Opaques]), io:format("erl_types:t_decorate_with_opaque(T1,T2,O).\n"), throw({error, "Failed to handle opaque types"}) end), R end end. decorate(Type, ?none, _Opaques) -> Type; decorate(?function(Domain, Range), ?function(D, R), Opaques) -> ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques)); decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) -> ?list(decorate(Types, Ts, Opaques), decorate(Tail, Tl, Opaques), Size); decorate(?product(Types), ?product(Ts), Opaques) -> ?product(list_decorate(Types, Ts, Opaques)); decorate(?tuple(_, _, _)=T, ?tuple(?any, _, _), _Opaques) -> T; decorate(?tuple(?any, _, _)=T, ?tuple(_, _, _), _Opaques) -> T; decorate(?tuple(Types, Arity, Tag), ?tuple(Ts, Arity, _), Opaques) -> ?tuple(list_decorate(Types, Ts, Opaques), Arity, Tag); decorate(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> decorate_tuple_sets(List, [{Arity, [T]}], Opaques); decorate(?tuple_set(List), ?tuple_set(L), Opaques) -> decorate_tuple_sets(List, L, Opaques); decorate(?union(List), T, Opaques) when T =/= ?any -> ?union(L) = force_union(T), union_decorate(List, L, Opaques); decorate(T, ?union(L), Opaques) when T =/= ?any -> ?union(List) = force_union(T), union_decorate(List, L, Opaques); decorate(Type, ?opaque(_)=T, Opaques) -> decorate_with_opaque(Type, T, Opaques); decorate(Type, _T, _Opaques) -> Type. %% Note: it is important that #opaque.struct is a subtype of the %% opaque type. decorate_with_opaque(Type, ?opaque(Set2), Opaques) -> case decoration(set_to_list(Set2), Type, Opaques, [], false) of {[], false} -> Type; {List, All} when List =/= [] -> NewType = sup_opaque(List), case All of true -> NewType; false -> t_sup(NewType, Type) end end. decoration([#opaque{struct = S} = Opaque|OpaqueTypes], Type, Opaques, NewOpaqueTypes0, All) -> IsOpaque = is_opaque_type2(Opaque, Opaques), I = t_inf(Type, S), case not IsOpaque orelse t_is_none(I) of true -> decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes0, All); false -> NewI = decorate(I, S, Opaques), NewOpaque = combine(NewI, [Opaque]), NewAll = All orelse t_is_equal(I, Type), NewOpaqueTypes = NewOpaque ++ NewOpaqueTypes0, decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes, NewAll) end; decoration([], _Type, _Opaques, NewOpaqueTypes, All) -> {NewOpaqueTypes, All}. -spec list_decorate([erl_type()], [erl_type()], opaques()) -> [erl_type()]. list_decorate(List, L, Opaques) -> [decorate(Elem, E, Opaques) || {Elem, E} <- lists:zip(List, L)]. union_decorate(U1, U2, Opaques) -> Union = union_decorate(U1, U2, Opaques, 0, []), [A,B,F,I,L,N,T,M,_,Map] = U1, [_,_,_,_,_,_,_,_,Opaque,_] = U2, List = [A,B,F,I,L,N,T,M,Map], DecList = [Dec || E <- List, not t_is_none(E), not t_is_none(Dec = decorate(E, Opaque, Opaques))], t_sup([Union|DecList]). union_decorate([?none|Left1], [_|Left2], Opaques, N, Acc) -> union_decorate(Left1, Left2, Opaques, N, [?none|Acc]); union_decorate([T1|Left1], [?none|Left2], Opaques, N, Acc) -> union_decorate(Left1, Left2, Opaques, N+1, [T1|Acc]); union_decorate([T1|Left1], [T2|Left2], Opaques, N, Acc) -> union_decorate(Left1, Left2, Opaques, N+1, [decorate(T1, T2, Opaques)|Acc]); union_decorate([], [], _Opaques, N, Acc) -> if N =:= 0 -> ?none; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], Type; N >= 2 -> ?union(lists:reverse(Acc)) end. decorate_tuple_sets(List, L, Opaques) -> decorate_tuple_sets(List, L, Opaques, []). decorate_tuple_sets([{Arity, Tuples}|List], [{Arity, Ts}|L], Opaques, Acc) -> DecTs = decorate_tuples_in_sets(Tuples, Ts, Opaques), decorate_tuple_sets(List, L, Opaques, [{Arity, DecTs}|Acc]); decorate_tuple_sets([ArTup|List], L, Opaques, Acc) -> decorate_tuple_sets(List, L, Opaques, [ArTup|Acc]); decorate_tuple_sets([], _L, _Opaques, Acc) -> ?tuple_set(lists:reverse(Acc)). decorate_tuples_in_sets([?tuple(Elements, _, ?any)], Ts, Opaques) -> NewList = [list_decorate(Elements, Es, Opaques) || ?tuple(Es, _, _) <- Ts], case t_sup([t_tuple(Es) || Es <- NewList]) of ?tuple_set([{_Arity, Tuples}]) -> Tuples; ?tuple(_, _, _)=Tuple -> [Tuple] end; decorate_tuples_in_sets(Tuples, Ts, Opaques) -> decorate_tuples_in_sets(Tuples, Ts, Opaques, []). decorate_tuples_in_sets([?tuple(Elements, Arity, Tag1) = T1|Tuples] = L1, [?tuple(Es, Arity, Tag2)|Ts] = L2, Opaques, Acc) -> if Tag1 < Tag2 -> decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]); Tag1 > Tag2 -> decorate_tuples_in_sets(L1, Ts, Opaques, Acc); Tag1 =:= Tag2 -> NewElements = list_decorate(Elements, Es, Opaques), NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc], decorate_tuples_in_sets(Tuples, Ts, Opaques, NewAcc) end; decorate_tuples_in_sets([T1|Tuples], L2, Opaques, Acc) -> decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]); decorate_tuples_in_sets([], _L, _Opaques, Acc) -> lists:reverse(Acc). -spec t_opaque_from_records(type_table()) -> [erl_type()]. t_opaque_from_records(RecMap) -> OpaqueRecMap = maps:filter(fun(Key, _Value) -> case Key of {opaque, _Name, _Arity} -> true; _ -> false end end, RecMap), OpaqueTypeMap = maps:map(fun({opaque, Name, _Arity}, {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), %% TmpVarTab = maps:to_list(List), %% Rep = t_from_form(Type, RecDict, TmpVarTab), Rep = t_any(), % not used for anything right now Args = [t_any() || _ <- ArgNames], t_opaque(Module, Name, Args, Rep) end, OpaqueRecMap), [OpaqueType || {_Key, OpaqueType} <- maps:to_list(OpaqueTypeMap)]. %% Decompose opaque instances of type arg2 to structured types, in arg1 %% XXX: Same as t_unopaque -spec t_struct_from_opaque(erl_type(), [erl_type()]) -> erl_type(). t_struct_from_opaque(?function(Domain, Range), Opaques) -> ?function(t_struct_from_opaque(Domain, Opaques), t_struct_from_opaque(Range, Opaques)); t_struct_from_opaque(?list(Types, Term, Size), Opaques) -> ?list(t_struct_from_opaque(Types, Opaques), t_struct_from_opaque(Term, Opaques), Size); t_struct_from_opaque(?opaque(_) = T, Opaques) -> case is_opaque_type(T, Opaques) of true -> t_opaque_structure(T); false -> T end; t_struct_from_opaque(?product(Types), Opaques) -> ?product(list_struct_from_opaque(Types, Opaques)); t_struct_from_opaque(?tuple(?any, _, _) = T, _Opaques) -> T; t_struct_from_opaque(?tuple(Types, Arity, Tag), Opaques) -> ?tuple(list_struct_from_opaque(Types, Opaques), Arity, Tag); t_struct_from_opaque(?tuple_set(Set), Opaques) -> NewSet = [{Sz, [t_struct_from_opaque(T, Opaques) || T <- Tuples]} || {Sz, Tuples} <- Set], ?tuple_set(NewSet); t_struct_from_opaque(?union(List), Opaques) -> t_sup(list_struct_from_opaque(List, Opaques)); t_struct_from_opaque(Type, _Opaques) -> Type. list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. %% -spec t_unit() -> erl_type(). t_unit() -> ?unit. -spec t_is_unit(erl_type()) -> boolean(). t_is_unit(?unit) -> true; t_is_unit(_) -> false. -spec t_is_none_or_unit(erl_type()) -> boolean(). t_is_none_or_unit(?none) -> true; t_is_none_or_unit(?unit) -> true; t_is_none_or_unit(_) -> false. %%----------------------------------------------------------------------------- %% Atoms and the derived type boolean %% -spec t_atom() -> erl_type(). t_atom() -> ?atom(?any). -spec t_atom(atom()) -> erl_type(). t_atom(A) when is_atom(A) -> ?atom(set_singleton(A)). -spec t_atoms([atom()]) -> erl_type(). t_atoms(List) when is_list(List) -> t_sup([t_atom(A) || A <- List]). -spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. t_atom_vals(Type) -> t_atom_vals(Type, 'universe'). -spec t_atom_vals(erl_type(), opaques()) -> 'unknown' | [atom(),...]. t_atom_vals(Type, Opaques) -> do_opaque(Type, Opaques, fun atom_vals/1). atom_vals(?atom(?any)) -> unknown; atom_vals(?atom(Set)) -> set_to_list(Set); atom_vals(?opaque(_)) -> unknown; atom_vals(Other) -> ?atom(_) = Atm = t_inf(t_atom(), Other), atom_vals(Atm). -spec t_is_atom(erl_type()) -> boolean(). t_is_atom(Type) -> t_is_atom(Type, 'universe'). -spec t_is_atom(erl_type(), opaques()) -> boolean(). t_is_atom(Type, Opaques) -> do_opaque(Type, Opaques, fun is_atom1/1). is_atom1(?atom(_)) -> true; is_atom1(_) -> false. -spec t_is_any_atom(atom(), erl_type()) -> boolean(). t_is_any_atom(Atom, SomeAtomsType) -> t_is_any_atom(Atom, SomeAtomsType, 'universe'). -spec t_is_any_atom(atom(), erl_type(), opaques()) -> boolean(). t_is_any_atom(Atom, SomeAtomsType, Opaques) -> do_opaque(SomeAtomsType, Opaques, fun(AtomsType) -> is_any_atom(Atom, AtomsType) end). is_any_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false; is_any_atom(Atom, ?atom(Set)) when is_atom(Atom) -> set_is_singleton(Atom, Set); is_any_atom(Atom, _) when is_atom(Atom) -> false. %%------------------------------------ -spec t_is_boolean(erl_type()) -> boolean(). t_is_boolean(Type) -> t_is_boolean(Type, 'universe'). -spec t_is_boolean(erl_type(), opaques()) -> boolean(). t_is_boolean(Type, Opaques) -> do_opaque(Type, Opaques, fun is_boolean/1). -spec t_boolean() -> erl_type(). t_boolean() -> ?atom(set_from_list([false, true])). is_boolean(?atom(?any)) -> false; is_boolean(?atom(Set)) -> case set_size(Set) of 1 -> set_is_element(true, Set) orelse set_is_element(false, Set); 2 -> set_is_element(true, Set) andalso set_is_element(false, Set); N when is_integer(N), N > 2 -> false end; is_boolean(_) -> false. %%----------------------------------------------------------------------------- %% Binaries %% -spec t_binary() -> erl_type(). t_binary() -> ?bitstr(8, 0). -spec t_is_binary(erl_type()) -> boolean(). t_is_binary(Type) -> t_is_binary(Type, 'universe'). -spec t_is_binary(erl_type(), opaques()) -> boolean(). t_is_binary(Type, Opaques) -> do_opaque(Type, Opaques, fun is_binary/1). is_binary(?bitstr(U, B)) -> ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0); is_binary(_) -> false. %%----------------------------------------------------------------------------- %% Bitstrings %% -spec t_bitstr() -> erl_type(). t_bitstr() -> ?bitstr(1, 0). -spec t_bitstr(non_neg_integer(), non_neg_integer()) -> erl_type(). t_bitstr(U, B) -> NewB = if U =:= 0 -> B; B >= (U * (?UNIT_MULTIPLIER + 1)) -> (B rem U) + U * ?UNIT_MULTIPLIER; true -> B end, ?bitstr(U, NewB). -spec t_bitstr_unit(erl_type()) -> non_neg_integer(). t_bitstr_unit(?bitstr(U, _)) -> U. -spec t_bitstr_base(erl_type()) -> non_neg_integer(). t_bitstr_base(?bitstr(_, B)) -> B. -spec t_bitstr_concat([erl_type()]) -> erl_type(). t_bitstr_concat(List) -> t_bitstr_concat_1(List, t_bitstr(0, 0)). t_bitstr_concat_1([T|Left], Acc) -> t_bitstr_concat_1(Left, t_bitstr_concat(Acc, T)); t_bitstr_concat_1([], Acc) -> Acc. -spec t_bitstr_concat(erl_type(), erl_type()) -> erl_type(). t_bitstr_concat(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), bitstr_concat(t_unopaque(T1p), t_unopaque(T2p)). -spec t_bitstr_match(erl_type(), erl_type()) -> erl_type(). t_bitstr_match(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), bitstr_match(t_unopaque(T1p), t_unopaque(T2p)). -spec t_is_bitstr(erl_type()) -> boolean(). t_is_bitstr(Type) -> t_is_bitstr(Type, 'universe'). -spec t_is_bitstr(erl_type(), opaques()) -> boolean(). t_is_bitstr(Type, Opaques) -> do_opaque(Type, Opaques, fun is_bitstr/1). is_bitstr(?bitstr(_, _)) -> true; is_bitstr(_) -> false. %%----------------------------------------------------------------------------- %% Matchstates %% -spec t_matchstate() -> erl_type(). t_matchstate() -> ?any_matchstate. -spec t_matchstate(erl_type(), non_neg_integer()) -> erl_type(). t_matchstate(Init, 0) -> ?matchstate(Init, Init); t_matchstate(Init, Max) when is_integer(Max) -> Slots = [Init|[?none || _ <- lists:seq(1, Max)]], ?matchstate(Init, t_product(Slots)). -spec t_is_matchstate(erl_type()) -> boolean(). t_is_matchstate(?matchstate(_, _)) -> true; t_is_matchstate(_) -> false. -spec t_matchstate_present(erl_type()) -> erl_type(). t_matchstate_present(Type) -> case t_inf(t_matchstate(), Type) of ?matchstate(P, _) -> P; _ -> ?none end. -spec t_matchstate_slot(erl_type(), non_neg_integer()) -> erl_type(). t_matchstate_slot(Type, Slot) -> RealSlot = Slot + 1, case t_inf(t_matchstate(), Type) of ?matchstate(_, ?any) -> ?any; ?matchstate(_, ?product(Vals)) when length(Vals) >= RealSlot -> lists:nth(RealSlot, Vals); ?matchstate(_, ?product(_)) -> ?none; ?matchstate(_, SlotType) when RealSlot =:= 1 -> SlotType; _ -> ?none end. -spec t_matchstate_slots(erl_type()) -> erl_type(). t_matchstate_slots(?matchstate(_, Slots)) -> Slots. -spec t_matchstate_update_present(erl_type(), erl_type()) -> erl_type(). t_matchstate_update_present(New, Type) -> case t_inf(t_matchstate(), Type) of ?matchstate(_, Slots) -> ?matchstate(New, Slots); _ -> ?none end. -spec t_matchstate_update_slot(erl_type(), erl_type(), non_neg_integer()) -> erl_type(). t_matchstate_update_slot(New, Type, Slot) -> RealSlot = Slot + 1, case t_inf(t_matchstate(), Type) of ?matchstate(Pres, Slots) -> NewSlots = case Slots of ?any -> ?any; ?product(Vals) when length(Vals) >= RealSlot -> NewTuple = setelement(RealSlot, list_to_tuple(Vals), New), NewVals = tuple_to_list(NewTuple), ?product(NewVals); ?product(_) -> ?none; _ when RealSlot =:= 1 -> New; _ -> ?none end, ?matchstate(Pres, NewSlots); _ -> ?none end. %%----------------------------------------------------------------------------- %% Functions %% -spec t_fun() -> erl_type(). t_fun() -> ?function(?any, ?any). -spec t_fun(erl_type()) -> erl_type(). t_fun(Range) -> ?function(?any, Range). -spec t_fun([erl_type()] | arity(), erl_type()) -> erl_type(). t_fun(Domain, Range) when is_list(Domain) -> ?function(?product(Domain), Range); t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 -> ?function(?product(lists:duplicate(Arity, ?any)), Range). -spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()]. t_fun_args(Type) -> t_fun_args(Type, 'universe'). -spec t_fun_args(erl_type(), opaques()) -> 'unknown' | [erl_type()]. t_fun_args(Type, Opaques) -> do_opaque(Type, Opaques, fun fun_args/1). fun_args(?function(?any, _)) -> unknown; fun_args(?function(?product(Domain), _)) when is_list(Domain) -> Domain. -spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer(). t_fun_arity(Type) -> t_fun_arity(Type, 'universe'). -spec t_fun_arity(erl_type(), opaques()) -> 'unknown' | non_neg_integer(). t_fun_arity(Type, Opaques) -> do_opaque(Type, Opaques, fun fun_arity/1). fun_arity(?function(?any, _)) -> unknown; fun_arity(?function(?product(Domain), _)) -> length(Domain). -spec t_fun_range(erl_type()) -> erl_type(). t_fun_range(Type) -> t_fun_range(Type, 'universe'). -spec t_fun_range(erl_type(), opaques()) -> erl_type(). t_fun_range(Type, Opaques) -> do_opaque(Type, Opaques, fun fun_range/1). fun_range(?function(_, Range)) -> Range. -spec t_is_fun(erl_type()) -> boolean(). t_is_fun(Type) -> t_is_fun(Type, 'universe'). -spec t_is_fun(erl_type(), opaques()) -> boolean(). t_is_fun(Type, Opaques) -> do_opaque(Type, Opaques, fun is_fun/1). is_fun(?function(_, _)) -> true; is_fun(_) -> false. %%----------------------------------------------------------------------------- %% Identifiers. Includes ports, pids and refs. %% -spec t_identifier() -> erl_type(). t_identifier() -> ?identifier(?any). -spec t_is_identifier(erl_type()) -> boolean(). t_is_identifier(?identifier(_)) -> true; t_is_identifier(_) -> false. %%------------------------------------ -spec t_port() -> erl_type(). t_port() -> ?identifier(set_singleton(?port_qual)). -spec t_is_port(erl_type()) -> boolean(). t_is_port(Type) -> t_is_port(Type, 'universe'). -spec t_is_port(erl_type(), opaques()) -> boolean(). t_is_port(Type, Opaques) -> do_opaque(Type, Opaques, fun is_port1/1). is_port1(?identifier(?any)) -> false; is_port1(?identifier(Set)) -> set_is_singleton(?port_qual, Set); is_port1(_) -> false. %%------------------------------------ -spec t_pid() -> erl_type(). t_pid() -> ?identifier(set_singleton(?pid_qual)). -spec t_is_pid(erl_type()) -> boolean(). t_is_pid(Type) -> t_is_pid(Type, 'universe'). -spec t_is_pid(erl_type(), opaques()) -> boolean(). t_is_pid(Type, Opaques) -> do_opaque(Type, Opaques, fun is_pid1/1). is_pid1(?identifier(?any)) -> false; is_pid1(?identifier(Set)) -> set_is_singleton(?pid_qual, Set); is_pid1(_) -> false. %%------------------------------------ -spec t_reference() -> erl_type(). t_reference() -> ?identifier(set_singleton(?reference_qual)). -spec t_is_reference(erl_type()) -> boolean(). t_is_reference(Type) -> t_is_reference(Type, 'universe'). -spec t_is_reference(erl_type(), opaques()) -> boolean(). t_is_reference(Type, Opaques) -> do_opaque(Type, Opaques, fun is_reference1/1). is_reference1(?identifier(?any)) -> false; is_reference1(?identifier(Set)) -> set_is_singleton(?reference_qual, Set); is_reference1(_) -> false. %%----------------------------------------------------------------------------- %% Numbers are divided into floats, integers, chars and bytes. %% -spec t_number() -> erl_type(). t_number() -> ?number(?any, ?unknown_qual). -spec t_number(integer()) -> erl_type(). t_number(X) when is_integer(X) -> t_integer(X). -spec t_is_number(erl_type()) -> boolean(). t_is_number(Type) -> t_is_number(Type, 'universe'). -spec t_is_number(erl_type(), opaques()) -> boolean(). t_is_number(Type, Opaques) -> do_opaque(Type, Opaques, fun is_number/1). is_number(?number(_, _)) -> true; is_number(_) -> false. %% Currently, the type system collapses all floats to ?float and does %% not keep any information about their values. As a result, the list %% that this function returns contains only integers. -spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...]. t_number_vals(Type) -> t_number_vals(Type, 'universe'). -spec t_number_vals(erl_type(), opaques()) -> 'unknown' | [integer(),...]. t_number_vals(Type, Opaques) -> do_opaque(Type, Opaques, fun number_vals/1). number_vals(?int_set(Set)) -> set_to_list(Set); number_vals(?number(_, _)) -> unknown; number_vals(?opaque(_)) -> unknown; number_vals(Other) -> Inf = t_inf(Other, t_number()), false = t_is_none(Inf), % sanity check number_vals(Inf). %%------------------------------------ -spec t_float() -> erl_type(). t_float() -> ?float. -spec t_is_float(erl_type()) -> boolean(). t_is_float(Type) -> t_is_float(Type, 'universe'). -spec t_is_float(erl_type(), opaques()) -> boolean(). t_is_float(Type, Opaques) -> do_opaque(Type, Opaques, fun is_float1/1). is_float1(?float) -> true; is_float1(_) -> false. %%------------------------------------ -spec t_integer() -> erl_type(). t_integer() -> ?integer(?any). -spec t_integer(integer()) -> erl_type(). t_integer(I) when is_integer(I) -> ?int_set(set_singleton(I)). -spec t_integers([integer()]) -> erl_type(). t_integers(List) when is_list(List) -> t_sup([t_integer(I) || I <- List]). -spec t_is_integer(erl_type()) -> boolean(). t_is_integer(Type) -> t_is_integer(Type, 'universe'). -spec t_is_integer(erl_type(), opaques()) -> boolean(). t_is_integer(Type, Opaques) -> do_opaque(Type, Opaques, fun is_integer1/1). is_integer1(?integer(_)) -> true; is_integer1(_) -> false. %%------------------------------------ -spec t_byte() -> erl_type(). t_byte() -> ?byte. -spec t_is_byte(erl_type()) -> boolean(). t_is_byte(?int_range(neg_inf, _)) -> false; t_is_byte(?int_range(_, pos_inf)) -> false; t_is_byte(?int_range(From, To)) when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_BYTE -> true; t_is_byte(?int_set(Set)) -> (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_BYTE); t_is_byte(_) -> false. %%------------------------------------ -spec t_char() -> erl_type(). t_char() -> ?char. -spec t_is_char(erl_type()) -> boolean(). t_is_char(?int_range(neg_inf, _)) -> false; t_is_char(?int_range(_, pos_inf)) -> false; t_is_char(?int_range(From, To)) when is_integer(From), From >= 0, is_integer(To), To =< ?MAX_CHAR -> true; t_is_char(?int_set(Set)) -> (set_min(Set) >= 0) andalso (set_max(Set) =< ?MAX_CHAR); t_is_char(_) -> false. %%----------------------------------------------------------------------------- %% Lists %% -spec t_cons() -> erl_type(). t_cons() -> ?nonempty_list(?any, ?any). %% Note that if the tail argument can be a list, we must collapse the %% content of the list to include both the content of the tail list %% and the head of the cons. If for example the tail argument is any() %% then there can be any list in the tail and the content of the %% returned list must be any(). -spec t_cons(erl_type(), erl_type()) -> erl_type(). t_cons(?none, _) -> ?none; t_cons(_, ?none) -> ?none; t_cons(?unit, _) -> ?none; t_cons(_, ?unit) -> ?none; t_cons(Hd, ?nil) -> ?nonempty_list(Hd, ?nil); t_cons(Hd, ?list(Contents, Termination, _)) -> ?nonempty_list(t_sup(Contents, Hd), Termination); t_cons(Hd, Tail) -> case cons_tail(t_inf(Tail, t_maybe_improper_list())) of ?list(Contents, Termination, _Size) -> %% Collapse the list part of the termination but keep the %% non-list part intact. NewTermination = t_sup(t_subtract(Tail, t_maybe_improper_list()), Termination), ?nonempty_list(t_sup(Hd, Contents), NewTermination); ?nil -> ?nonempty_list(Hd, Tail); ?none -> ?nonempty_list(Hd, Tail); ?unit -> ?none end. cons_tail(Type) -> do_opaque(Type, 'universe', fun(T) -> T end). -spec t_is_cons(erl_type()) -> boolean(). t_is_cons(Type) -> t_is_cons(Type, 'universe'). -spec t_is_cons(erl_type(), opaques()) -> boolean(). t_is_cons(Type, Opaques) -> do_opaque(Type, Opaques, fun is_cons/1). is_cons(?nonempty_list(_, _)) -> true; is_cons(_) -> false. -spec t_cons_hd(erl_type()) -> erl_type(). t_cons_hd(Type) -> t_cons_hd(Type, 'universe'). -spec t_cons_hd(erl_type(), opaques()) -> erl_type(). t_cons_hd(Type, Opaques) -> do_opaque(Type, Opaques, fun cons_hd/1). cons_hd(?nonempty_list(Contents, _Termination)) -> Contents. -spec t_cons_tl(erl_type()) -> erl_type(). t_cons_tl(Type) -> t_cons_tl(Type, 'universe'). -spec t_cons_tl(erl_type(), opaques()) -> erl_type(). t_cons_tl(Type, Opaques) -> do_opaque(Type, Opaques, fun cons_tl/1). cons_tl(?nonempty_list(_Contents, Termination) = T) -> t_sup(Termination, T). -spec t_nil() -> erl_type(). t_nil() -> ?nil. -spec t_is_nil(erl_type()) -> boolean(). t_is_nil(Type) -> t_is_nil(Type, 'universe'). -spec t_is_nil(erl_type(), opaques()) -> boolean(). t_is_nil(Type, Opaques) -> do_opaque(Type, Opaques, fun is_nil/1). is_nil(?nil) -> true; is_nil(_) -> false. -spec t_list() -> erl_type(). t_list() -> ?list(?any, ?nil, ?unknown_qual). -spec t_list(erl_type()) -> erl_type(). t_list(?none) -> ?none; t_list(?unit) -> ?none; t_list(Contents) -> ?list(Contents, ?nil, ?unknown_qual). -spec t_list_elements(erl_type()) -> erl_type(). t_list_elements(Type) -> t_list_elements(Type, 'universe'). -spec t_list_elements(erl_type(), opaques()) -> erl_type(). t_list_elements(Type, Opaques) -> do_opaque(Type, Opaques, fun list_elements/1). list_elements(?list(Contents, _, _)) -> Contents; list_elements(?nil) -> ?none. -spec t_list_termination(erl_type(), opaques()) -> erl_type(). t_list_termination(Type, Opaques) -> do_opaque(Type, Opaques, fun t_list_termination/1). -spec t_list_termination(erl_type()) -> erl_type(). t_list_termination(?nil) -> ?nil; t_list_termination(?list(_, Term, _)) -> Term. -spec t_is_list(erl_type()) -> boolean(). t_is_list(?list(_Contents, ?nil, _)) -> true; t_is_list(?nil) -> true; t_is_list(_) -> false. -spec t_nonempty_list() -> erl_type(). t_nonempty_list() -> t_cons(?any, ?nil). -spec t_nonempty_list(erl_type()) -> erl_type(). t_nonempty_list(Type) -> t_cons(Type, ?nil). -spec t_nonempty_string() -> erl_type(). t_nonempty_string() -> t_nonempty_list(t_char()). -spec t_string() -> erl_type(). t_string() -> t_list(t_char()). -spec t_is_string(erl_type()) -> boolean(). t_is_string(X) -> t_is_list(X) andalso t_is_char(t_list_elements(X)). -spec t_maybe_improper_list() -> erl_type(). t_maybe_improper_list() -> ?list(?any, ?any, ?unknown_qual). %% Should only be used if you know what you are doing. See t_cons/2 -spec t_maybe_improper_list(erl_type(), erl_type()) -> erl_type(). t_maybe_improper_list(_Content, ?unit) -> ?none; t_maybe_improper_list(?unit, _Termination) -> ?none; t_maybe_improper_list(Content, Termination) -> %% Safety check: would be nice to have but does not work with remote types %% true = t_is_subtype(t_nil(), Termination), ?list(Content, Termination, ?unknown_qual). -spec t_is_maybe_improper_list(erl_type()) -> boolean(). t_is_maybe_improper_list(Type) -> t_is_maybe_improper_list(Type, 'universe'). -spec t_is_maybe_improper_list(erl_type(), opaques()) -> boolean(). t_is_maybe_improper_list(Type, Opaques) -> do_opaque(Type, Opaques, fun is_maybe_improper_list/1). is_maybe_improper_list(?list(_, _, _)) -> true; is_maybe_improper_list(?nil) -> true; is_maybe_improper_list(_) -> false. %% %% Should only be used if you know what you are doing. See t_cons/2 %% -spec t_improper_list(erl_type(), erl_type()) -> erl_type(). %% %% t_improper_list(?unit, _Termination) -> ?none; %% t_improper_list(_Content, ?unit) -> ?none; %% t_improper_list(Content, Termination) -> %% %% Safety check: would be nice to have but does not work with remote types %% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). -spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type(). lift_list_to_pos_empty(Type, Opaques) -> do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1). -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). lift_list_to_pos_empty(?nil) -> ?nil; lift_list_to_pos_empty(?list(Content, Termination, _)) -> ?list(Content, Termination, ?unknown_qual). -spec t_widen_to_number(erl_type()) -> erl_type(). %% Widens integers and floats to t_number(). %% Used by erl_bif_types:key_comparison_fail(). t_widen_to_number(?any) -> ?any; t_widen_to_number(?none) -> ?none; t_widen_to_number(?unit) -> ?unit; t_widen_to_number(?atom(_Set) = T) -> T; t_widen_to_number(?bitstr(_Unit, _Base) = T) -> T; t_widen_to_number(?float) -> t_number(); t_widen_to_number(?function(Domain, Range)) -> ?function(t_widen_to_number(Domain), t_widen_to_number(Range)); t_widen_to_number(?identifier(_Types) = T) -> T; t_widen_to_number(?int_range(_From, _To)) -> t_number(); t_widen_to_number(?int_set(_Set)) -> t_number(); t_widen_to_number(?integer(_Types)) -> t_number(); t_widen_to_number(?list(Type, Tail, Size)) -> ?list(t_widen_to_number(Type), t_widen_to_number(Tail), Size); t_widen_to_number(?map(Pairs, DefK, DefV)) -> L = [{t_widen_to_number(K), MNess, t_widen_to_number(V)} || {K, MNess, V} <- Pairs], t_map(L, t_widen_to_number(DefK), t_widen_to_number(DefV)); t_widen_to_number(?matchstate(_P, _Slots) = T) -> T; t_widen_to_number(?nil) -> ?nil; t_widen_to_number(?number(_Set, _Tag)) -> t_number(); t_widen_to_number(?opaque(Set)) -> L = [Opaque#opaque{struct = t_widen_to_number(S)} || #opaque{struct = S} = Opaque <- set_to_list(Set)], ?opaque(ordsets:from_list(L)); t_widen_to_number(?product(Types)) -> ?product(list_widen_to_number(Types)); t_widen_to_number(?tuple(?any, _, _) = T) -> T; t_widen_to_number(?tuple(Types, Arity, Tag)) -> ?tuple(list_widen_to_number(Types), Arity, Tag); t_widen_to_number(?tuple_set(_) = Tuples) -> t_sup([t_widen_to_number(T) || T <- t_tuple_subtypes(Tuples)]); t_widen_to_number(?union(List)) -> ?union(list_widen_to_number(List)); t_widen_to_number(?var(_Id)= T) -> T. list_widen_to_number(List) -> [t_widen_to_number(E) || E <- List]. %%----------------------------------------------------------------------------- %% Maps %% %% Representation: %% ?map(Pairs, DefaultKey, DefaultValue) %% %% Pairs is a sorted dictionary of types with a mandatoriness tag on each pair %% (t_map_dict()). DefaultKey and DefaultValue are plain types. %% %% A map M belongs to this type iff %% For each pair {KT, mandatory, VT} in Pairs, there exists a pair {K, V} in M %% such that K \in KT and V \in VT. %% For each pair {KT, optional, VT} in Pairs, either there exists no key K in %% M s.t. K in KT, or there exists a pair {K, V} in M such that K \in KT and %% V \in VT. %% For each remaining pair {K, V} in M (where remaining means that there is no %% key KT in Pairs s.t. K \in KT), K \in DefaultKey and V \in DefaultValue. %% %% Invariants: %% * 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'. %% * 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. %% t_subtract(DefaultKey, K) must return DefaultKey. %% * For every pair {K, 'optional', ?none} in Pairs, K must be a subtype of %% DefaultKey. %% * Pairs must be sorted and not contain any duplicate keys. %% %% These invariants ensure that equal map types are represented by equal terms. -define(mand, mandatory). -define(opt, optional). -type t_map_mandatoriness() :: ?mand | ?opt. -type t_map_pair() :: {erl_type(), t_map_mandatoriness(), erl_type()}. -type t_map_dict() :: [t_map_pair()]. -spec t_map() -> erl_type(). t_map() -> t_map([], t_any(), t_any()). -spec t_map([{erl_type(), erl_type()}]) -> erl_type(). t_map(L) -> lists:foldl(fun t_map_put/2, t_map(), L). -spec t_map(t_map_dict(), erl_type(), erl_type()) -> erl_type(). t_map(Pairs0, DefK0, DefV0) -> DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0), {DefK2, DefV1} = case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of true -> {?none, ?none}; false -> {DefK1, DefV0} end, {Pairs1, DefK, DefV} = case is_singleton_type(DefK2) of true -> {mapdict_insert({DefK2, ?opt, DefV1}, Pairs0), ?none, ?none}; false -> {Pairs0, DefK2, DefV1} end, Pairs = normalise_map_optionals(Pairs1, DefK, DefV), %% Validate invariants of the map representation. %% Since we needed to iterate over the arguments in order to normalise anyway, %% we might as well save us some future pain and do this even without %% define(DEBUG, true). try validate_map_elements(Pairs) catch error:badarg -> error(badarg, [Pairs0,DefK0,DefV0]) end, case map_pairs_are_none(Pairs) of true -> ?none; false -> ?map(Pairs, DefK, DefV) end. normalise_map_optionals([], _, _) -> []; normalise_map_optionals([E={K,?opt,?none}|T], DefK, DefV) -> Diff = t_subtract(DefK, K), case t_is_subtype(K, DefK) andalso DefK =:= Diff of true -> [E|normalise_map_optionals(T, DefK, DefV)]; false -> normalise_map_optionals(T, Diff, DefV) end; normalise_map_optionals([E={K,?opt,V}|T], DefK, DefV) -> case t_is_equal(V, DefV) andalso t_is_subtype(K, DefK) of true -> normalise_map_optionals(T, DefK, DefV); false -> [E|normalise_map_optionals(T, DefK, DefV)] end; normalise_map_optionals([E|T], DefK, DefV) -> [E|normalise_map_optionals(T, DefK, DefV)]. validate_map_elements([{K1,_,_}|Rest=[{K2,_,_}|_]]) -> case is_singleton_type(K1) andalso K1 < K2 of false -> error(badarg); true -> validate_map_elements(Rest) end; validate_map_elements([{K,_,_}]) -> case is_singleton_type(K) of false -> error(badarg); true -> true end; validate_map_elements([]) -> true. map_pairs_are_none([]) -> false; map_pairs_are_none([{_,?mand,?none}|_]) -> true; map_pairs_are_none([_|Ps]) -> map_pairs_are_none(Ps). -spec t_is_map(erl_type()) -> boolean(). t_is_map(Type) -> t_is_map(Type, 'universe'). -spec t_is_map(erl_type(), opaques()) -> boolean(). t_is_map(Type, Opaques) -> do_opaque(Type, Opaques, fun is_map1/1). is_map1(?map(_, _, _)) -> true; is_map1(_) -> false. -spec t_map_entries(erl_type()) -> t_map_dict(). t_map_entries(M) -> t_map_entries(M, 'universe'). -spec t_map_entries(erl_type(), opaques()) -> t_map_dict(). t_map_entries(M, Opaques) -> do_opaque(M, Opaques, fun map_entries/1). map_entries(?map(Pairs,_,_)) -> Pairs. -spec t_map_def_key(erl_type()) -> erl_type(). t_map_def_key(M) -> t_map_def_key(M, 'universe'). -spec t_map_def_key(erl_type(), opaques()) -> erl_type(). t_map_def_key(M, Opaques) -> do_opaque(M, Opaques, fun map_def_key/1). map_def_key(?map(_,DefK,_)) -> DefK. -spec t_map_def_val(erl_type()) -> erl_type(). t_map_def_val(M) -> t_map_def_val(M, 'universe'). -spec t_map_def_val(erl_type(), opaques()) -> erl_type(). t_map_def_val(M, Opaques) -> do_opaque(M, Opaques, fun map_def_val/1). map_def_val(?map(_,_,DefV)) -> DefV. -spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_store(E1, T)]; mapdict_store(E={_,_,_}, T) -> [E|T]. -spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_insert(E1, T)]; mapdict_insert(E={_,_,_}, T) -> [E|T]. -type map_pairwise_merge_fun() :: fun((erl_type(), t_map_mandatoriness(), erl_type(), t_map_mandatoriness(), erl_type()) -> t_map_pair() | false). -spec t_map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type(), opaques()) -> t_map_dict(). t_map_pairwise_merge(F, MapA, MapB, Opaques) -> do_opaque(MapA, Opaques, fun(UMapA) -> do_opaque(MapB, Opaques, fun(UMapB) -> map_pairwise_merge(F, UMapA, UMapB) end) end). %% Merges the pairs of two maps together. Missing pairs become (?opt, DefV) or %% (?opt, ?none), depending on whether K \in DefK. -spec map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type()) -> t_map_dict(). map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), ?map(BPairs, BDefK, BDefV)) -> map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). map_pairwise_merge(_, [], _, _, [], _, _) -> []; map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = case {As0, Bs0} of {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> {K, AMNess, AV, As, BMNess, BV, Bs}; {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; {As, [{K, BMNess,BV}|Bs]} -> {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; {[{K,AMNess,AV}|As], []=Bs} -> {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} end, MK = K1, %% Rename to make clear that we are matching below case F(K1, AMNess1, AV1, BMNess1, BV1) of false -> map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV); {MK,_,_}=M -> [M|map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV)] end. %% Folds over the pairs in two maps simultaneously in reverse key order. Missing %% pairs become (?opt, DefV) or (?opt, ?none), depending on whether K \in DefK. -spec map_pairwise_merge_foldr(fun((erl_type(), t_map_mandatoriness(), erl_type(), t_map_mandatoriness(), erl_type(), Acc) -> Acc), Acc, erl_type(), erl_type()) -> Acc. map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), ?map(BPairs, BDefK, BDefV)) -> map_pairwise_merge_foldr(F, AccIn, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = case {As0, Bs0} of {[{K,AMNess,AV}|As], [{K,BMNess,BV}|Bs]} -> {K, AMNess, AV, As, BMNess, BV, Bs}; {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; {As, [{K,BMNess,BV}|Bs]} -> {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; {[{K,AMNess,AV}|As], []=Bs} -> {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} end, F(K1, AMNess1, AV1, BMNess1, BV1, map_pairwise_merge_foldr(F,AccIn,As1,ADefK,ADefV,Bs1,BDefK,BDefV)). %% By observing that a missing pair in a map is equivalent to an optional pair, %% with ?none or DefV value, depending on whether K \in DefK, we can simplify %% merging by denormalising the map pairs temporarily, removing all 'false' %% cases, at the cost of the creation of more tuples: mapmerge_otherv(K, ODefK, ODefV) -> case t_inf(K, ODefK) of ?none -> ?none; _KOrOpaque -> ODefV end. -spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type(). t_map_put(KV, Map) -> t_map_put(KV, Map, 'universe'). -spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). t_map_put(KV, Map, Opaques) -> do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end). %% Key and Value are *not* unopaqued, but the map is map_put(_, ?none, _) -> ?none; map_put(_, ?unit, _) -> ?none; map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of true -> ?none; false -> case is_singleton_type(Key) of true -> t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV); false -> t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of true -> V; false -> t_sup(V, Value) end} || {K, MNess, V} <- Pairs], t_sup(DefK, Key), t_sup(DefV, Value)) end end. -spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). t_map_update(KV, Map) -> t_map_update(KV, Map, 'universe'). -spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). t_map_update(_, ?none, _) -> ?none; t_map_update(_, ?unit, _) -> ?none; t_map_update(KV={Key, _}, M, Opaques) -> case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of false -> ?none; true -> t_map_put(KV, M, Opaques) end. -spec t_map_get(erl_type(), erl_type()) -> erl_type(). t_map_get(Key, Map) -> t_map_get(Key, Map, 'universe'). -spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type(). t_map_get(Key, Map, Opaques) -> do_opaque(Map, Opaques, fun(UM) -> do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end) end). map_get(_, ?none) -> ?none; map_get(_, ?unit) -> ?none; map_get(Key, ?map(Pairs, DefK, DefV)) -> DefRes = case t_do_overlap(DefK, Key) of false -> t_none(); true -> DefV end, case is_singleton_type(Key) of false -> lists:foldl(fun({K, _, V}, Res) -> case t_do_overlap(K, Key) of false -> Res; true -> t_sup(Res, V) end end, DefRes, Pairs); true -> case lists:keyfind(Key, 1, Pairs) of false -> DefRes; {_, _, ValType} -> ValType end end. -spec t_map_is_key(erl_type(), erl_type()) -> erl_type(). t_map_is_key(Key, Map) -> t_map_is_key(Key, Map, 'universe'). -spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type(). t_map_is_key(Key, Map, Opaques) -> do_opaque(Map, Opaques, fun(UM) -> do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end) end). map_is_key(_, ?none) -> ?none; map_is_key(_, ?unit) -> ?none; map_is_key(Key, ?map(Pairs, DefK, _DefV)) -> case is_singleton_type(Key) of true -> case lists:keyfind(Key, 1, Pairs) of {Key, ?mand, _} -> t_atom(true); {Key, ?opt, ?none} -> t_atom(false); {Key, ?opt, _} -> t_boolean(); false -> case t_do_overlap(DefK, Key) of false -> t_atom(false); true -> t_boolean() end end; false -> case t_do_overlap(DefK, Key) orelse lists:any(fun({_,_,?none}) -> false; ({K,_,_}) -> t_do_overlap(K, Key) end, Pairs) of true -> t_boolean(); false -> t_atom(false) end end. %%----------------------------------------------------------------------------- %% Tuples %% -spec t_tuple() -> erl_type(). t_tuple() -> ?tuple(?any, ?any, ?any). -spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type(). t_tuple(N) when is_integer(N), N > ?MAX_TUPLE_SIZE -> t_tuple(); t_tuple(N) when is_integer(N) -> ?tuple(lists:duplicate(N, ?any), N, ?any); t_tuple(List) -> case any_none_or_unit(List) of true -> t_none(); false -> Arity = length(List), case get_tuple_tags(List) of [Tag] -> ?tuple(List, Arity, Tag); %% Tag can also be ?any here TagList -> SortedTagList = lists:sort(TagList), Tuples = [?tuple([T|tl(List)], Arity, T) || T <- SortedTagList], ?tuple_set([{Arity, Tuples}]) end end. -spec get_tuple_tags([erl_type()]) -> [erl_type(),...]. get_tuple_tags([Tag|_]) -> do_opaque(Tag, 'universe', fun tuple_tags/1); get_tuple_tags(_) -> [?any]. tuple_tags(?atom(?any)) -> [?any]; tuple_tags(?atom(Set)) -> case set_size(Set) > ?TUPLE_TAG_LIMIT of true -> [?any]; false -> [t_atom(A) || A <- set_to_list(Set)] end; tuple_tags(_) -> [?any]. %% to be used for a tuple with known types for its arguments (not ?any) -spec t_tuple_args(erl_type()) -> [erl_type()]. t_tuple_args(Type) -> t_tuple_args(Type, 'universe'). %% to be used for a tuple with known types for its arguments (not ?any) -spec t_tuple_args(erl_type(), opaques()) -> [erl_type()]. t_tuple_args(Type, Opaques) -> do_opaque(Type, Opaques, fun tuple_args/1). tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args. %% to be used for a tuple with a known size (not ?any) -spec t_tuple_size(erl_type()) -> non_neg_integer(). t_tuple_size(Type) -> t_tuple_size(Type, 'universe'). %% to be used for a tuple with a known size (not ?any) -spec t_tuple_size(erl_type(), opaques()) -> non_neg_integer(). t_tuple_size(Type, Opaques) -> do_opaque(Type, Opaques, fun tuple_size1/1). tuple_size1(?tuple(_, Size, _)) when is_integer(Size) -> Size. -spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...]. t_tuple_sizes(Type) -> do_opaque(Type, 'universe', fun tuple_sizes/1). tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown; tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size]; tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List]. -spec t_tuple_subtypes(erl_type(), opaques()) -> 'unknown' | [erl_type(),...]. t_tuple_subtypes(Type, Opaques) -> Fun = fun(?tuple_set(List)) -> t_tuple_subtypes_tuple_list(List, Opaques); (?opaque(_)) -> unknown; (T) -> t_tuple_subtypes(T) end, do_opaque(Type, Opaques, Fun). t_tuple_subtypes_tuple_list(List, Opaques) -> lists:append([t_tuple_subtypes_list(Tuples, Opaques) || {_Size, Tuples} <- List]). t_tuple_subtypes_list(List, Opaques) -> ListOfLists = [t_tuple_subtypes(E, Opaques) || E <- List, E =/= ?none], lists:append([L || L <- ListOfLists, L =/= 'unknown']). -spec t_tuple_subtypes(erl_type()) -> 'unknown' | [erl_type(),...]. %% XXX. Not the same as t_tuple_subtypes(T, 'universe')... t_tuple_subtypes(?tuple(?any, ?any, ?any)) -> unknown; t_tuple_subtypes(?tuple(_, _, _) = T) -> [T]; t_tuple_subtypes(?tuple_set(List)) -> lists:append([Tuples || {_Size, Tuples} <- List]). -spec t_is_tuple(erl_type()) -> boolean(). t_is_tuple(Type) -> t_is_tuple(Type, 'universe'). -spec t_is_tuple(erl_type(), opaques()) -> boolean(). t_is_tuple(Type, Opaques) -> do_opaque(Type, Opaques, fun is_tuple1/1). is_tuple1(?tuple(_, _, _)) -> true; is_tuple1(?tuple_set(_)) -> true; is_tuple1(_) -> false. %%----------------------------------------------------------------------------- %% Non-primitive types, including some handy syntactic sugar types %% -spec t_bitstrlist() -> erl_type(). t_bitstrlist() -> t_iolist(1, t_bitstr()). -spec t_arity() -> erl_type(). t_arity() -> t_from_range(0, 255). % was t_byte(). -spec t_pos_integer() -> erl_type(). t_pos_integer() -> t_from_range(1, pos_inf). -spec t_non_neg_integer() -> erl_type(). t_non_neg_integer() -> t_from_range(0, pos_inf). -spec t_is_non_neg_integer(erl_type()) -> boolean(). t_is_non_neg_integer(?integer(_) = T) -> t_is_subtype(T, t_non_neg_integer()); t_is_non_neg_integer(_) -> false. -spec t_neg_integer() -> erl_type(). t_neg_integer() -> t_from_range(neg_inf, -1). -spec t_fixnum() -> erl_type(). t_fixnum() -> t_integer(). % Gross over-approximation -spec t_pos_fixnum() -> erl_type(). t_pos_fixnum() -> t_pos_integer(). % Gross over-approximation -spec t_non_neg_fixnum() -> erl_type(). t_non_neg_fixnum() -> t_non_neg_integer(). % Gross over-approximation -spec t_mfa() -> erl_type(). t_mfa() -> t_tuple([t_atom(), t_atom(), t_arity()]). -spec t_module() -> erl_type(). t_module() -> t_atom(). -spec t_node() -> erl_type(). t_node() -> t_atom(). -spec t_iodata() -> erl_type(). t_iodata() -> t_sup(t_iolist(), t_binary()). -spec t_iolist() -> erl_type(). t_iolist() -> t_iolist(1, t_binary()). %% Added a second argument which currently is t_binary() | t_bitstr() -spec t_iolist(non_neg_integer(), erl_type()) -> erl_type(). t_iolist(N, T) when N > 0 -> t_maybe_improper_list(t_sup([t_iolist(N-1, T), T, t_byte()]), t_sup(T, t_nil())); t_iolist(0, T) -> t_maybe_improper_list(t_any(), t_sup(T, t_nil())). -spec t_timeout() -> erl_type(). t_timeout() -> t_sup(t_non_neg_integer(), t_atom('infinity')). %%------------------------------------ %% ?none is allowed in products. A product of size 1 is not a product. -spec t_product([erl_type()]) -> erl_type(). t_product([T]) -> T; t_product(Types) when is_list(Types) -> ?product(Types). %% This function is intended to be the inverse of the one above. %% It should NOT be used with ?any, ?none or ?unit as input argument. -spec t_to_tlist(erl_type()) -> [erl_type()]. t_to_tlist(?product(Types)) -> Types; t_to_tlist(T) when T =/= ?any orelse T =/= ?none orelse T =/= ?unit -> [T]. %%------------------------------------ -spec t_var(atom() | integer()) -> erl_type(). t_var(Atom) when is_atom(Atom) -> ?var(Atom); t_var(Int) when is_integer(Int) -> ?var(Int). -spec t_is_var(erl_type()) -> boolean(). t_is_var(?var(_)) -> true; t_is_var(_) -> false. -spec t_var_name(erl_type()) -> atom() | integer(). t_var_name(?var(Id)) -> Id. -spec t_has_var(erl_type()) -> boolean(). t_has_var(?var(_)) -> true; t_has_var(?function(Domain, Range)) -> t_has_var(Domain) orelse t_has_var(Range); t_has_var(?list(Contents, Termination, _)) -> t_has_var(Contents) orelse t_has_var(Termination); t_has_var(?product(Types)) -> t_has_var_list(Types); t_has_var(?tuple(?any, ?any, ?any)) -> false; t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); t_has_var(?map(_, DefK, _)= Map) -> t_has_var_list(map_all_values(Map)) orelse t_has_var(DefK); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); t_has_var(?union(List)) -> t_has_var_list(List); t_has_var(_) -> false. -spec t_has_var_list([erl_type()]) -> boolean(). t_has_var_list([T|Ts]) -> t_has_var(T) orelse t_has_var_list(Ts); t_has_var_list([]) -> false. -spec t_collect_vars(erl_type()) -> [erl_type()]. t_collect_vars(T) -> Vs = t_collect_vars(T, maps:new()), [V || {V, _} <- maps:to_list(Vs)]. -type ctab() :: #{erl_type() => 'any'}. -spec t_collect_vars(erl_type(), ctab()) -> ctab(). t_collect_vars(?var(_) = Var, Acc) -> maps:put(Var, any, Acc); t_collect_vars(?function(Domain, Range), Acc) -> Acc1 = t_collect_vars(Domain, Acc), t_collect_vars(Range, Acc1); t_collect_vars(?list(Contents, Termination, _), Acc) -> Acc1 = t_collect_vars(Contents, Acc), t_collect_vars(Termination, Acc1); t_collect_vars(?product(Types), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> Acc; t_collect_vars(?tuple(Types, _, _), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> t_collect_vars_list(t_tuple_subtypes(TS), Acc); t_collect_vars(?map(_, DefK, _) = Map, Acc0) -> Acc = t_collect_vars_list(map_all_values(Map), Acc0), t_collect_vars(DefK, Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); t_collect_vars(?union(List), Acc) -> t_collect_vars_list(List, Acc); t_collect_vars(_, Acc) -> Acc. t_collect_vars_list([T|Ts], Acc0) -> Acc = t_collect_vars(T, Acc0), t_collect_vars_list(Ts, Acc); t_collect_vars_list([], Acc) -> Acc. %%============================================================================= %% %% Type construction from Erlang terms. %% %%============================================================================= %%----------------------------------------------------------------------------- %% Make a type from a term. No type depth is enforced. %% -spec t_from_term(term()) -> erl_type(). t_from_term([H|T]) -> t_cons(t_from_term(H), t_from_term(T)); t_from_term([]) -> t_nil(); t_from_term(T) when is_atom(T) -> t_atom(T); t_from_term(T) when is_bitstring(T) -> t_bitstr(0, erlang:bit_size(T)); t_from_term(T) when is_float(T) -> t_float(); t_from_term(T) when is_function(T) -> {arity, Arity} = erlang:fun_info(T, arity), t_fun(Arity, t_any()); t_from_term(T) when is_integer(T) -> t_integer(T); t_from_term(T) when is_map(T) -> Pairs = [{t_from_term(K), ?mand, t_from_term(V)} || {K, V} <- maps:to_list(T)], {Stons, Rest} = lists:partition(fun({K,_,_}) -> is_singleton_type(K) end, Pairs), {DefK, DefV} = lists:foldl(fun({K,_,V},{AK,AV}) -> {t_sup(K,AK), t_sup(V,AV)} end, {t_none(), t_none()}, Rest), t_map(lists:keysort(1, Stons), DefK, DefV); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); t_from_term(T) when is_tuple(T) -> t_tuple([t_from_term(E) || E <- tuple_to_list(T)]). %%----------------------------------------------------------------------------- %% Integer types from a range. %%----------------------------------------------------------------------------- %%-define(USE_UNSAFE_RANGES, true). -spec t_from_range(rng_elem(), rng_elem()) -> erl_type(). -ifdef(USE_UNSAFE_RANGES). t_from_range(X, Y) -> t_from_range_unsafe(X, Y). -else. t_from_range(pos_inf, pos_inf) -> ?integer_pos; t_from_range(neg_inf, neg_inf) -> ?integer_neg; t_from_range(neg_inf, pos_inf) -> t_integer(); t_from_range(neg_inf, Y) when is_integer(Y), Y < 0 -> ?integer_neg; t_from_range(neg_inf, Y) when is_integer(Y), Y >= 0 -> t_integer(); t_from_range(X, pos_inf) when is_integer(X), X >= 1 -> ?integer_pos; t_from_range(X, pos_inf) when is_integer(X), X >= 0 -> ?integer_non_neg; t_from_range(X, pos_inf) when is_integer(X), X < 0 -> t_integer(); t_from_range(X, Y) when is_integer(X), is_integer(Y), X > Y -> t_none(); t_from_range(X, Y) when is_integer(X), is_integer(Y) -> case ((Y - X) < ?SET_LIMIT) of true -> t_integers(lists:seq(X, Y)); false -> case X >= 0 of false -> if Y < 0 -> ?integer_neg; true -> t_integer() end; true -> if Y =< ?MAX_BYTE, X >= 1 -> ?int_range(1, ?MAX_BYTE); Y =< ?MAX_BYTE -> t_byte(); Y =< ?MAX_CHAR, X >= 1 -> ?int_range(1, ?MAX_CHAR); Y =< ?MAX_CHAR -> t_char(); X >= 1 -> ?integer_pos; X >= 0 -> ?integer_non_neg end end end; t_from_range(pos_inf, neg_inf) -> t_none(). -endif. -spec t_from_range_unsafe(rng_elem(), rng_elem()) -> erl_type(). t_from_range_unsafe(pos_inf, pos_inf) -> ?integer_pos; t_from_range_unsafe(neg_inf, neg_inf) -> ?integer_neg; t_from_range_unsafe(neg_inf, pos_inf) -> t_integer(); t_from_range_unsafe(neg_inf, Y) -> ?int_range(neg_inf, Y); t_from_range_unsafe(X, pos_inf) -> ?int_range(X, pos_inf); t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y), X =< Y -> if (Y - X) < ?SET_LIMIT -> t_integers(lists:seq(X, Y)); true -> ?int_range(X, Y) end; t_from_range_unsafe(X, Y) when is_integer(X), is_integer(Y) -> t_none(); t_from_range_unsafe(pos_inf, neg_inf) -> t_none(). -spec t_is_fixnum(erl_type()) -> boolean(). t_is_fixnum(?int_range(neg_inf, _)) -> false; t_is_fixnum(?int_range(_, pos_inf)) -> false; t_is_fixnum(?int_range(From, To)) -> is_fixnum(From) andalso is_fixnum(To); t_is_fixnum(?int_set(Set)) -> is_fixnum(set_min(Set)) andalso is_fixnum(set_max(Set)); t_is_fixnum(_) -> false. -spec is_fixnum(integer()) -> boolean(). is_fixnum(N) when is_integer(N) -> Bits = ?BITS, (N =< ((1 bsl (Bits - 1)) - 1)) andalso (N >= -(1 bsl (Bits - 1))). infinity_geq(pos_inf, _) -> true; infinity_geq(_, pos_inf) -> false; infinity_geq(_, neg_inf) -> true; infinity_geq(neg_inf, _) -> false; infinity_geq(A, B) -> A >= B. -spec t_is_bitwidth(erl_type()) -> boolean(). t_is_bitwidth(?int_range(neg_inf, _)) -> false; t_is_bitwidth(?int_range(_, pos_inf)) -> false; t_is_bitwidth(?int_range(From, To)) -> infinity_geq(From, 0) andalso infinity_geq(?BITS, To); t_is_bitwidth(?int_set(Set)) -> infinity_geq(set_min(Set), 0) andalso infinity_geq(?BITS, set_max(Set)); t_is_bitwidth(_) -> false. -spec number_min(erl_type()) -> rng_elem(). number_min(Type) -> number_min(Type, 'universe'). -spec number_min(erl_type(), opaques()) -> rng_elem(). number_min(Type, Opaques) -> do_opaque(Type, Opaques, fun number_min2/1). number_min2(?int_range(From, _)) -> From; number_min2(?int_set(Set)) -> set_min(Set); number_min2(?number(?any, _Tag)) -> neg_inf. -spec number_max(erl_type()) -> rng_elem(). number_max(Type) -> number_max(Type, 'universe'). -spec number_max(erl_type(), opaques()) -> rng_elem(). number_max(Type, Opaques) -> do_opaque(Type, Opaques, fun number_max2/1). number_max2(?int_range(_, To)) -> To; number_max2(?int_set(Set)) -> set_max(Set); number_max2(?number(?any, _Tag)) -> pos_inf. %% -spec int_range(rgn_elem(), rng_elem()) -> erl_type(). %% %% int_range(neg_inf, pos_inf) -> t_integer(); %% int_range(neg_inf, To) -> ?int_range(neg_inf, To); %% int_range(From, pos_inf) -> ?int_range(From, pos_inf); %% int_range(From, To) when From =< To -> t_from_range(From, To); %% int_range(From, To) when To < From -> ?none. in_range(_, ?int_range(neg_inf, pos_inf)) -> true; in_range(X, ?int_range(From, pos_inf)) -> X >= From; in_range(X, ?int_range(neg_inf, To)) -> X =< To; in_range(X, ?int_range(From, To)) -> (X >= From) andalso (X =< To). -spec min(rng_elem(), rng_elem()) -> rng_elem(). min(neg_inf, _) -> neg_inf; min(_, neg_inf) -> neg_inf; min(pos_inf, Y) -> Y; min(X, pos_inf) -> X; min(X, Y) when X =< Y -> X; min(_, Y) -> Y. -spec max(rng_elem(), rng_elem()) -> rng_elem(). max(neg_inf, Y) -> Y; max(X, neg_inf) -> X; max(pos_inf, _) -> pos_inf; max(_, pos_inf) -> pos_inf; max(X, Y) when X =< Y -> Y; max(X, _) -> X. expand_range_from_set(Range = ?int_range(From, To), Set) -> Min = min(set_min(Set), From), Max = max(set_max(Set), To), if From =:= Min, To =:= Max -> Range; true -> t_from_range(Min, Max) end. %%============================================================================= %% %% Lattice operations %% %%============================================================================= %%----------------------------------------------------------------------------- %% Supremum %% -spec t_sup([erl_type()]) -> erl_type(). 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(). t_sup(?any, _) -> ?any; t_sup(_, ?any) -> ?any; t_sup(?none, T) -> T; t_sup(T, ?none) -> T; t_sup(?unit, T) -> T; t_sup(T, ?unit) -> T; t_sup(T, T) -> subst_all_vars_to_any(T); t_sup(?var(_), _) -> ?any; t_sup(_, ?var(_)) -> ?any; t_sup(?atom(Set1), ?atom(Set2)) -> ?atom(set_union(Set1, Set2)); t_sup(?bitstr(U1, B1), ?bitstr(U2, B2)) -> t_bitstr(gcd(gcd(U1, U2), abs(B1-B2)), lists:min([B1, B2])); t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) -> %% The domain is either a product or any. ?function(t_sup(Domain1, Domain2), t_sup(Range1, Range2)); t_sup(?identifier(Set1), ?identifier(Set2)) -> ?identifier(set_union(Set1, Set2)); t_sup(?opaque(Set1), ?opaque(Set2)) -> sup_opaque(set_to_list(ordsets:union(Set1, Set2))); %%Disallow unions with opaque types %%t_sup(T1=?opaque(_,_,_), T2) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; %%t_sup(T1, T2=?opaque(_,_,_)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) -> ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2)); t_sup(?nil, ?nil) -> ?nil; t_sup(?nil, ?list(Contents, Termination, _)) -> ?list(Contents, t_sup(?nil, Termination), ?unknown_qual); t_sup(?list(Contents, Termination, _), ?nil) -> ?list(Contents, t_sup(?nil, Termination), ?unknown_qual); t_sup(?list(Contents1, Termination1, Size1), ?list(Contents2, Termination2, Size2)) -> NewSize = case {Size1, Size2} of {?unknown_qual, ?unknown_qual} -> ?unknown_qual; {?unknown_qual, ?nonempty_qual} -> ?unknown_qual; {?nonempty_qual, ?unknown_qual} -> ?unknown_qual; {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual end, NewContents = t_sup(Contents1, Contents2), NewTermination = t_sup(Termination1, Termination2), TmpList = t_cons(NewContents, NewTermination), case NewSize of ?nonempty_qual -> TmpList; ?unknown_qual -> ?list(FinalContents, FinalTermination, _) = TmpList, ?list(FinalContents, FinalTermination, ?unknown_qual) end; t_sup(?number(_, _), ?number(?any, ?unknown_qual) = T) -> T; t_sup(?number(?any, ?unknown_qual) = T, ?number(_, _)) -> T; t_sup(?float, ?float) -> ?float; t_sup(?float, ?integer(_)) -> t_number(); t_sup(?integer(_), ?float) -> t_number(); t_sup(?integer(?any) = T, ?integer(_)) -> T; t_sup(?integer(_), ?integer(?any) = T) -> T; t_sup(?int_set(Set1), ?int_set(Set2)) -> case set_union(Set1, Set2) of ?any -> t_from_range(min(set_min(Set1), set_min(Set2)), max(set_max(Set1), set_max(Set2))); Set -> ?int_set(Set) end; t_sup(?int_range(From1, To1), ?int_range(From2, To2)) -> t_from_range(min(From1, From2), max(To1, To2)); t_sup(Range = ?int_range(_, _), ?int_set(Set)) -> expand_range_from_set(Range, Set); t_sup(?int_set(Set), Range = ?int_range(_, _)) -> expand_range_from_set(Range, Set); t_sup(?product(Types1), ?product(Types2)) -> L1 = length(Types1), L2 = length(Types2), if L1 =:= L2 -> ?product(t_sup_lists(Types1, Types2)); true -> ?any end; t_sup(?product(_), _) -> ?any; t_sup(_, ?product(_)) -> ?any; t_sup(?tuple(?any, ?any, ?any) = T, ?tuple(_, _, _)) -> T; t_sup(?tuple(_, _, _), ?tuple(?any, ?any, ?any) = T) -> T; t_sup(?tuple(?any, ?any, ?any) = T, ?tuple_set(_)) -> T; t_sup(?tuple_set(_), ?tuple(?any, ?any, ?any) = T) -> T; t_sup(?tuple(Elements1, Arity, Tag1) = T1, ?tuple(Elements2, Arity, Tag2) = T2) -> if Tag1 =:= Tag2 -> t_tuple(t_sup_lists(Elements1, Elements2)); Tag1 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2)); Tag2 =:= ?any -> t_tuple(t_sup_lists(Elements1, Elements2)); Tag1 < Tag2 -> ?tuple_set([{Arity, [T1, T2]}]); Tag1 > Tag2 -> ?tuple_set([{Arity, [T2, T1]}]) end; t_sup(?tuple(_, Arity1, _) = T1, ?tuple(_, Arity2, _) = T2) -> sup_tuple_sets([{Arity1, [T1]}], [{Arity2, [T2]}]); t_sup(?tuple_set(List1), ?tuple_set(List2)) -> sup_tuple_sets(List1, List2); t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> sup_tuple_sets(List1, [{Arity, [T2]}]); t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> sup_tuple_sets([{Arity, [T1]}], List2); t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> Pairs = map_pairwise_merge( fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)}; (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)} end, A, B), t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)); t_sup(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), sup_union(U1, U2). sup_opaque([]) -> ?none; sup_opaque(List) -> L = sup_opaq(List), ?opaque(ordsets:from_list(L)). sup_opaq(L0) -> L1 = [{{Mod,Name,Args}, T} || #opaque{mod = Mod, name = Name, args = Args}=T <- L0], F = family(L1), [supl(Ts) || {_, Ts} <- F]. supl([O]) -> O; supl(Ts) -> supl(Ts, t_none()). supl([#opaque{struct = S}=O|L], S0) -> S1 = t_sup(S, S0), case L =:= [] of true -> O#opaque{struct = S1}; false -> supl(L, S1) end. -spec t_sup_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_sup_lists([T1|Left1], [T2|Left2]) -> [t_sup(T1, T2)|t_sup_lists(Left1, Left2)]; t_sup_lists([], []) -> []. sup_tuple_sets(L1, L2) -> TotalArities = ordsets:union([Arity || {Arity, _} <- L1], [Arity || {Arity, _} <- L2]), if length(TotalArities) > ?TUPLE_ARITY_LIMIT -> t_tuple(); true -> case sup_tuple_sets(L1, L2, []) of [{_Arity, [OneTuple = ?tuple(_, _, _)]}] -> OneTuple; List -> ?tuple_set(List) end end. sup_tuple_sets([{Arity, Tuples1}|Left1], [{Arity, Tuples2}|Left2], Acc) -> NewAcc = [{Arity, sup_tuples_in_set(Tuples1, Tuples2)}|Acc], sup_tuple_sets(Left1, Left2, NewAcc); sup_tuple_sets([{Arity1, _} = T1|Left1] = L1, [{Arity2, _} = T2|Left2] = L2, Acc) -> if Arity1 < Arity2 -> sup_tuple_sets(Left1, L2, [T1|Acc]); Arity1 > Arity2 -> sup_tuple_sets(L1, Left2, [T2|Acc]) end; sup_tuple_sets([], L2, Acc) -> lists:reverse(Acc, L2); sup_tuple_sets(L1, [], Acc) -> lists:reverse(Acc, L1). sup_tuples_in_set([?tuple(_, _, ?any) = T], L) -> [t_tuple(sup_tuple_elements([T|L]))]; sup_tuples_in_set(L, [?tuple(_, _, ?any) = T]) -> [t_tuple(sup_tuple_elements([T|L]))]; sup_tuples_in_set(L1, L2) -> FoldFun = fun(?tuple(_, _, Tag), AccTag) -> t_sup(Tag, AccTag) end, TotalTag0 = lists:foldl(FoldFun, ?none, L1), TotalTag = lists:foldl(FoldFun, TotalTag0, L2), case TotalTag of ?atom(?any) -> %% We will reach the set limit. Widen now. [t_tuple(sup_tuple_elements(L1 ++ L2))]; ?atom(Set) -> case set_size(Set) > ?TUPLE_TAG_LIMIT of true -> %% We will reach the set limit. Widen now. [t_tuple(sup_tuple_elements(L1 ++ L2))]; false -> %% We can go on and build the tuple set. sup_tuples_in_set(L1, L2, []) end end. sup_tuple_elements([?tuple(Elements, _, _)|L]) -> lists:foldl(fun (?tuple(Es, _, _), Acc) -> t_sup_lists(Es, Acc) end, Elements, L). sup_tuples_in_set([?tuple(Elements1, Arity, Tag1) = T1|Left1] = L1, [?tuple(Elements2, Arity, Tag2) = T2|Left2] = L2, Acc) -> if Tag1 < Tag2 -> sup_tuples_in_set(Left1, L2, [T1|Acc]); Tag1 > Tag2 -> sup_tuples_in_set(L1, Left2, [T2|Acc]); Tag2 =:= Tag2 -> NewElements = t_sup_lists(Elements1, Elements2), NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc], sup_tuples_in_set(Left1, Left2, NewAcc) end; sup_tuples_in_set([], L2, Acc) -> lists:reverse(Acc, L2); sup_tuples_in_set(L1, [], Acc) -> lists:reverse(Acc, L1). sup_union(U1, U2) -> sup_union(U1, U2, 0, []). sup_union([?none|Left1], [?none|Left2], N, Acc) -> sup_union(Left1, Left2, N, [?none|Acc]); sup_union([T1|Left1], [T2|Left2], N, Acc) -> sup_union(Left1, Left2, N+1, [t_sup(T1, T2)|Acc]); sup_union([], [], N, Acc) -> if N =:= 0 -> ?none; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], Type; N =:= length(Acc) -> ?any; true -> ?union(lists:reverse(Acc)) end. force_union(T = ?atom(_)) -> ?atom_union(T); force_union(T = ?bitstr(_, _)) -> ?bitstr_union(T); force_union(T = ?function(_, _)) -> ?function_union(T); force_union(T = ?identifier(_)) -> ?identifier_union(T); force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); force_union(T = ?map(_,_,_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T); force_union(T = ?union(_)) -> T. %%----------------------------------------------------------------------------- %% An attempt to write the inverse operation of t_sup/1 -- XXX: INCOMPLETE !! %% -spec t_elements(erl_type()) -> [erl_type()]. t_elements(?none) -> []; t_elements(?unit) -> []; t_elements(?any = T) -> [T]; t_elements(?nil = T) -> [T]; t_elements(?atom(?any) = T) -> [T]; t_elements(?atom(Atoms)) -> [t_atom(A) || A <- Atoms]; t_elements(?bitstr(_, _) = T) -> [T]; t_elements(?function(_, _) = T) -> [T]; t_elements(?identifier(?any) = T) -> [T]; t_elements(?identifier(IDs)) -> [?identifier([T]) || T <- IDs]; t_elements(?list(_, _, _) = T) -> [T]; t_elements(?number(_, _) = T) -> case T of ?number(?any, ?unknown_qual) -> [?float, ?integer(?any)]; ?float -> [T]; ?integer(?any) -> [T]; ?int_range(_, _) -> [T]; ?int_set(Set) -> [t_integer(I) || I <- Set] end; t_elements(?opaque(_) = T) -> do_elements(T); t_elements(?map(_,_,_) = T) -> [T]; t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of unknown -> []; Elems -> Elems end; t_elements(?union(_) = T) -> do_elements(T); t_elements(?var(_)) -> [?any]. %% yes, vars exist -- what else to do here? %% t_elements(T) -> %% io:format("T_ELEMENTS => ~p\n", [T]). do_elements(Type0) -> case do_opaque(Type0, 'universe', fun(T) -> T end) of ?union(List) -> lists:append([t_elements(T) || T <- List]); Type -> t_elements(Type) end. %%----------------------------------------------------------------------------- %% Infimum %% -spec t_inf([erl_type()]) -> erl_type(). t_inf([H1, H2|T]) -> case t_inf(H1, H2) of ?none -> ?none; NewH -> t_inf([NewH|T]) end; t_inf([H]) -> H; t_inf([]) -> ?none. -spec t_inf(erl_type(), erl_type()) -> erl_type(). t_inf(T1, T2) -> t_inf(T1, T2, 'universe'). %% 'match' should be used from t_find_unknown_opaque() only -type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. -spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). t_inf(?var(_), ?var(_), _Opaques) -> ?any; t_inf(?var(_), T, _Opaques) -> subst_all_vars_to_any(T); t_inf(T, ?var(_), _Opaques) -> subst_all_vars_to_any(T); t_inf(?any, T, _Opaques) -> subst_all_vars_to_any(T); t_inf(T, ?any, _Opaques) -> subst_all_vars_to_any(T); t_inf(?none, _, _Opaques) -> ?none; t_inf(_, ?none, _Opaques) -> ?none; t_inf(?unit, _, _Opaques) -> ?unit; % ?unit cases should appear below ?none t_inf(_, ?unit, _Opaques) -> ?unit; t_inf(T, T, _Opaques) -> subst_all_vars_to_any(T); t_inf(?atom(Set1), ?atom(Set2), _) -> case set_intersection(Set1, Set2) of ?none -> ?none; NewSet -> ?atom(NewSet) end; t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Opaques) -> if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2); true -> ?none end; t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Opaques) -> if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1); true -> ?none end; t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Opaques) -> t_bitstr(U1, B1); t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) when U2 > U1 -> inf_bitstr(U2, B2, U1, B1); t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) -> inf_bitstr(U1, B1, U2, B2); t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Opaques) -> case t_inf(Domain1, Domain2, Opaques) of ?none -> ?none; Domain -> ?function(Domain, t_inf(Range1, Range2, Opaques)) end; t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> %% Because it simplifies the anonymous function, we allow Pairs to temporarily %% contain mandatory pairs with none values, since all such cases should %% result in a none result. Pairs = map_pairwise_merge( %% For optional keys in both maps, when the infinimum is none, we have %% essentially concluded that K must not be a key in the map. fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)}; %% When a key is optional in one map, but mandatory in another, it %% becomes mandatory in the infinumum (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)} end, A, B), t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV)); t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) -> ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2)); t_inf(?nil, ?nil, _Opaques) -> ?nil; t_inf(?nil, ?nonempty_list(_, _), _Opaques) -> ?none; t_inf(?nonempty_list(_, _), ?nil, _Opaques) -> ?none; t_inf(?nil, ?list(_Contents, Termination, _), Opaques) -> t_inf(?nil, t_unopaque(Termination), Opaques); t_inf(?list(_Contents, Termination, _), ?nil, Opaques) -> t_inf(?nil, t_unopaque(Termination), Opaques); t_inf(?list(Contents1, Termination1, Size1), ?list(Contents2, Termination2, Size2), Opaques) -> case t_inf(Termination1, Termination2, Opaques) of ?none -> ?none; Termination -> case t_inf(Contents1, Contents2, Opaques) of ?none -> %% If none of the lists are nonempty, then the infimum is nil. case (Size1 =:= ?unknown_qual) andalso (Size2 =:= ?unknown_qual) of true -> t_nil(); false -> ?none end; Contents -> Size = case {Size1, Size2} of {?unknown_qual, ?unknown_qual} -> ?unknown_qual; {?unknown_qual, ?nonempty_qual} -> ?nonempty_qual; {?nonempty_qual, ?unknown_qual} -> ?nonempty_qual; {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual end, ?list(Contents, Termination, Size) end end; t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> case {T1, T2} of {T, T} -> T; {_, ?number(?any, ?unknown_qual)} -> T1; {?number(?any, ?unknown_qual), _} -> T2; {?float, ?integer(_)} -> ?none; {?integer(_), ?float} -> ?none; {?integer(?any), ?integer(_)} -> T2; {?integer(_), ?integer(?any)} -> T1; {?int_set(Set1), ?int_set(Set2)} -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?int_set(Set) end; {?int_range(From1, To1), ?int_range(From2, To2)} -> t_from_range(max(From1, From2), min(To1, To2)); {Range = ?int_range(_, _), ?int_set(Set)} -> %% io:format("t_inf range, set args ~p ~p ~n", [T1, T2]), Ans2 = case set_filter(fun(X) -> in_range(X, Range) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) end, %% io:format("Ans2 ~p ~n", [Ans2]), Ans2; {?int_set(Set), ?int_range(_, _) = Range} -> case set_filter(fun(X) -> in_range(X, Range) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) end end; t_inf(?product(Types1), ?product(Types2), Opaques) -> L1 = length(Types1), L2 = length(Types2), if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Opaques)); true -> ?none end; t_inf(?product(_), _, _Opaques) -> ?none; t_inf(_, ?product(_), _Opaques) -> ?none; t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Opaques) -> subst_all_vars_to_any(T); t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Opaques) -> subst_all_vars_to_any(T); t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Opaques) -> subst_all_vars_to_any(T); t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Opaques) -> subst_all_vars_to_any(T); t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Opaques) -> case t_inf_lists_strict(Elements1, Elements2, Opaques) of bottom -> ?none; NewElements -> t_tuple(NewElements) end; t_inf(?tuple_set(List1), ?tuple_set(List2), Opaques) -> inf_tuple_sets(List1, List2, Opaques); t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> inf_tuple_sets(List, [{Arity, [T]}], Opaques); t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Opaques) -> inf_tuple_sets(List, [{Arity, [T]}], Opaques); %% be careful: here and in the next clause T can be ?opaque t_inf(?union(U1), T, Opaques) -> ?union(U2) = force_union(T), inf_union(U1, U2, Opaques); t_inf(T, ?union(U2), Opaques) -> ?union(U1) = force_union(T), inf_union(U1, U2, Opaques); t_inf(?opaque(Set1), ?opaque(Set2), Opaques) -> inf_opaque(Set1, Set2, Opaques); t_inf(?opaque(_) = T1, T2, Opaques) -> inf_opaque1(T2, T1, 1, Opaques); t_inf(T1, ?opaque(_) = T2, Opaques) -> inf_opaque1(T1, T2, 2, Opaques); %% and as a result, the cases for ?opaque should appear *after* ?union t_inf(#c{}, #c{}, _) -> ?none. inf_opaque1(T1, ?opaque(Set2)=T2, Pos, Opaques) -> case Opaques =:= 'universe' orelse inf_is_opaque_type(T2, Pos, Opaques) of false -> ?none; true -> List2 = set_to_list(Set2), case inf_collect(T1, List2, Opaques, []) of [] -> ?none; OpL -> ?opaque(ordsets:from_list(OpL)) end end. inf_is_opaque_type(T, Pos, {match, Opaques}) -> is_opaque_type(T, Opaques) orelse throw({pos, [Pos]}); inf_is_opaque_type(T, _Pos, Opaques) -> is_opaque_type(T, Opaques). inf_collect(T1, [T2|List2], Opaques, OpL) -> #opaque{struct = S2} = T2, case t_inf(T1, S2, Opaques) of ?none -> inf_collect(T1, List2, Opaques, OpL); Inf -> Op = T2#opaque{struct = Inf}, inf_collect(T1, List2, Opaques, [Op|OpL]) end; inf_collect(_T1, [], _Opaques, OpL) -> OpL. combine(S, T1, T2) -> case is_compat_opaque_names(T1, T2) of true -> combine(S, [T1]); false -> combine(S, [T1, T2]) end. combine(?opaque(Set), Ts) -> [comb2(O, T) || O <- Set, T <- Ts]; combine(S, Ts) -> [T#opaque{struct = S} || T <- Ts]. comb2(O, T) -> case is_compat_opaque_names(O, T) of true -> O; false -> T#opaque{struct = ?opaque(set_singleton(O))} end. %% 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, Opaques), List2 = inf_look_up(Set2, Opaques), List0 = [combine(Inf, T1, T2) || {Is1, T1} <- List1, {Is2, T2} <- List2, not t_is_none(Inf = inf_opaque_types(Is1, T1, Is2, T2, Opaques))], List = lists:append(List0), sup_opaque(List). %% Optimization: do just one lookup. inf_look_up(Set, Opaques) -> [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Opaques), T} || T <- set_to_list(Set)]. 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, T1, IsOpaque2, T2, Opaques) -> #opaque{struct = S1}=T1, #opaque{struct = S2}=T2, case Opaques =:= 'universe' orelse is_compat_opaque_names(T1, T2) 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); {false, false} when element(1, Opaques) =:= match -> throw({pos, [1, 2]}); {false, false} -> t_none() end end. compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) -> [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)]. is_compat_opaque_names(Opaque1, Opaque2) -> #opaque{mod = Mod1, name = Name1, args = Args1} = Opaque1, #opaque{mod = Mod2, name = Name2, args = Args2} = Opaque2, case {{Mod1, Name1, Args1}, {Mod2, Name2, Args2}} of {ModNameArgs, ModNameArgs} -> true; {{Mod, Name, Args1}, {Mod, Name, Args2}} -> is_compat_args(Args1, Args2); _ -> false end. 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. -spec is_compat_arg(erl_type(), erl_type()) -> boolean(). %% The intention is that 'true' is to be returned iff one of the %% arguments is a specialization of the other argument in the sense %% that every type is a specialization of any(). For example, {_,_} is %% a specialization of any(), but not of tuple(). Does not handle %% variables, but any() and unions (sort of). However, the %% implementation is more relaxed as any() is compatible to anything. is_compat_arg(T, T) -> true; is_compat_arg(_, ?any) -> true; is_compat_arg(?any, _) -> true; is_compat_arg(?function(Domain1, Range1), ?function(Domain2, Range2)) -> (is_compat_arg(Domain1, Domain2) andalso is_compat_arg(Range1, Range2)); is_compat_arg(?list(Contents1, Termination1, Size1), ?list(Contents2, Termination2, Size2)) -> (Size1 =:= Size2 andalso is_compat_arg(Contents1, Contents2) andalso is_compat_arg(Termination1, Termination2)); is_compat_arg(?product(Types1), ?product(Types2)) -> is_compat_list(Types1, Types2); is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) -> {Ks1, _, Vs1} = lists:unzip3(Pairs1), {Ks2, _, Vs2} = lists:unzip3(Pairs2), Key1 = t_sup([DefK1 | Ks1]), Key2 = t_sup([DefK2 | Ks2]), case is_compat_arg(Key1, Key2) of true -> Value1 = t_sup([DefV1 | Vs1]), Value2 = t_sup([DefV2 | Vs2]), is_compat_arg(Value1, Value2); false -> false end; is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; is_compat_arg(?tuple(Elements1, Arity, _), ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> is_compat_list(Elements1, Elements2); is_compat_arg(?tuple_set([{Arity, List}]), ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> is_compat_list(sup_tuple_elements(List), Elements2); is_compat_arg(?tuple(Elements1, Arity, _), ?tuple_set([{Arity, List}])) when Arity =/= ?any -> is_compat_list(Elements1, sup_tuple_elements(List)); is_compat_arg(?tuple_set(List1), ?tuple_set(List2)) -> try is_compat_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; is_compat_arg(?opaque(_) = T1, T2) -> is_compat_arg(t_opaque_structure(T1), T2); is_compat_arg(T1, ?opaque(_) = T2) -> is_compat_arg(T1, t_opaque_structure(T2)); is_compat_arg(?union(List1)=T1, ?union(List2)=T2) -> case is_compat_union2(T1, T2) of {yes, Type1, Type2} -> is_compat_arg(Type1, Type2); no -> is_compat_list(List1, List2) end; is_compat_arg(?union(List), T2) -> case unify_union(List) of {yes, Type} -> is_compat_arg(Type, T2); no -> false end; is_compat_arg(T1, ?union(List)) -> case unify_union(List) of {yes, Type} -> is_compat_arg(T1, Type); no -> false end; is_compat_arg(?var(_), _) -> exit(error); is_compat_arg(_, ?var(_)) -> exit(error); is_compat_arg(?none, _) -> false; is_compat_arg(_, ?none) -> false; is_compat_arg(?unit, _) -> false; is_compat_arg(_, ?unit) -> false; is_compat_arg(#c{}, #c{}) -> false. is_compat_list_list(LL1, LL2) -> length(LL1) =:= length(LL2) andalso is_compat_list_list1(LL1, LL2). is_compat_list_list1([], []) -> true; is_compat_list_list1([L1|LL1], [L2|LL2]) -> is_compat_list(L1, L2) andalso is_compat_list_list1(LL1, LL2). is_compat_list(L1, L2) -> length(L1) =:= length(L2) andalso is_compat_list1(L1, L2). is_compat_list1([], []) -> true; is_compat_list1([T1|L1], [T2|L2]) -> is_compat_arg(T1, T2) andalso is_compat_list1(L1, L2). is_compat_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; {{yes, Type1}, no} -> {yes, Type1, T2}; {no, {yes, Type2}} -> {yes, T1, Type2}; {no, no} -> no end. -spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_inf_lists(L1, L2) -> t_inf_lists(L1, L2, 'universe'). -spec t_inf_lists([erl_type()], [erl_type()], t_inf_opaques()) -> [erl_type()]. t_inf_lists(L1, L2, Opaques) -> t_inf_lists(L1, L2, [], Opaques). -spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> [erl_type()]. t_inf_lists([T1|Left1], [T2|Left2], Acc, Opaques) -> t_inf_lists(Left1, Left2, [t_inf(T1, T2, Opaques)|Acc], Opaques); t_inf_lists([], [], Acc, _Opaques) -> lists:reverse(Acc). %% Infimum of lists with strictness. %% If any element is the ?none type, the value 'bottom' is returned. -spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. t_inf_lists_strict(L1, L2, Opaques) -> t_inf_lists_strict(L1, L2, [], Opaques). -spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Opaques) -> case t_inf(T1, T2, Opaques) of ?none -> bottom; T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Opaques) end; t_inf_lists_strict([], [], Acc, _Opaques) -> lists:reverse(Acc). inf_tuple_sets(L1, L2, Opaques) -> case inf_tuple_sets(L1, L2, [], Opaques) of [] -> ?none; [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple; List -> ?tuple_set(List) end. inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc, Opaques) -> case inf_tuples_in_sets(Tuples1, Tuples2, Opaques) of [] -> inf_tuple_sets(Ts1, Ts2, Acc, Opaques); [?tuple_set([{Arity, NewTuples}])] -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques); NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques) end; inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc, Opaques) -> if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Opaques); Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Opaques) end; inf_tuple_sets([], _, Acc, _Opaques) -> lists:reverse(Acc); inf_tuple_sets(_, [], Acc, _Opaques) -> lists:reverse(Acc). inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Opaques) -> NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) || ?tuple(Elements2, _, _) <- L2], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Opaques) -> NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) || ?tuple(Elements1, _, _) <- L1], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; inf_tuples_in_sets(L1, L2, Opaques) -> inf_tuples_in_sets2(L1, L2, [], Opaques). inf_tuples_in_sets2([?tuple(Elements1, Arity, Tag)|Ts1], [?tuple(Elements2, Arity, Tag)|Ts2], Acc, Opaques) -> case t_inf_lists_strict(Elements1, Elements2, Opaques) of bottom -> inf_tuples_in_sets2(Ts1, Ts2, Acc, Opaques); NewElements -> inf_tuples_in_sets2(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc], Opaques) end; inf_tuples_in_sets2([?tuple(_, _, Tag1)|Ts1] = L1, [?tuple(_, _, Tag2)|Ts2] = L2, Acc, Opaques) -> if Tag1 < Tag2 -> inf_tuples_in_sets2(Ts1, L2, Acc, Opaques); Tag1 > Tag2 -> inf_tuples_in_sets2(L1, Ts2, Acc, Opaques) end; inf_tuples_in_sets2([], _, Acc, _Opaques) -> lists:reverse(Acc); inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). inf_union(U1, U2, Opaques) -> OpaqueFun = fun(Union1, Union2, InfFun) -> [_,_,_,_,_,_,_,_,Opaque,_] = Union1, [A,B,F,I,L,N,T,M,_,Map] = Union2, List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, {O1, ThrowList1} = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), {O2, ThrowList2} = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), {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({pos, lists:usort(ThrowList)}); Sup -> Sup end. inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> {t_sup(InfList), lists:usort(ThrowList)}; inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) -> inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList); 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:{pos, Ns} -> inf_union_collect(L, Opaque, InfFun, InfList, Ns ++ ThrowList) end. inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); 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:{pos, Ns} -> inf_union(Left1, Left2, N, [?none|Acc], Ns ++ ThrowList, Opaques) end; inf_union([], [], N, Acc, ThrowList, _Opaques) -> if N =:= 0 -> {?none, ThrowList}; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], {Type, ThrowList}; N >= 2 -> {?union(lists:reverse(Acc)), ThrowList} end. inf_bitstr(U1, B1, U2, B2) -> GCD = gcd(U1, U2), case (B2-B1) rem GCD of 0 -> U = (U1*U2) div GCD, B = findfirst(0, 0, U1, B1, U2, B2), t_bitstr(U, B); _ -> ?none end. findfirst(N1, N2, U1, B1, U2, B2) -> Val1 = U1*N1+B1, Val2 = U2*N2+B2, if Val1 =:= Val2 -> Val1; Val1 > Val2 -> findfirst(N1, N2+1, U1, B1, U2, B2); Val1 < Val2 -> findfirst(N1+1, N2, U1, B1, U2, B2) end. %%----------------------------------------------------------------------------- %% Substitution of variables %% -type subst_table() :: #{any() => erl_type()}. -spec t_subst(erl_type(), subst_table()) -> erl_type(). t_subst(T, Map) -> case t_has_var(T) of true -> t_subst_aux(T, Map); false -> T end. -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> t_subst(T, #{}). t_subst_aux(?var(Id), Map) -> case maps:find(Id, Map) of error -> ?any; {ok, Type} -> Type end; t_subst_aux(?list(Contents, Termination, Size), Map) -> case t_subst_aux(Contents, Map) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. case t_subst_aux(Termination, Map) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), ?list(NewContents2, NewTermination, Size) end end; t_subst_aux(?function(Domain, Range), Map) -> ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map)); t_subst_aux(?product(Types), Map) -> ?product([t_subst_aux(T, Map) || T <- Types]); t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) -> T; t_subst_aux(?tuple(Elements, _Arity, _Tag), Map) -> t_tuple([t_subst_aux(E, Map) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, Map) -> t_sup([t_subst_aux(T, Map) || T <- t_tuple_subtypes(TS)]); t_subst_aux(?map(Pairs, DefK, DefV), Map) -> t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs], t_subst_aux(DefK, Map), t_subst_aux(DefV, Map)); t_subst_aux(?opaque(Es), Map) -> List = [Opaque#opaque{args = [t_subst_aux(Arg, Map) || Arg <- Args], struct = t_subst_aux(S, Map)} || Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], ?opaque(ordsets:from_list(List)); t_subst_aux(?union(List), Map) -> ?union([t_subst_aux(E, Map) || E <- List]); t_subst_aux(T, _Map) -> T. %%----------------------------------------------------------------------------- %% Unification %% -type t_unify_ret() :: {erl_type(), [{_, erl_type()}]}. -spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> {T, VarMap} = t_unify(T1, T2, #{}), {t_subst(T, VarMap), lists:keysort(1, maps:to_list(VarMap))}. t_unify(?var(Id) = T, ?var(Id), VarMap) -> {T, VarMap}; t_unify(?var(Id1) = T, ?var(Id2), VarMap) -> case maps:find(Id1, VarMap) of error -> case maps:find(Id2, VarMap) of error -> {T, VarMap#{Id2 => T}}; {ok, Type} -> t_unify(T, Type, VarMap) end; {ok, Type1} -> case maps:find(Id2, VarMap) of error -> {Type1, VarMap#{Id2 => T}}; {ok, Type2} -> t_unify(Type1, Type2, VarMap) end end; t_unify(?var(Id), Type, VarMap) -> case maps:find(Id, VarMap) of error -> {Type, VarMap#{Id => Type}}; {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(Type, ?var(Id), VarMap) -> case maps:find(Id, VarMap) of error -> {Type, VarMap#{Id => Type}}; {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) -> {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap), {Range, VarMap2} = t_unify(Range1, Range2, VarMap1), {?function(Domain, Range), VarMap2}; t_unify(?list(Contents1, Termination1, Size), ?list(Contents2, Termination2, Size), VarMap) -> {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap), {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1), {?list(Contents, Termination, Size), VarMap2}; t_unify(?product(Types1), ?product(Types2), VarMap) -> {Types, VarMap1} = unify_lists(Types1, Types2, VarMap), {?product(Types), VarMap1}; t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap) -> {T, VarMap}; t_unify(?tuple(Elements1, Arity, _), ?tuple(Elements2, Arity, _), VarMap) when Arity =/= ?any -> {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap), {t_tuple(NewElements), VarMap1}; t_unify(?tuple_set([{Arity, _}]) = T1, ?tuple(_, Arity, _) = T2, VarMap) when Arity =/= ?any -> unify_tuple_set_and_tuple1(T1, T2, VarMap); t_unify(?tuple(_, Arity, _) = T1, ?tuple_set([{Arity, _}]) = T2, VarMap) when Arity =/= ?any -> unify_tuple_set_and_tuple2(T1, T2, VarMap); t_unify(?tuple_set(List1) = T1, ?tuple_set(List2) = T2, VarMap) -> try unify_lists(lists:append([T || {_Arity, T} <- List1]), lists:append([T || {_Arity, T} <- List2]), VarMap) of {Tuples, NewVarMap} -> {t_sup(Tuples), NewVarMap} catch _:_ -> throw({mismatch, T1, T2}) end; t_unify(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0) -> {DefK, VarMap1} = t_unify(ADefK, BDefK, VarMap0), {DefV, VarMap2} = t_unify(ADefV, BDefV, VarMap1), {Pairs, VarMap} = map_pairwise_merge_foldr( fun(K, MNess, V1, MNess, V2, {Pairs0, VarMap3}) -> %% We know that the keys unify and do not contain variables, or they %% would not be singletons %% TODO: Should V=?none (known missing keys) be handled special? {V, VarMap4} = t_unify(V1, V2, VarMap3), {[{K,MNess,V}|Pairs0], VarMap4}; (K, _, V1, _, V2, {Pairs0, VarMap3}) -> %% One mandatory and one optional; what should be done in this case? {V, VarMap4} = t_unify(V1, V2, VarMap3), {[{K,?mand,V}|Pairs0], VarMap4} end, {[], VarMap2}, A, B), {t_map(Pairs, DefK, DefV), VarMap}; t_unify(?opaque(_) = T1, ?opaque(_) = T2, VarMap) -> t_unify(t_opaque_structure(T1), t_opaque_structure(T2), VarMap); t_unify(T1, ?opaque(_) = T2, VarMap) -> t_unify(T1, t_opaque_structure(T2), VarMap); t_unify(?opaque(_) = T1, T2, VarMap) -> t_unify(t_opaque_structure(T1), T2, VarMap); t_unify(T, T, VarMap) -> {T, VarMap}; t_unify(?union(_)=T1, ?union(_)=T2, VarMap) -> {Type1, Type2} = unify_union2(T1, T2), t_unify(Type1, Type2, VarMap); t_unify(?union(_)=T1, T2, VarMap) -> t_unify(unify_union1(T1, T1, T2), T2, VarMap); t_unify(T1, ?union(_)=T2, VarMap) -> t_unify(T1, unify_union1(T2, T1, T2), VarMap); t_unify(T1, T2, _) -> throw({mismatch, T1, T2}). unify_union2(?union(List1)=T1, ?union(List2)=T2) -> case {unify_union(List1), unify_union(List2)} of {{yes, Type1}, {yes, Type2}} -> {Type1, Type2}; {{yes, Type1}, no} -> {Type1, T2}; {no, {yes, Type2}} -> {T1, Type2}; {no, no} -> throw({mismatch, T1, T2}) end. unify_union1(?union(List), T1, T2) -> case unify_union(List) of {yes, Type} -> Type; no -> throw({mismatch, T1, T2}) end. unify_union(List) -> [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> no; true -> S = t_opaque_structure(O), {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])} end. -spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). %% An opaque type is a union of types. Returns true iff any of the type %% names (Module and Name) of the first argument (the opaque type to %% check) occurs in any of the opaque types of the second argument. is_opaque_type(?opaque(Elements), Opaques) -> lists:any(fun(Opaque) -> is_opaque_type2(Opaque, Opaques) end, Elements). is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) -> F1 = fun(?opaque(Es)) -> F2 = fun(#opaque{mod = Mod, name = Name, args = Args}) -> is_type_name(Mod1, Name1, Args1, Mod, Name, Args) end, lists:any(F2, Es) end, lists:any(F1, Opaques). is_type_name(Mod, Name, Args1, Mod, Name, Args2) -> length(Args1) =:= length(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}]), ?tuple(Elements2, Arity, _), VarMap) -> %% Can only work if the single tuple has variables at correct places. %% Collapse the tuple set. {NewElements, VarMap1} = unify_lists(sup_tuple_elements(List), Elements2, VarMap), {t_tuple(NewElements), VarMap1}. unify_tuple_set_and_tuple2(?tuple(Elements2, Arity, _), ?tuple_set([{Arity, List}]), VarMap) -> %% Can only work if the single tuple has variables at correct places. %% Collapse the tuple set. {NewElements, VarMap1} = unify_lists(Elements2, sup_tuple_elements(List), VarMap), {t_tuple(NewElements), VarMap1}. unify_lists(L1, L2, VarMap) -> unify_lists(L1, L2, VarMap, []). unify_lists([T1|Left1], [T2|Left2], VarMap, Acc) -> {NewT, NewVarMap} = t_unify(T1, T2, VarMap), unify_lists(Left1, Left2, NewVarMap, [NewT|Acc]); unify_lists([], [], VarMap, Acc) -> {lists:reverse(Acc), VarMap}. %%t_assign_variables_to_subtype(T1, T2) -> %% try %% Dict = assign_vars(T1, T2, dict:new()), %% {ok, dict:map(fun(_Param, List) -> t_sup(List) end, Dict)} %% catch %% throw:error -> error %% end. %%assign_vars(_, ?var(_), _Dict) -> %% erlang:error("Variable in right hand side of assignment"); %%assign_vars(?any, _, Dict) -> %% Dict; %%assign_vars(?var(_) = Var, Type, Dict) -> %% store_var(Var, Type, Dict); %%assign_vars(?function(Domain1, Range1), ?function(Domain2, Range2), Dict) -> %% DomainList = %% case Domain2 of %% ?any -> []; %% ?product(List) -> List %% end, %% case any_none([Range2|DomainList]) of %% true -> throw(error); %% false -> %% Dict1 = assign_vars(Domain1, Domain2, Dict), %% assign_vars(Range1, Range2, Dict1) %% end; %%assign_vars(?list(_Contents, _Termination, ?any), ?nil, Dict) -> %% Dict; %%assign_vars(?list(Contents1, Termination1, Size1), %% ?list(Contents2, Termination2, Size2), Dict) -> %% Dict1 = assign_vars(Contents1, Contents2, Dict), %% Dict2 = assign_vars(Termination1, Termination2, Dict1), %% case {Size1, Size2} of %% {S, S} -> Dict2; %% {?any, ?nonempty_qual} -> Dict2; %% {_, _} -> throw(error) %% end; %%assign_vars(?product(Types1), ?product(Types2), Dict) -> %% case length(Types1) =:= length(Types2) of %% true -> assign_vars_lists(Types1, Types2, Dict); %% false -> throw(error) %% end; %%assign_vars(?tuple(?any, ?any, ?any), ?tuple(?any, ?any, ?any), Dict) -> %% Dict; %%assign_vars(?tuple(?any, ?any, ?any), ?tuple(_, _, _), Dict) -> %% Dict; %%assign_vars(?tuple(Elements1, Arity, _), %% ?tuple(Elements2, Arity, _), Dict) when Arity =/= ?any -> %% assign_vars_lists(Elements1, Elements2, Dict); %%assign_vars(?tuple_set(_) = T, ?tuple_set(List2), Dict) -> %% %% All Rhs tuples must already be subtypes of Lhs, so we can take %% %% each one separatly. %% assign_vars_lists([T || _ <- List2], List2, Dict); %%assign_vars(?tuple(?any, ?any, ?any), ?tuple_set(_), Dict) -> %% Dict; %%assign_vars(?tuple(_, Arity, _) = T1, ?tuple_set(List), Dict) -> %% case reduce_tuple_tags(List) of %% [Tuple = ?tuple(_, Arity, _)] -> assign_vars(T1, Tuple, Dict); %% _ -> throw(error) %% end; %%assign_vars(?tuple_set(List), ?tuple(_, Arity, Tag) = T2, Dict) -> %% case [T || ?tuple(_, Arity1, Tag1) = T <- List, %% Arity1 =:= Arity, Tag1 =:= Tag] of %% [] -> throw(error); %% [T1] -> assign_vars(T1, T2, Dict) %% end; %%assign_vars(?union(U1), T2, Dict) -> %% ?union(U2) = force_union(T2), %% assign_vars_lists(U1, U2, Dict); %%assign_vars(T, T, Dict) -> %% Dict; %%assign_vars(T1, T2, Dict) -> %% case t_is_subtype(T2, T1) of %% false -> throw(error); %% true -> Dict %% end. %%assign_vars_lists([T1|Left1], [T2|Left2], Dict) -> %% assign_vars_lists(Left1, Left2, assign_vars(T1, T2, Dict)); %%assign_vars_lists([], [], Dict) -> %% Dict. %%store_var(?var(Id), Type, Dict) -> %% case dict:find(Id, Dict) of %% error -> dict:store(Id, [Type], Dict); %% {ok, _VarType0} -> dict:update(Id, fun(X) -> [Type|X] end, Dict) %% end. %%----------------------------------------------------------------------------- %% Subtraction. %% %% Note that the subtraction is an approximation since we do not have %% negative types. Also, tuples and products should be handled using %% the cartesian product of the elements, but this is not feasible to %% do. %% %% Example: {a|b,c|d}\{a,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d} = %% = {a,c}|{b,c}|{b,d} = {a|b,c|d} %% %% Instead, we can subtract if all elements but one becomes none after %% subtracting element-wise. %% %% Example: {a|b,c|d}\{a|b,d} = {a,c}|{a,d}|{b,c}|{b,d} \ {a,d}|{b,d} = %% = {a,c}|{b,c} = {a|b,c} -spec t_subtract_list(erl_type(), [erl_type()]) -> erl_type(). t_subtract_list(T1, [T2|Left]) -> t_subtract_list(t_subtract(T1, T2), Left); t_subtract_list(T, []) -> T. -spec t_subtract(erl_type(), erl_type()) -> erl_type(). t_subtract(_, ?any) -> ?none; t_subtract(T, ?var(_)) -> T; t_subtract(?any, _) -> ?any; t_subtract(?var(_) = T, _) -> T; t_subtract(T, ?unit) -> T; t_subtract(?unit, _) -> ?unit; t_subtract(?none, _) -> ?none; t_subtract(T, ?none) -> T; t_subtract(?atom(Set1), ?atom(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?atom(Set) end; t_subtract(?bitstr(U1, B1), ?bitstr(U2, B2)) -> subtract_bin(t_bitstr(U1, B1), t_inf(t_bitstr(U1, B1), t_bitstr(U2, B2))); t_subtract(?function(_, _) = T1, ?function(_, _) = T2) -> case t_is_subtype(T1, T2) of true -> ?none; false -> T1 end; t_subtract(?identifier(Set1), ?identifier(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; t_subtract(?opaque(_)=T1, ?opaque(_)=T2) -> opaque_subtract(T1, t_opaque_structure(T2)); t_subtract(?opaque(_)=T1, T2) -> opaque_subtract(T1, T2); t_subtract(T1, ?opaque(_)=T2) -> t_subtract(T1, t_opaque_structure(T2)); t_subtract(?matchstate(Pres1, Slots1), ?matchstate(Pres2, _Slots2)) -> Pres = t_subtract(Pres1, Pres2), case t_is_none(Pres) of true -> ?none; false -> ?matchstate(Pres, Slots1) end; t_subtract(?matchstate(Present, Slots), _) -> ?matchstate(Present, Slots); t_subtract(?nil, ?nil) -> ?none; t_subtract(?nil, ?nonempty_list(_, _)) -> ?nil; t_subtract(?nil, ?list(_, _, _)) -> ?none; t_subtract(?list(Contents, Termination, _Size) = T, ?nil) -> case Termination =:= ?nil of true -> ?nonempty_list(Contents, Termination); false -> T end; t_subtract(?list(Contents1, Termination1, Size1) = T, ?list(Contents2, Termination2, Size2)) -> case t_is_subtype(Contents1, Contents2) of true -> case t_is_subtype(Termination1, Termination2) of true -> case {Size1, Size2} of {?nonempty_qual, ?unknown_qual} -> ?none; {?unknown_qual, ?nonempty_qual} -> ?nil; {S, S} -> ?none end; false -> %% If the termination is not covered by the subtracted type %% we cannot really say anything about the result. T end; false -> %% All contents must be covered if there is going to be any %% change to the list. T end; t_subtract(?float, ?float) -> ?none; t_subtract(?number(_, _) = T1, ?float) -> t_inf(T1, t_integer()); t_subtract(?float, ?number(_Set, Tag)) -> case Tag of ?unknown_qual -> ?none; _ -> ?float end; t_subtract(?number(_, _), ?number(?any, ?unknown_qual)) -> ?none; t_subtract(?number(_, _) = T1, ?integer(?any)) -> t_inf(?float, T1); t_subtract(?int_set(Set1), ?int_set(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?int_set(Set) end; t_subtract(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) -> case t_inf(T1, T2) of ?none -> T1; ?int_range(From1, To1) -> ?none; ?int_range(neg_inf, To) -> t_from_range(To + 1, To1); ?int_range(From, pos_inf) -> t_from_range(From1, From - 1); ?int_range(From, To) -> t_sup(t_from_range(From1, From - 1), t_from_range(To + 1, To)) end; t_subtract(?int_range(From, To) = T1, ?int_set(Set)) -> NewFrom = case set_is_element(From, Set) of true -> From + 1; false -> From end, NewTo = case set_is_element(To, Set) of true -> To - 1; false -> To end, if (NewFrom =:= From) and (NewTo =:= To) -> T1; true -> t_from_range(NewFrom, NewTo) end; t_subtract(?int_set(Set), ?int_range(From, To)) -> case set_filter(fun(X) -> not ((X =< From) orelse (X >= To)) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) end; t_subtract(?integer(?any) = T1, ?integer(_)) -> T1; t_subtract(?number(_, _) = T1, ?number(_, _)) -> T1; t_subtract(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> ?none; t_subtract(?tuple_set(_), ?tuple(?any, ?any, ?any)) -> ?none; t_subtract(?tuple(?any, ?any, ?any) = T1, ?tuple_set(_)) -> T1; t_subtract(?tuple(Elements1, Arity1, _Tag1) = T1, ?tuple(Elements2, Arity2, _Tag2)) -> if Arity1 =/= Arity2 -> T1; Arity1 =:= Arity2 -> NewElements = t_subtract_lists(Elements1, Elements2), case [E || E <- NewElements, E =/= ?none] of [] -> ?none; [_] -> t_tuple(replace_nontrivial_element(Elements1, NewElements)); _ -> T1 end end; t_subtract(?tuple_set(List1) = T1, ?tuple(_, Arity, _) = T2) -> case orddict:find(Arity, List1) of error -> T1; {ok, List2} -> TuplesLeft0 = [Tuple || {_Arity, Tuple} <- orddict:erase(Arity, List1)], TuplesLeft1 = lists:append(TuplesLeft0), t_sup([t_subtract(L, T2) || L <- List2] ++ TuplesLeft1) end; t_subtract(?tuple(_, Arity, _) = T1, ?tuple_set(List1)) -> case orddict:find(Arity, List1) of error -> T1; {ok, List2} -> t_inf([t_subtract(T1, L) || L <- List2]) end; t_subtract(?tuple_set(_) = T1, ?tuple_set(_) = T2) -> t_sup([t_subtract(T, T2) || T <- t_tuple_subtypes(T1)]); t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> Arity1 = length(Elements1), Arity2 = length(Elements2), if Arity1 =/= Arity2 -> T1; Arity1 =:= Arity2 -> NewElements = t_subtract_lists(Elements1, Elements2), case [E || E <- NewElements, E =/= ?none] of [] -> ?none; [_] -> t_product(replace_nontrivial_element(Elements1, NewElements)); _ -> T1 end end; t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of false -> A; true -> %% We fold over the maps to produce a list of constraints, where %% constraints are additional key-value pairs to put in Pairs. Only one %% constraint need to be applied to produce a type that excludes the %% right-hand-side type, so if more than one constraint is produced, we %% just return the left-hand-side argument. %% %% Each case of the fold may either conclude that %% * The arguments constrain A at least as much as B, i.e. that A so far %% is a subtype of B. In that case they return false %% * That for the particular arguments, A being a subtype of B does not %% hold, but the infinimum of A and B is nonempty, and by narrowing a %% pair in A, we can create a type that excludes some elements in the %% infinumum. In that case, they will return that pair. %% * That for the particular arguments, A being a subtype of B does not %% hold, and either the infinumum of A and B is empty, or it is not %% possible with the current representation to create a type that %% excludes elements from B without also excluding elements that are %% only in A. In that case, it will return the pair from A unchanged. case map_pairwise_merge( %% If V1 is a subtype of V2, the case that K does not exist in A %% remain. fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)}; (K, _, V1, _, V2) -> %% If we subtract an optional key, that leaves a mandatory key case t_subtract(V1, V2) of ?none -> false; Partial -> {K, ?mand, Partial} end end, A, B) of %% We produce a list of keys that are constrained. As only one of %% these should apply at a time, we can't represent the difference if %% more than one constraint is produced. If we applied all of them, %% that would make an underapproximation, which we must not do. [] -> ?none; %% A is a subtype of B [E] -> t_map(mapdict_store(E, APairs), ADefK, ADefV); _ -> A end end; t_subtract(?product(P1), _) -> ?product(P1); t_subtract(T, ?product(_)) -> T; t_subtract(?union(U1), ?union(U2)) -> subtract_union(U1, U2); t_subtract(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), subtract_union(U1, U2). -spec opaque_subtract(erl_type(), erl_type()) -> erl_type(). opaque_subtract(?opaque(Set1), T2) -> List = [T1#opaque{struct = Sub} || #opaque{struct = S1}=T1 <- set_to_list(Set1), not t_is_none(Sub = t_subtract(S1, T2))], case List of [] -> ?none; _ -> ?opaque(ordsets:from_list(List)) end. -spec t_subtract_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_subtract_lists(L1, L2) -> t_subtract_lists(L1, L2, []). -spec t_subtract_lists([erl_type()], [erl_type()], [erl_type()]) -> [erl_type()]. t_subtract_lists([T1|Left1], [T2|Left2], Acc) -> t_subtract_lists(Left1, Left2, [t_subtract(T1, T2)|Acc]); t_subtract_lists([], [], Acc) -> lists:reverse(Acc). -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1, [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2, List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1], List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2], Sub1 = subtract_union(List1, List2, 0, []), O = if O1 =:= ?none -> O1; true -> t_subtract(O1, ?union(U2)) end, Sub2 = if O2 =:= ?none -> Sub1; true -> t_subtract(Sub1, t_opaque_structure(O2)) end, t_sup(O, Sub2). -spec subtract_union([erl_type()], [erl_type()], non_neg_integer(), [erl_type()]) -> erl_type(). subtract_union([T1|Left1], [T2|Left2], N, Acc) -> case t_subtract(T1, T2) of ?none -> subtract_union(Left1, Left2, N, [?none|Acc]); T -> subtract_union(Left1, Left2, N+1, [T|Acc]) end; subtract_union([], [], 0, _Acc) -> ?none; subtract_union([], [], 1, Acc) -> [T] = [X || X <- Acc, X =/= ?none], T; subtract_union([], [], N, Acc) when is_integer(N), N > 1 -> ?union(lists:reverse(Acc)). replace_nontrivial_element(El1, El2) -> replace_nontrivial_element(El1, El2, []). replace_nontrivial_element([T1|Left1], [?none|Left2], Acc) -> replace_nontrivial_element(Left1, Left2, [T1|Acc]); replace_nontrivial_element([_|Left1], [T2|_], Acc) -> lists:reverse(Acc) ++ [T2|Left1]. subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B1)) -> ?none; subtract_bin(?bitstr(U1, B1), ?none) -> t_bitstr(U1, B1); subtract_bin(?bitstr(U1, B1), ?bitstr(0, B1)) -> t_bitstr(U1, B1+U1); subtract_bin(?bitstr(U1, B1), ?bitstr(U1, B2)) -> if (B1+U1) =/= B2 -> t_bitstr(0, B1); true -> t_bitstr(U1, B1) end; subtract_bin(?bitstr(U1, B1), ?bitstr(U2, B2)) -> if (2 * U1) =:= U2 -> if B1 =:= B2 -> t_bitstr(U2, B1+U1); (B1 + U1) =:= B2 -> t_bitstr(U2, B1); true -> t_bitstr(U1, B1) end; true -> t_bitstr(U1, B1) end. %%----------------------------------------------------------------------------- %% Relations %% -spec t_is_equal(erl_type(), erl_type()) -> boolean(). t_is_equal(T, T) -> true; t_is_equal(_, _) -> false. -spec t_is_subtype(erl_type(), erl_type()) -> boolean(). t_is_subtype(T1, T2) -> Inf = t_inf(T1, T2), subtype_is_equal(T1, Inf). %% The subtype relation has to behave correctly irrespective of opaque %% types. subtype_is_equal(T, T) -> true; subtype_is_equal(T1, T2) -> t_is_equal(case t_contains_opaque(T1) of true -> t_unopaque(T1); false -> T1 end, case t_contains_opaque(T2) of true -> t_unopaque(T2); false -> T2 end). -spec t_is_instance(erl_type(), erl_type()) -> boolean(). %% XXX. To be removed. t_is_instance(ConcreteType, Type) -> t_is_subtype(ConcreteType, t_unopaque(Type)). -spec t_do_overlap(erl_type(), erl_type()) -> boolean(). t_do_overlap(TypeA, TypeB) -> not (t_is_none_or_unit(t_inf(TypeA, TypeB))). -spec t_unopaque(erl_type()) -> erl_type(). t_unopaque(T) -> t_unopaque(T, 'universe'). -spec t_unopaque(erl_type(), opaques()) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); false -> T end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); t_unopaque(?tuple(?any, _, _) = T, _) -> T; t_unopaque(?tuple(ArgTs, Sz, Tag), Opaques) when is_list(ArgTs) -> NewArgTs = [t_unopaque(A, Opaques) || A <- ArgTs], ?tuple(NewArgTs, Sz, Tag); t_unopaque(?tuple_set(Set), Opaques) -> NewSet = [{Sz, [t_unopaque(T, Opaques) || T <- Tuples]} || {Sz, Tuples} <- Set], ?tuple_set(NewSet); t_unopaque(?product(Types), Opaques) -> ?product([t_unopaque(T, Opaques) || T <- Types]); t_unopaque(?function(Domain, Range), Opaques) -> ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques)); t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), UM = t_unopaque(M, Opaques), UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, t_sup([?union([A,B,UF,I,UL,N,UT,UM,OF,UMap])|UO]); t_unopaque(?map(Pairs,DefK,DefV), Opaques) -> t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs], t_unopaque(DefK, Opaques), t_unopaque(DefV, Opaques)); t_unopaque(T, _) -> T. %%----------------------------------------------------------------------------- %% K-depth abstraction. %% %% t_limit/2 is the exported function, which checks the type of the %% second argument and calls the module local t_limit_k/2 function. %% -spec t_limit(erl_type(), integer()) -> erl_type(). t_limit(Term, K) when is_integer(K) -> t_limit_k(Term, K). t_limit_k(_, K) when K =< 0 -> ?any; t_limit_k(?tuple(?any, ?any, ?any) = T, _K) -> T; t_limit_k(?tuple(Elements, Arity, _), K) -> if K =:= 1 -> t_tuple(Arity); true -> t_tuple([t_limit_k(E, K-1) || E <- Elements]) end; t_limit_k(?tuple_set(_) = T, K) -> t_sup([t_limit_k(Tuple, K) || Tuple <- t_tuple_subtypes(T)]); t_limit_k(?list(Elements, Termination, Size), K) -> NewTermination = if K =:= 1 -> %% We do not want to lose the termination information. t_limit_k(Termination, K); true -> t_limit_k(Termination, K - 1) end, NewElements = t_limit_k(Elements, K - 1), TmpList = t_cons(NewElements, NewTermination), case Size of ?nonempty_qual -> TmpList; ?unknown_qual -> ?list(NewElements1, NewTermination1, _) = TmpList, ?list(NewElements1, NewTermination1, ?unknown_qual) end; t_limit_k(?function(Domain, Range), K) -> %% The domain is either a product or any() so we do not decrease the K. ?function(t_limit_k(Domain, K), t_limit_k(Range, K-1)); t_limit_k(?product(Elements), K) -> ?product([t_limit_k(X, K - 1) || X <- Elements]); t_limit_k(?union(Elements), K) -> ?union([t_limit_k(X, K) || X <- Elements]); t_limit_k(?opaque(Es), K) -> List = [begin NewS = t_limit_k(S, K), Opaque#opaque{struct = NewS} end || #opaque{struct = S} = Opaque <- set_to_list(Es)], ?opaque(ordsets:from_list(List)); t_limit_k(?map(Pairs0, DefK0, DefV0), K) -> Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) -> LV = t_limit_k(EV, K - 1), case t_limit_k(EK, K - 1) of EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1}; LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} end end, {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0), t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1)); t_limit_k(T, _K) -> T. %%============================================================================ %% %% Abstract records. Used for comparing contracts. %% %%============================================================================ -spec t_abstract_records(erl_type(), type_table()) -> erl_type(). t_abstract_records(?list(Contents, Termination, Size), RecDict) -> case t_abstract_records(Contents, RecDict) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. case t_abstract_records(Termination, RecDict) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), ?list(NewContents2, NewTermination, Size) end end; t_abstract_records(?function(Domain, Range), RecDict) -> ?function(t_abstract_records(Domain, RecDict), t_abstract_records(Range, RecDict)); t_abstract_records(?product(Types), RecDict) -> ?product([t_abstract_records(T, RecDict) || T <- Types]); t_abstract_records(?union(Types), RecDict) -> t_sup([t_abstract_records(T, RecDict) || T <- Types]); t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) -> T; 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, _Abstr, T} <- Fields]]) end; t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); t_abstract_records(?tuple_set(_) = Tuples, RecDict) -> t_sup([t_abstract_records(T, RecDict) || T <- t_tuple_subtypes(Tuples)]); t_abstract_records(?opaque(_)=Type, RecDict) -> t_abstract_records(t_opaque_structure(Type), RecDict); t_abstract_records(T, _RecDict) -> T. %%============================================================================= %% %% Prettyprinter %% %%============================================================================= -spec t_to_string(erl_type()) -> string(). t_to_string(T) -> t_to_string(T, maps:new()). -spec t_to_string(erl_type(), type_table()) -> string(). t_to_string(?any, _RecDict) -> "any()"; t_to_string(?none, _RecDict) -> "none()"; t_to_string(?unit, _RecDict) -> "no_return()"; t_to_string(?atom(?any), _RecDict) -> "atom()"; t_to_string(?atom(Set), _RecDict) -> case set_size(Set) of 2 -> case set_is_element(true, Set) andalso set_is_element(false, Set) of true -> "boolean()"; false -> set_to_string(Set) end; _ -> set_to_string(Set) end; t_to_string(?bitstr(0, 0), _RecDict) -> "<<>>"; t_to_string(?bitstr(8, 0), _RecDict) -> "binary()"; t_to_string(?bitstr(1, 0), _RecDict) -> "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> flat_format("<<_:~w>>", [B]); t_to_string(?bitstr(U, 0), _RecDict) -> flat_format("<<_:_*~w>>", [U]); t_to_string(?bitstr(U, B), _RecDict) -> flat_format("<<_:~w,_:_*~w>>", [B, U]); t_to_string(?function(?any, ?any), _RecDict) -> "fun()"; t_to_string(?function(?any, Range), RecDict) -> "fun((...) -> " ++ t_to_string(Range, RecDict) ++ ")"; t_to_string(?function(?product(ArgList), Range), RecDict) -> "fun((" ++ comma_sequence(ArgList, RecDict) ++ ") -> " ++ t_to_string(Range, RecDict) ++ ")"; t_to_string(?identifier(Set), _RecDict) -> case Set of ?any -> "identifier()"; _ -> flat_join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ") end; t_to_string(?opaque(Set), RecDict) -> flat_join([opaque_type(Mod, Name, Args, S, RecDict) || #opaque{mod = Mod, name = Name, struct = S, args = Args} <- set_to_list(Set)], " | "); t_to_string(?matchstate(Pres, Slots), RecDict) -> flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict), t_to_string(Slots,RecDict)]); t_to_string(?nil, _RecDict) -> "[]"; t_to_string(?nonempty_list(Contents, Termination), RecDict) -> ContentString = t_to_string(Contents, RecDict), case Termination of ?nil -> case Contents of ?char -> "nonempty_string()"; _ -> "["++ContentString++",...]" end; ?any -> %% Just a safety check. case Contents =:= ?any of true -> ok; false -> %% XXX. See comment below. %% erlang:error({illegal_list, ?nonempty_list(Contents, Termination)}) ok end, "nonempty_maybe_improper_list()"; _ -> case t_is_subtype(t_nil(), Termination) of true -> "nonempty_maybe_improper_list("++ContentString++"," ++t_to_string(Termination, RecDict)++")"; false -> "nonempty_improper_list("++ContentString++"," ++t_to_string(Termination, RecDict)++")" end end; t_to_string(?list(Contents, Termination, ?unknown_qual), RecDict) -> ContentString = t_to_string(Contents, RecDict), case Termination of ?nil -> case Contents of ?char -> "string()"; _ -> "["++ContentString++"]" end; ?any -> %% Just a safety check. %% XXX. Types such as "maybe_improper_list(integer(), any())" %% are OK, but cannot be printed!? case Contents =:= ?any of true -> ok; false -> ok %% L = ?list(Contents, Termination, ?unknown_qual), %% erlang:error({illegal_list, L}) end, "maybe_improper_list()"; _ -> case t_is_subtype(t_nil(), Termination) of true -> "maybe_improper_list("++ContentString++"," ++t_to_string(Termination, RecDict)++")"; false -> "improper_list("++ContentString++"," ++t_to_string(Termination, RecDict)++")" end end; t_to_string(?int_set(Set), _RecDict) -> set_to_string(Set); t_to_string(?byte, _RecDict) -> "byte()"; t_to_string(?char, _RecDict) -> "char()"; t_to_string(?integer_pos, _RecDict) -> "pos_integer()"; t_to_string(?integer_non_neg, _RecDict) -> "non_neg_integer()"; t_to_string(?integer_neg, _RecDict) -> "neg_integer()"; t_to_string(?int_range(From, To), _RecDict) -> flat_format("~w..~w", [From, To]); t_to_string(?integer(?any), _RecDict) -> "integer()"; t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; t_to_string(?map([],?any,?any), _RecDict) -> "map()"; t_to_string(?map(Pairs0,DefK,DefV), RecDict) -> {Pairs, ExtraEl} = case {DefK, DefV} of {?none, ?none} -> {Pairs0, []}; _ -> {Pairs0 ++ [{DefK,?opt,DefV}], []} end, Tos = fun(T) -> case T of ?any -> "_"; _ -> t_to_string(T, RecDict) end end, StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs], StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs], "#{" ++ flat_join([K ++ ":=" ++ V||{K,V}<-StrMand] ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] ++ ExtraEl, ", ") ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; t_to_string(?tuple(Elements, Arity, Tag), RecDict) -> [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity-1, RecDict) of error -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; {ok, FieldNames} -> record_to_string(TagAtom, Elements, FieldNames, RecDict) end; t_to_string(?tuple_set(_) = T, RecDict) -> union_sequence(t_tuple_subtypes(T), RecDict); t_to_string(?union(Types), RecDict) -> union_sequence([T || T <- Types, T =/= ?none], RecDict); t_to_string(?var(Id), _RecDict) when is_atom(Id) -> flat_format("~s", [atom_to_list(Id)]); t_to_string(?var(Id), _RecDict) when is_integer(Id) -> flat_format("var(~w)", [Id]). record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ flat_join(FieldStrings, ",") ++ "}". 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) andalso not t_is_none(t_inf(F, DefType))) of true -> Acc; false -> StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict), [StrFV|Acc] end, record_fields_to_string(Fs, FDefs, RecDict, NewAcc); record_fields_to_string([], [], _RecDict, Acc) -> lists:reverse(Acc). -spec record_field_diffs_to_string(erl_type(), type_table()) -> string(). record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) -> [TagAtom] = atom_vals(Tag), {ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict), %% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]), FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []), flat_join(FieldDiffs, " and "). field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> %% Don't care about opacity for now. NewAcc = case not t_is_none(t_inf(F, DefType)) of true -> Acc; false -> Str = atom_to_string(FName) ++ "::" ++ t_to_string(DefType, RecDict), [Str|Acc] end, field_diffs(Fs, FDefs, RecDict, NewAcc); field_diffs([], [], _, Acc) -> lists:reverse(Acc). comma_sequence(Types, RecDict) -> List = [case T =:= ?any of true -> "_"; false -> t_to_string(T, RecDict) end || T <- Types], flat_join(List, ","). union_sequence(Types, RecDict) -> List = [t_to_string(T, RecDict) || T <- Types], flat_join(List, " | "). -ifdef(DEBUG). opaque_type(Mod, Name, _Args, S, RecDict) -> ArgsString = comma_sequence(_Args, RecDict), String = t_to_string(S, RecDict), opaque_name(Mod, Name, ArgsString) ++ "[" ++ String ++ "]". -else. opaque_type(Mod, Name, Args, _S, RecDict) -> ArgsString = comma_sequence(Args, RecDict), opaque_name(Mod, Name, ArgsString). -endif. opaque_name(Mod, Name, Extra) -> S = mod_name(Mod, Name), flat_format("~ts(~ts)", [S, Extra]). mod_name(Mod, Name) -> flat_format("~w:~tw", [Mod, Name]). %%============================================================================= %% %% Build a type from parse forms. %% %%============================================================================= -type type_names() :: [type_key() | record_key()]. -type mta() :: {module(), atom(), arity()}. -type mra() :: {module(), atom(), arity()}. -type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. -type cache_key() :: {module(), atom(), expand_depth(), [erl_type()], type_names()}. -type mod_type_table() :: ets:tid(). -type mod_records() :: dict:dict(module(), type_table()). -record(cache, { types = maps:new() :: #{cache_key() => {erl_type(), expand_limit()}}, mod_recs = {mrecs, dict:new()} :: {'mrecs', mod_records()} }). -opaque cache() :: #cache{}. -spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_type_table(), var_table(), cache()) -> {erl_type(), cache()}. t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) -> t_from_form1(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(). t_from_form_without_remote(Form, Site, TypeTable) -> Module = site_module(Site), ModRecs = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, VarTab = var_table__new(), Cache0 = cache__new(), Cache = Cache0#cache{mod_recs = {mrecs, ModRecs}}, {Type, _} = t_from_form1(Form, ExpTypes, Site, undefined, VarTab, Cache), Type. -type expand_limit() :: integer(). -type expand_depth() :: integer(). -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}, 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), from_form_loop(Form, State, 2, L, C1, T1); true -> {T0, C0} end. initial_typenames({type, _MTA}=Site) -> [Site]; initial_typenames({spec, _MFA}) -> []; initial_typenames({record, _MRA}) -> []. from_form_loop(Form, State, D, Limit, C, T0) -> {T1, L1, C1} = from_form(Form, State, D, Limit, C), Delta = Limit - L1, if L1 =< 0 -> {T0, C1}; Delta * 8 > Limit -> %% Save some time by assuming next depth will exceed the limit. {T1, C1}; true -> D1 = D + 1, from_form_loop(Form, State, D1, Limit, C1, T1) end. -spec from_form(parse_form(), #from_form{}, expand_depth(), expand_limit(), cache()) -> {erl_type(), expand_limit(), cache()}. %% 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 site_module(S) can be found in MR. from_form(_, _S, D, L, C) when D =< 0 ; L =< 0 -> {t_any(), L, C}; from_form({var, _L, '_'}, _S, _D, L, C) -> {t_any(), L, C}; from_form({var, _L, Name}, S, _D, L, C) -> V = S#from_form.vtab, case maps:find(Name, V) of error -> {t_var(Name), L, C}; {ok, Val} -> {Val, L, C} end; from_form({ann_type, _L, [_Var, Type]}, S, D, L, C) -> from_form(Type, S, D, L, C); from_form({paren_type, _L, [Type]}, S, D, L, C) -> from_form(Type, S, D, L, C); from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, S, D, L, C) -> remote_from_form(Module, Type, Args, S, D, L, C); from_form({atom, _L, Atom}, _S, _D, L, C) -> {t_atom(Atom), L, C}; from_form({integer, _L, Int}, _S, _D, L, C) -> {t_integer(Int), L, C}; from_form({char, _L, Char}, _S, _D, L, C) -> {t_integer(Char), L, C}; from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; from_form({type, _L, any, []}, _S, _D, L, C) -> {t_any(), L, C}; from_form({type, _L, arity, []}, _S, _D, L, C) -> {t_arity(), L, C}; from_form({type, _L, atom, []}, _S, _D, L, C) -> {t_atom(), L, C}; from_form({type, _L, binary, []}, _S, _D, L, C) -> {t_binary(), L, C}; from_form({type, _L, binary, [Base, Unit]} = Type, _S, _D, L, C) -> 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), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; from_form({type, _L, bitstring, []}, _S, _D, L, C) -> {t_bitstr(), L, C}; from_form({type, _L, bool, []}, _S, _D, L, C) -> {t_boolean(), L, C}; % XXX: Temporarily from_form({type, _L, boolean, []}, _S, _D, L, C) -> {t_boolean(), L, C}; from_form({type, _L, byte, []}, _S, _D, L, C) -> {t_byte(), L, C}; from_form({type, _L, char, []}, _S, _D, L, C) -> {t_char(), L, C}; from_form({type, _L, float, []}, _S, _D, L, C) -> {t_float(), L, C}; from_form({type, _L, function, []}, _S, _D, L, C) -> {t_fun(), L, C}; from_form({type, _L, 'fun', []}, _S, _D, L, C) -> {t_fun(), L, C}; from_form({type, _L, 'fun', [{type, _, any}, Range]}, S, D, L, C) -> {T, L1, C1} = from_form(Range, S, D - 1, L - 1, C), {t_fun(T), L1, C1}; from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, S, D, L, C) -> {Dom1, L1, C1} = list_from_form(Domain, S, D, L, C), {Ran1, L2, C2} = from_form(Range, S, D, L1, C1), {t_fun(Dom1, Ran1), L2, C2}; from_form({type, _L, identifier, []}, _S, _D, L, C) -> {t_identifier(), L, C}; from_form({type, _L, integer, []}, _S, _D, L, C) -> {t_integer(), L, C}; from_form({type, _L, iodata, []}, _S, _D, L, C) -> {t_iodata(), L, C}; from_form({type, _L, iolist, []}, _S, _D, L, C) -> {t_iolist(), L, C}; from_form({type, _L, list, []}, _S, _D, L, C) -> {t_list(), L, C}; from_form({type, _L, list, [Type]}, S, D, L, C) -> {T, L1, C1} = from_form(Type, S, D - 1, L - 1, C), {t_list(T), L1, C1}; from_form({type, _L, map, any}, S, D, L, C) -> builtin_type(map, t_map(), S, D, L, C); from_form({type, _L, map, List}, S, D0, L, C) -> {Pairs1, L5, C5} = fun PairsFromForm(_, L1, C1) when L1 =< 0 -> {[{?any,?opt,?any}], L1, C1}; PairsFromForm([], L1, C1) -> {[], L1, C1}; PairsFromForm([{type, _, Oper, [KF, VF]}|T], L1, C1) -> D = D0 - 1, {Key, L2, C2} = from_form(KF, S, D, L1, C1), {Val, L3, C3} = from_form(VF, S, D, L2, C2), {Pairs0, L4, C4} = PairsFromForm(T, L3 - 1, C3), case Oper of map_field_assoc -> {[{Key,?opt, Val}|Pairs0], L4, C4}; map_field_exact -> {[{Key,?mand,Val}|Pairs0], L4, C4} end end(List, L, C), try 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; from_form({type, _L, mfa, []}, _S, _D, L, C) -> {t_mfa(), L, C}; from_form({type, _L, module, []}, _S, _D, L, C) -> {t_module(), L, C}; from_form({type, _L, nil, []}, _S, _D, L, C) -> {t_nil(), L, C}; from_form({type, _L, neg_integer, []}, _S, _D, L, C) -> {t_neg_integer(), L, C}; from_form({type, _L, non_neg_integer, []}, _S, _D, L, C) -> {t_non_neg_integer(), L, C}; from_form({type, _L, no_return, []}, _S, _D, L, C) -> {t_unit(), L, C}; from_form({type, _L, node, []}, _S, _D, L, C) -> {t_node(), L, C}; from_form({type, _L, none, []}, _S, _D, L, C) -> {t_none(), L, C}; from_form({type, _L, nonempty_list, []}, _S, _D, L, C) -> {t_nonempty_list(), L, C}; from_form({type, _L, nonempty_list, [Type]}, S, D, L, C) -> {T, L1, C1} = from_form(Type, S, D, L - 1, C), {t_nonempty_list(T), L1, C1}; from_form({type, _L, nonempty_improper_list, [Cont, Term]}, S, D, L, C) -> {T1, L1, C1} = from_form(Cont, S, D, L - 1, C), {T2, L2, C2} = from_form(Term, S, D, L1, C1), {t_cons(T1, T2), L2, C2}; from_form({type, _L, nonempty_maybe_improper_list, []}, _S, _D, L, C) -> {t_cons(?any, ?any), L, C}; from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, S, D, L, C) -> {T1, L1, C1} = from_form(Cont, S, D, L - 1, C), {T2, L2, C2} = from_form(Term, S, D, L1, C1), {t_cons(T1, T2), L2, C2}; from_form({type, _L, nonempty_string, []}, _S, _D, L, C) -> {t_nonempty_string(), L, C}; from_form({type, _L, number, []}, _S, _D, L, C) -> {t_number(), L, C}; from_form({type, _L, pid, []}, _S, _D, L, C) -> {t_pid(), L, C}; from_form({type, _L, port, []}, _S, _D, L, C) -> {t_port(), L, C}; from_form({type, _L, pos_integer, []}, _S, _D, L, C) -> {t_pos_integer(), L, C}; from_form({type, _L, maybe_improper_list, []}, _S, _D, L, C) -> {t_maybe_improper_list(), L, C}; from_form({type, _L, maybe_improper_list, [Content, Termination]}, S, D, L, C) -> {T1, L1, C1} = from_form(Content, S, D, L - 1, C), {T2, L2, C2} = from_form(Termination, S, D, L1, C1), {t_maybe_improper_list(T1, T2), L2, C2}; from_form({type, _L, product, Elements}, S, D, L, C) -> {Lst, L1, C1} = list_from_form(Elements, S, D - 1, L, C), {t_product(Lst), L1, C1}; from_form({type, _L, range, [From, To]} = Type, _S, _D, L, C) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> {t_from_range(FromVal, ToVal), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; from_form({type, _L, record, [Name|Fields]}, S, D, L, C) -> record_from_form(Name, Fields, S, D, L, C); from_form({type, _L, reference, []}, _S, _D, L, C) -> {t_reference(), L, C}; from_form({type, _L, string, []}, _S, _D, L, C) -> {t_string(), L, C}; from_form({type, _L, term, []}, _S, _D, L, C) -> {t_any(), L, C}; from_form({type, _L, timeout, []}, _S, _D, L, C) -> {t_timeout(), L, C}; from_form({type, _L, tuple, any}, _S, _D, L, C) -> {t_tuple(), L, C}; from_form({type, _L, tuple, Args}, S, D, L, C) -> {Lst, L1, C1} = list_from_form(Args, S, D - 1, L, C), {t_tuple(Lst), L1, C1}; from_form({type, _L, union, Args}, S, D, L, C) -> {Lst, L1, C1} = list_from_form(Args, S, D, L, C), {t_sup(Lst), L1, C1}; from_form({user_type, _L, Name, Args}, S, D, L, C) -> type_from_form(Name, Args, S, D, L, C); from_form({type, _L, Name, Args}, S, D, L, C) -> %% Compatibility: modules compiled before Erlang/OTP 18.0. type_from_form(Name, Args, S, D, L, C); from_form({opaque, _L, Name, {Mod, Args, Rep}}, _S, _D, L, C) -> %% XXX. To be removed. {t_opaque(Mod, Name, Args, Rep), L, C}. builtin_type(Name, Type, S, D, L, C) -> #from_form{site = Site, mrecs = MR} = S, M = site_module(Site), case lookup_module_types(M, MR, C) of {R, C1} -> case lookup_type(Name, 0, R) of {_, {{_M, _FL, _F, _A}, _T}} -> type_from_form(Name, [], S, D, L, C1); error -> {Type, L, C1} end; error -> {Type, L, C} end. type_from_form(Name, Args, S, D, L, C) -> #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, ArgsLen = length(Args), Module = site_module(Site), TypeName = {type, {Module, Name, ArgsLen}}, 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, Site, S, D, L, C1); false -> {t_any(), L, C} end. 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}, {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), CKey = cache_key(Module, Name, ArgTypes, TypeNames, D), case cache_find(CKey, C) of {CachedType, DeltaL} -> {CachedType, L1 - DeltaL, C}; error -> List = lists:zip(ArgNames, ArgTypes), TmpV = maps:from_list(List), S2 = S1#from_form{site = TypeName, vtab = TmpV}, Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, {NewType, L3, C3} = case Tag of type -> recur_limit(Fun, D, L1, TypeName, TypeNames); opaque -> {Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames), Rep1 = choose_opaque_type(Rep, Type), Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of true -> Rep; false -> ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), t_opaque(Module, Name, ArgTypes2, Rep1) end, {Rep2, L2, C2} end, C4 = cache_put(CKey, NewType, L1 - L3, C3), {NewType, L3, C4} end; error -> Msg = io_lib:format("Unable to find type ~tw/~w\n", [Name, ArgsLen]), throw({error, Msg}) end. remote_from_form(RemMod, Name, Args, S, D, L, C) -> #from_form{site = Site, xtypes = ET, mrecs = MR, tnames = TypeNames} = S, if ET =:= replace_by_none -> {t_none(), L, C}; true -> ArgsLen = length(Args), MFA = {RemMod, Name, ArgsLen}, case lookup_module_types(RemMod, MR, C) of error -> self() ! {self(), ext_types, MFA}, {t_any(), L, C}; {RemDict, C1} -> case sets:is_element(MFA, ET) of true -> RemType = {type, MFA}, case can_unfold_more(RemType, TypeNames) of true -> remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, Site, S, D, L, C1); false -> {t_any(), L, C1} end; false -> self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, {t_any(), L, C1} end end end. remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, 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 cache_find(CKey, C) of {CachedType, DeltaL} -> {CachedType, L - DeltaL, C}; error -> List = lists:zip(ArgNames, ArgTypes), TmpVarTab = maps:from_list(List), S2 = S1#from_form{site = RemType, vtab = TmpVarTab}, Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, {NewType, L3, C3} = case Tag of type -> recur_limit(Fun, D, L1, RemType, TypeNames); opaque -> {NewRep, L2, C2} = recur_limit(Fun, D, L1, RemType, TypeNames), NewRep1 = choose_opaque_type(NewRep, Type), NewRep2 = case cannot_have_opaque(NewRep1, RemType, TypeNames) of true -> NewRep; false -> ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), t_opaque(Mod, Name, ArgTypes2, NewRep1) end, {NewRep2, L2, C2} end, C4 = cache_put(CKey, NewType, L1 - L3, C3), {NewType, L3, C4} end; error -> Msg = io_lib:format("Unable to find remote type ~w:~tw()\n", [RemMod, Name]), throw({error, Msg}) end. subst_all_vars_to_any_list(Types) -> [subst_all_vars_to_any(Type) || Type <- Types]. %% 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, S, D0, L0, C) -> #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, RecordType = {record, Name}, case can_unfold_more(RecordType, TypeNames) of true -> 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)}}, S1 = S#from_form{site = Site1, tnames = NewTypeNames}, Fun = fun(D, L) -> {GetModRec, L1, C2} = get_mod_record(ModFields, DeclFields, S1, D, L, C1), case GetModRec of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~tw{~tw}\n", [Name, FieldName])}); {ok, NewFields} -> S2 = S1#from_form{vtab = var_table__new()}, {NewFields1, L2, C3} = fields_from_form(NewFields, S2, D, L1, C2), Rec = t_tuple( [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields1]]), {Rec, L2, C3} end end, recur_limit(Fun, D0, L0, RecordType, TypeNames); error -> throw({error, io_lib:format("Unknown record #~tw{}\n", [Name])}) end; false -> {t_any(), L0, C} end. get_mod_record([], DeclFields, _S, _D, L, C) -> {{ok, DeclFields}, L, C}; get_mod_record(ModFields, DeclFields, S, D, L, C) -> DeclFieldsDict = lists:keysort(1, DeclFields), {ModFieldsDict, L1, C1} = build_field_dict(ModFields, S, D, L, C), case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of {error, _FieldName} = Error -> {Error, L1, C1}; {ok, FinalKeyDict} -> Fields = [lists:keyfind(FieldName, 1, FinalKeyDict) || {FieldName, _, _} <- DeclFields], {{ok, Fields}, L1, C1} end. build_field_dict(FieldTypes, S, D, L, C) -> build_field_dict(FieldTypes, S, D, L, C, []). build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], S, D, L, C, Acc) -> {T, L1, C1} = from_form(Type, S, D, L - 1, C), NewAcc = [{Name, Type, T}|Acc], build_field_dict(Left, S, D, L1, C1, NewAcc); build_field_dict([], _S, _D, L, C, Acc) -> {lists:keysort(1, Acc), L, C}. 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}. %% 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([], _S, _D, L, C) -> {[], L, C}; fields_from_form([{Name, Abstr, _Type}|Tail], S, D, L, C) -> {T, L1, C1} = from_form(Abstr, S, D, L, C), {F, L2, C2} = fields_from_form(Tail, S, D, L1, C1), {[{Name, T}|F], L2, C2}. list_from_form([], _S, _D, L, C) -> {[], L, C}; list_from_form([H|Tail], S, D, L, C) -> {H1, L1, C1} = from_form(H, S, D, L - 1, 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) -> verify_possible(MKs, ShdwPs), {promote_to_mand(MKs, Pairs), DefK, DefV}; map_from_form([{SKey,MNess,Val}|SPairs], ShdwPs0, MKs0, Pairs0, DefK0, DefV0) -> Key = lists:foldl(fun({K,_},S)->t_subtract(S,K)end, SKey, ShdwPs0), ShdwPs = case Key of ?none -> ShdwPs0; _ -> [{Key,Val}|ShdwPs0] end, MKs = case MNess of ?mand -> [SKey|MKs0]; ?opt -> MKs0 end, if MNess =:= ?mand, SKey =:= ?none -> throw(none); true -> ok end, {Pairs, DefK, DefV} = case is_singleton_type(Key) of true -> MNess1 = case Val =:= ?none of true -> ?opt; false -> MNess end, {mapdict_insert({Key,MNess1,Val}, Pairs0), DefK0, DefV0}; false -> case Key =:= ?none orelse Val =:= ?none of true -> {Pairs0, DefK0, DefV0}; false -> {Pairs0, t_sup(DefK0, Key), t_sup(DefV0, Val)} end end, map_from_form(SPairs, ShdwPs, MKs, Pairs, DefK, DefV). %% Verifies that all mandatory keys are possible, throws 'none' otherwise verify_possible(MKs, ShdwPs) -> lists:foreach(fun(M) -> verify_possible_1(M, ShdwPs) end, MKs). verify_possible_1(M, ShdwPs) -> case lists:any(fun({K,_}) -> t_inf(M, K) =/= ?none end, ShdwPs) of true -> ok; false -> throw(none) end. -spec promote_to_mand([erl_type()], t_map_dict()) -> t_map_dict(). promote_to_mand(_, []) -> []; promote_to_mand(MKs, [E={K,_,V}|T]) -> [case lists:any(fun(M) -> t_is_equal(K,M) end, MKs) of true -> {K, ?mand, V}; false -> E end|promote_to_mand(MKs, T)]. -define(RECUR_EXPAND_LIMIT, 10). -define(RECUR_EXPAND_DEPTH, 2). %% If more of the limited resources is spent on the non-recursive %% forms, more warnings are found. And the analysis is also a bit %% faster. %% %% Setting REC_TYPE_LIMIT to 1 would work also work well. recur_limit(Fun, D, L, _, _) when L =< ?RECUR_EXPAND_DEPTH, D =< ?RECUR_EXPAND_LIMIT -> Fun(D, L); recur_limit(Fun, D, L, TypeName, TypeNames) -> case is_recursive(TypeName, TypeNames) of true -> {T, L1, C1} = Fun(?RECUR_EXPAND_DEPTH, ?RECUR_EXPAND_LIMIT), {T, L - L1, C1}; false -> Fun(D, L) end. -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_type_table(), var_table(), cache()) -> cache(). t_check_record_fields(Form, ExpTypes, Site, RecDict, VarTable, Cache) -> State = #from_form{site = Site, xtypes = ExpTypes, mrecs = RecDict, vtab = VarTable, tnames = []}, check_record_fields(Form, State, Cache). -spec check_record_fields(parse_form(), #from_form{}, cache()) -> cache(). %% If there is something wrong with parse_form() %% throw({error, io_lib:chars()} is called. check_record_fields({var, _L, _}, _S, C) -> C; check_record_fields({ann_type, _L, [_Var, Type]}, S, C) -> check_record_fields(Type, S, C); check_record_fields({paren_type, _L, [Type]}, S, C) -> check_record_fields(Type, S, C); check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, S, C) -> list_check_record_fields(Args, S, C); check_record_fields({atom, _L, _}, _S, C) -> C; check_record_fields({integer, _L, _}, _S, C) -> C; check_record_fields({char, _L, _}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; check_record_fields({type, _L, tuple, any}, _S, C) -> C; check_record_fields({type, _L, map, any}, _S, C) -> C; check_record_fields({type, _L, binary, [_Base, _Unit]}, _S, C) -> C; check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, S, C) -> check_record_fields(Range, S, C); check_record_fields({type, _L, range, [_From, _To]}, _S, C) -> C; check_record_fields({type, _L, record, [Name|Fields]}, S, C) -> check_record(Name, Fields, S, C); check_record_fields({type, _L, _, Args}, S, C) -> list_check_record_fields(Args, S, C); check_record_fields({user_type, _L, _Name, Args}, S, C) -> list_check_record_fields(Args, S, C). check_record({atom, _, Name}, ModFields, S, C) -> #from_form{site = Site, mrecs = MR} = S, M = site_module(Site), {R, C1} = lookup_module_types(M, MR, C), {ok, DeclFields} = lookup_record(Name, R), case check_fields(Name, ModFields, DeclFields, S, C1) of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~tw{~tw}\n", [Name, FieldName])}); C2 -> C2 end. check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], DeclFields, S, C) -> #from_form{site = Site0, xtypes = ET, mrecs = MR, vtab = V} = S, M = site_module(Site0), Site = {record, {M, RecName, length(DeclFields)}}, {Type, C1} = t_from_form(Abstr, ET, Site, MR, V, C), {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(RecName, Left, DeclFields, S, C1) end; check_fields(_RecName, [], _Decl, _S, C) -> C. list_check_record_fields([], _S, C) -> C; list_check_record_fields([H|Tail], S, C) -> C1 = check_record_fields(H, S, C), list_check_record_fields(Tail, S, C1). site_module({_, {Module, _, _}}) -> Module. -spec cache__new() -> cache(). cache__new() -> #cache{}. -spec cache_key(module(), atom(), [erl_type()], type_names(), expand_depth()) -> cache_key(). %% If TypeNames is left out from the key, the cache is smaller, and %% the form-to-type translation is faster. But it would be a shame if, %% for example, any() is used, where a more complex type should be %% used. There is also a slight risk of creating unnecessarily big %% types. cache_key(Module, Name, ArgTypes, TypeNames, D) -> {Module, Name, D, ArgTypes, TypeNames}. -spec cache_find(cache_key(), cache()) -> {erl_type(), expand_limit()} | 'error'. cache_find(Key, #cache{types = Types}) -> case maps:find(Key, Types) of {ok, Value} -> Value; error -> error end. -spec cache_put(cache_key(), erl_type(), expand_limit(), cache()) -> cache(). cache_put(_Key, _Type, DeltaL, Cache) when DeltaL < 0 -> %% The type is truncated; do not reuse it. Cache; cache_put(Key, Type, DeltaL, #cache{types = Types} = Cache) -> NewTypes = maps:put(Key, {Type, DeltaL}, Types), Cache#cache{types = NewTypes}. -spec t_var_names([parse_form()]) -> [atom()]. t_var_names([{var, _, Name}|L]) when Name =/= '_' -> [Name|t_var_names(L)]; t_var_names([]) -> []. -spec t_form_to_string(parse_form()) -> string(). t_form_to_string({var, _L, '_'}) -> "_"; t_form_to_string({var, _L, Name}) -> atom_to_list(Name); t_form_to_string({atom, _L, Atom}) -> io_lib:write_string(atom_to_list(Atom), $'); % To quote or not to quote... ' t_form_to_string({integer, _L, Int}) -> integer_to_list(Int); t_form_to_string({char, _L, Char}) -> integer_to_list(Char); t_form_to_string({op, _L, _Op, _Arg} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); _ -> io_lib:format("Badly formed type ~w", [Op]) end; t_form_to_string({op, _L, _Op, _Arg1, _Arg2} = Op) -> case erl_eval:partial_eval(Op) of {integer, _, _} = Int -> t_form_to_string(Int); _ -> io_lib:format("Badly formed type ~w", [Op]) end; t_form_to_string({ann_type, _L, [Var, Type]}) -> t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type); t_form_to_string({paren_type, _L, [Type]}) -> flat_format("(~ts)", [t_form_to_string(Type)]); t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) -> ArgString = "(" ++ flat_join(t_form_to_string_list(Args), ",") ++ ")", flat_format("~w:~tw", [Mod, Name]) ++ ArgString; t_form_to_string({type, _L, arity, []}) -> "arity()"; t_form_to_string({type, _L, binary, []}) -> "binary()"; t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of {{integer, _, B}, {integer, _, U}} -> %% the following mirrors the clauses of t_to_string/2 case {U, B} of {0, 0} -> "<<>>"; {8, 0} -> "binary()"; {1, 0} -> "bitstring()"; {0, B} -> flat_format("<<_:~w>>", [B]); {U, 0} -> flat_format("<<_:_*~w>>", [U]); {U, B} -> flat_format("<<_:~w,_:_*~w>>", [B, U]) end; _ -> io_lib:format("Badly formed bitstr type ~w", [Type]) end; t_form_to_string({type, _L, bitstring, []}) -> "bitstring()"; t_form_to_string({type, _L, 'fun', []}) -> "fun()"; t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) -> "fun(...) -> " ++ t_form_to_string(Range); t_form_to_string({type, _L, 'fun', [{type, _, product, Domain}, Range]}) -> "fun((" ++ flat_join(t_form_to_string_list(Domain), ",") ++ ") -> " ++ t_form_to_string(Range) ++ ")"; 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, any}) -> "map()"; t_form_to_string({type, _L, map, Args}) -> "#{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}"; t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) -> t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val); t_form_to_string({type, _L, map_field_exact, [Key, Val]}) -> t_form_to_string(Key) ++ ":=" ++ t_form_to_string(Val); t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; t_form_to_string({type, _L, node, []}) -> "node()"; t_form_to_string({type, _L, nonempty_list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ ",...]"; t_form_to_string({type, _L, nonempty_string, []}) -> "nonempty_string()"; t_form_to_string({type, _L, product, Elements}) -> "<" ++ flat_join(t_form_to_string_list(Elements), ",") ++ ">"; t_form_to_string({type, _L, range, [From, To]} = Type) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> flat_format("~w..~w", [FromVal, ToVal]); _ -> flat_format("Badly formed type ~w",[Type]) end; t_form_to_string({type, _L, record, [{atom, _, Name}]}) -> flat_format("#~tw{}", [Name]); t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) -> FieldString = flat_join(t_form_to_string_list(Fields), ","), flat_format("#~tw{~ts}", [Name, FieldString]); t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) -> flat_format("~tw::~ts", [Name, t_form_to_string(Type)]); t_form_to_string({type, _L, term, []}) -> "term()"; t_form_to_string({type, _L, timeout, []}) -> "timeout()"; t_form_to_string({type, _L, tuple, any}) -> "tuple()"; t_form_to_string({type, _L, tuple, Args}) -> "{" ++ flat_join(t_form_to_string_list(Args), ",") ++ "}"; t_form_to_string({type, _L, union, Args}) -> flat_join(t_form_to_string_list(Args), " | "); t_form_to_string({type, _L, Name, []} = T) -> try M = mod, Site = {type, {M,Name,0}}, V = var_table__new(), C = cache__new(), State = #from_form{site = Site, xtypes = sets:new(), mrecs = 'undefined', vtab = V, tnames = []}, {T1, _, _} = from_form(T, State, _Deep=1000, _ALot=1000000, C), t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; t_form_to_string({user_type, _L, Name, List}) -> flat_format("~tw(~ts)", [Name, flat_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, []). t_form_to_string_list([H|T], Acc) -> t_form_to_string_list(T, [t_form_to_string(H)|Acc]); t_form_to_string_list([], Acc) -> lists:reverse(Acc). -spec atom_to_string(atom()) -> string(). atom_to_string(Atom) -> flat_format("~tw", [Atom]). %%============================================================================= %% %% Utilities %% %%============================================================================= -spec any_none([erl_type()]) -> boolean(). any_none([?none|_Left]) -> true; any_none([_|Left]) -> any_none(Left); any_none([]) -> false. -spec any_none_or_unit([erl_type()]) -> boolean(). any_none_or_unit([?none|_]) -> true; any_none_or_unit([?unit|_]) -> true; any_none_or_unit([_|Left]) -> any_none_or_unit(Left); any_none_or_unit([]) -> false. -spec is_erl_type(any()) -> boolean(). is_erl_type(?any) -> true; is_erl_type(?none) -> true; is_erl_type(?unit) -> true; is_erl_type(#c{}) -> true; is_erl_type(_) -> false. -spec lookup_module_types(module(), mod_type_table(), cache()) -> 'error' | {type_table(), cache()}. lookup_module_types(Module, CodeTable, Cache) -> #cache{mod_recs = {mrecs, MRecs}} = Cache, case dict:find(Module, MRecs) of {ok, R} -> {R, Cache}; error -> try ets:lookup_element(CodeTable, Module, 2) of R -> NewMRecs = dict:store(Module, R, MRecs), {R, Cache#cache{mod_recs = {mrecs, NewMRecs}}} catch _:_ -> error end end. -spec lookup_record(atom(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, Table) when is_atom(Tag) -> case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, List}} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. error; error -> error end. -spec lookup_record(atom(), arity(), type_table()) -> 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, Arity, Table) when is_atom(Tag) -> case maps:find({record, Tag}, Table) of {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. -spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. lookup_type(Name, Arity, Table) -> case maps:find({type, Name, Arity}, Table) of error -> case maps:find({opaque, Name, Arity}, Table) of error -> error; {ok, Found} -> {opaque, Found} end; {ok, Found} -> {type, Found} end. -spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> boolean(). type_is_defined(TypeOrOpaque, Name, Arity, Table) -> maps:is_key({TypeOrOpaque, Name, Arity}, Table). cannot_have_opaque(Type, TypeName, TypeNames) -> t_is_none(Type) orelse is_recursive(TypeName, TypeNames). is_recursive(TypeName, TypeNames) -> lists:member(TypeName, TypeNames). can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, lists:foldl(Fun, 0, TypeNames) < ?REC_TYPE_LIMIT. -spec do_opaque(erl_type(), opaques(), fun((_) -> T)) -> T. %% Probably a little faster than calling t_unopaque/2. %% Unions that are due to opaque types are unopaqued. do_opaque(?opaque(_) = Type, Opaques, Pred) -> case Opaques =:= 'universe' orelse is_opaque_type(Type, Opaques) of true -> do_opaque(t_opaque_structure(Type), Opaques, Pred); false -> Pred(Type) end; do_opaque(?union(List) = Type, Opaques, Pred) -> [A,B,F,I,L,N,T,M,O,Map] = List, if O =:= ?none -> Pred(Type); true -> case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of true -> S = t_opaque_structure(O), do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred); false -> Pred(Type) end end; do_opaque(Type, _Opaques, Pred) -> Pred(Type). map_all_values(?map(Pairs,_,DefV)) -> [DefV|[V || {V, _, _} <- Pairs]]. map_all_keys(?map(Pairs,DefK,_)) -> [DefK|[K || {_, _, K} <- Pairs]]. map_all_types(M) -> map_all_keys(M) ++ map_all_values(M). %% Tests if a type has exactly one possible value. -spec t_is_singleton(erl_type()) -> boolean(). t_is_singleton(Type) -> t_is_singleton(Type, 'universe'). -spec t_is_singleton(erl_type(), opaques()) -> boolean(). t_is_singleton(Type, Opaques) -> do_opaque(Type, Opaques, fun is_singleton_type/1). %% 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)) -> ordsets:size(Set) =:= 1; is_singleton_type(?int_range(V, V)) -> true; is_singleton_type(?int_set(Set)) -> ordsets:size(Set) =:= 1; is_singleton_type(_) -> false. %% Returns the only possible value of a singleton type. -spec t_singleton_to_term(erl_type(), opaques()) -> term(). t_singleton_to_term(Type, Opaques) -> do_opaque(Type, Opaques, fun singleton_type_to_term/1). singleton_type_to_term(?nil) -> []; singleton_type_to_term(?atom(Set)) when Set =/= ?any -> case ordsets:size(Set) of 1 -> hd(ordsets:to_list(Set)); _ -> error(badarg) end; singleton_type_to_term(?int_range(V, V)) -> V; singleton_type_to_term(?int_set(Set)) -> case ordsets:size(Set) of 1 -> hd(ordsets:to_list(Set)); _ -> error(badarg) end; singleton_type_to_term(?tuple(Types, Arity, _)) when is_integer(Arity) -> lists:map(fun singleton_type_to_term/1, Types); singleton_type_to_term(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) -> singleton_type_to_term(OnlyTuple); singleton_type_to_term(?map(Pairs, ?none, ?none)) -> maps:from_list([{singleton_type_to_term(K), singleton_type_to_term(V)} || {K,?mand,V} <- Pairs]). %% ----------------------------------- %% Set %% set_singleton(Element) -> ordsets:from_list([Element]). set_is_singleton(Element, Set) -> set_singleton(Element) =:= Set. set_is_element(Element, Set) -> ordsets:is_element(Element, Set). set_union(?any, _) -> ?any; set_union(_, ?any) -> ?any; set_union(S1, S2) -> case ordsets:union(S1, S2) of S when length(S) =< ?SET_LIMIT -> S; _ -> ?any end. %% The intersection and subtraction can return ?none. %% This should always be handled right away since ?none is not a valid set. %% However, ?any is considered a valid set. set_intersection(?any, S) -> S; set_intersection(S, ?any) -> S; set_intersection(S1, S2) -> case ordsets:intersection(S1, S2) of [] -> ?none; S -> S end. set_subtract(_, ?any) -> ?none; set_subtract(?any, _) -> ?any; set_subtract(S1, S2) -> case ordsets:subtract(S1, S2) of [] -> ?none; S -> S end. set_from_list(List) -> case length(List) of L when L =< ?SET_LIMIT -> ordsets:from_list(List); L when L > ?SET_LIMIT -> ?any end. set_to_list(Set) -> ordsets:to_list(Set). set_filter(Fun, Set) -> case ordsets:filter(Fun, Set) of [] -> ?none; NewSet -> NewSet end. set_size(Set) -> ordsets:size(Set). set_to_string(Set) -> L = [case is_atom(X) of true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs ' false -> flat_format("~tw", [X]) end || X <- set_to_list(Set)], flat_join(L, " | "). set_min([H|_]) -> H. set_max(Set) -> hd(lists:reverse(Set)). flat_format(F, S) -> lists:flatten(io_lib:format(F, S)). flat_join(List, Sep) -> lists:flatten(lists:join(Sep, List)). %%============================================================================= %% %% Utilities for the binary type %% %%============================================================================= -spec gcd(integer(), integer()) -> integer(). gcd(A, B) when B > A -> gcd1(B, A); gcd(A, B) -> gcd1(A, B). -spec gcd1(integer(), integer()) -> integer(). gcd1(A, 0) -> A; gcd1(A, B) -> case A rem B of 0 -> B; X -> gcd1(B, X) end. -spec bitstr_concat(erl_type(), erl_type()) -> erl_type(). bitstr_concat(?none, _) -> ?none; bitstr_concat(_, ?none) -> ?none; bitstr_concat(?bitstr(U1, B1), ?bitstr(U2, B2)) -> t_bitstr(gcd(U1, U2), B1+B2). -spec bitstr_match(erl_type(), erl_type()) -> erl_type(). bitstr_match(?none, _) -> ?none; bitstr_match(_, ?none) -> ?none; bitstr_match(?bitstr(0, B1), ?bitstr(0, B2)) when B1 =< B2 -> t_bitstr(0, B2-B1); bitstr_match(?bitstr(0, _B1), ?bitstr(0, _B2)) -> ?none; bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) when B1 =< B2 -> t_bitstr(U2, B2-B1); bitstr_match(?bitstr(0, B1), ?bitstr(U2, B2)) -> t_bitstr(U2, handle_base(U2, B2-B1)); bitstr_match(?bitstr(_, B1), ?bitstr(0, B2)) when B1 > B2 -> ?none; bitstr_match(?bitstr(U1, B1), ?bitstr(U2, B2)) -> GCD = gcd(U1, U2), t_bitstr(GCD, handle_base(GCD, B2-B1)). -spec handle_base(integer(), integer()) -> integer(). handle_base(Unit, Pos) when Pos >= 0 -> Pos rem Unit; handle_base(Unit, Neg) -> (Unit+(Neg rem Unit)) rem Unit. family(L) -> R = sofs:relation(L), F = sofs:relation_to_family(R), sofs:to_external(F). %%============================================================================= %% %% Interface functions for abstract data types defined in this module %% %%============================================================================= -spec var_table__new() -> var_table(). var_table__new() -> maps:new().