diff options
Diffstat (limited to 'lib')
40 files changed, 6452 insertions, 2335 deletions
diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 35156afff2..bb7e39dfda 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -423,6 +423,9 @@ message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}) -> message_to_string({opaque_eq, [Type, _Op, OpaqueType]}) -> io_lib:format("Attempt to test for equality between a term of type ~s" " and a term of opaque type ~s\n", [Type, OpaqueType]); +message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}) -> + io_lib:format("Guard test ~s ~s ~s contains ~s\n", + [Arg1, Infix, Arg2, form_positions(ArgNs)]); message_to_string({opaque_guard, [Guard, Args]}) -> io_lib:format("Guard test ~w~s breaks the opaqueness of its argument\n", [Guard, Args]); @@ -435,8 +438,16 @@ message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}) -> message_to_string({opaque_neq, [Type, _Op, OpaqueType]}) -> io_lib:format("Attempt to test for inequality between a term of type ~s" " and a term of opaque type ~s\n", [Type, OpaqueType]); -message_to_string({opaque_type_test, [Fun, Opaque]}) -> - io_lib:format("The type test ~s(~s) breaks the opaqueness of the term ~s\n", [Fun, Opaque, Opaque]); +message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}) -> + io_lib:format("The type test ~s~s breaks the opaqueness of the term ~s~s\n", + [Fun, Args, Arg, ArgType]); +message_to_string({opaque_size, [SizeType, Size]}) -> + io_lib:format("The size ~s breaks the opaqueness of ~s\n", + [SizeType, Size]); +message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) -> + io_lib:format("The call ~s:~s~s breaks the opaqueness of the term ~s :: ~s\n", + [M, F, Args, Culprit, OpaqueType]); + %%----- Warnings for concurrency errors -------------------- message_to_string({race_condition, [M, F, Args, Reason]}) -> io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]); diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 365c0b36d4..a7be6e0d05 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -613,7 +613,7 @@ cl_loop(State, LogCache) -> -spec failed_anal_msg(string(), [_]) -> nonempty_string(). failed_anal_msg(Reason, LogCache) -> - Msg = "Analysis failed with error:\n" ++ Reason ++ "\n", + Msg = "Analysis failed with error:\n" ++ lists:flatten(Reason) ++ "\n", case LogCache =:= [] of true -> Msg; false -> @@ -640,7 +640,7 @@ store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> -spec cl_error(string()) -> no_return(). cl_error(Msg) -> - throw({dialyzer_error, Msg}). + throw({dialyzer_error, lists:flatten(Msg)}). -spec cl_error(#cl_state{}, string()) -> no_return(). @@ -650,7 +650,7 @@ cl_error(State, Msg) -> Outfile -> io:format(Outfile, "\n~s\n", [Msg]) end, maybe_close_output_file(State), - throw({dialyzer_error, Msg}). + throw({dialyzer_error, lists:flatten(Msg)}). return_value(State = #cl_state{erlang_mode = ErlangMode, mod_deps = ModDeps, diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 332a326b0d..3467ab4e65 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,10 +21,10 @@ -module(dialyzer_contracts). -export([check_contract/2, - check_contracts/3, + check_contracts/4, contracts_without_fun/3, contract_to_string/1, - get_invalid_contract_warnings/3, + get_invalid_contract_warnings/4, get_contract_args/1, get_contract_return/1, get_contract_return/2, @@ -160,17 +160,22 @@ process_contract_remote_types(CodeServer) -> dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, CodeServer). +-type opaques() :: [erl_types:erl_type()] | 'universe'. +-type opaques_fun() :: fun((module()) -> opaques()). + -spec check_contracts([{mfa(), file_contract()}], - dialyzer_callgraph:callgraph(), dict()) -> plt_contracts(). + dialyzer_callgraph:callgraph(), dict(), + opaques_fun()) -> plt_contracts(). -check_contracts(Contracts, Callgraph, FunTypes) -> +check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) -> FoldFun = fun(Label, Type, NewContracts) -> case dialyzer_callgraph:lookup_name(Label, Callgraph) of {ok, {M,F,A} = MFA} -> case orddict:find(MFA, Contracts) of {ok, {_FileLine, Contract}} -> - case check_contract(Contract, Type) of + Opaques = FindOpaques(M), + case check_contract(Contract, Type, Opaques) of ok -> case erl_bif_types:is_known(M, F, A) of true -> @@ -192,7 +197,10 @@ check_contracts(Contracts, Callgraph, FunTypes) -> %% Checks all components of a contract -spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}. -check_contract(#contract{contracts = Contracts}, SuccType) -> +check_contract(Contract, SuccType) -> + check_contract(Contract, SuccType, 'universe'). + +check_contract(#contract{contracts = Contracts}, SuccType, Opaques) -> try Contracts1 = [{Contract, insert_constraints(Constraints, dict:new())} || {Contract, Constraints} <- Contracts], @@ -203,9 +211,9 @@ check_contract(#contract{contracts = Contracts}, SuccType) -> error -> {error, {overlapping_contract, []}}; ok -> - InfList = [erl_types:t_inf(Contract, SuccType, opaque) + InfList = [erl_types:t_inf(Contract, SuccType, Opaques) || Contract <- Contracts2], - case check_contract_inf_list(InfList, SuccType) of + case check_contract_inf_list(InfList, SuccType, Opaques) of {error, _} = Invalid -> Invalid; ok -> check_extraneous(Contracts2, SuccType) end @@ -217,7 +225,7 @@ check_contract(#contract{contracts = Contracts}, SuccType) -> check_domains([_]) -> ok; check_domains([Dom|Doms]) -> Fun = fun(D) -> - erl_types:any_none_or_unit(erl_types:t_inf_lists(Dom, D, opaque)) + erl_types:any_none_or_unit(erl_types:t_inf_lists(Dom, D)) end, case lists:all(Fun, Doms) of true -> check_domains(Doms); @@ -227,23 +235,23 @@ check_domains([Dom|Doms]) -> %% Allow a contract if one of the overloaded contracts is possible. %% We used to be more strict, e.g., all overloaded contracts had to be %% possible. -check_contract_inf_list([FunType|Left], SuccType) -> +check_contract_inf_list([FunType|Left], SuccType, Opaques) -> FunArgs = erl_types:t_fun_args(FunType), case lists:any(fun erl_types:t_is_none_or_unit/1, FunArgs) of - true -> check_contract_inf_list(Left, SuccType); + true -> check_contract_inf_list(Left, SuccType, Opaques); false -> STRange = erl_types:t_fun_range(SuccType), case erl_types:t_is_none_or_unit(STRange) of true -> ok; false -> Range = erl_types:t_fun_range(FunType), - case erl_types:t_is_none(erl_types:t_inf(STRange, Range, opaque)) of - true -> check_contract_inf_list(Left, SuccType); + case erl_types:t_is_none(erl_types:t_inf(STRange, Range)) of + true -> check_contract_inf_list(Left, SuccType, Opaques); false -> ok end end end; -check_contract_inf_list([], _SuccType) -> +check_contract_inf_list([], _SuccType, _Opaques) -> {error, invalid_contract}. check_extraneous([], _SuccType) -> ok; @@ -259,7 +267,7 @@ check_extraneous_1(Contract, SuccType) -> STRng = erl_types:t_fun_range(SuccType), ?debug("CR = ~p\nSR = ~p\n", [CRngs, STRng]), case [CR || CR <- CRngs, - erl_types:t_is_none(erl_types:t_inf(CR, STRng, opaque))] of + erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of [] -> CRngList = list_part(CRng), STRngList = list_part(STRng), @@ -268,7 +276,7 @@ check_extraneous_1(Contract, SuccType) -> true -> CRngElements = erl_types:t_list_elements(CRngList), STRngElements = erl_types:t_list_elements(STRngList), - Inf = erl_types:t_inf(CRngElements, STRngElements, opaque), + Inf = erl_types:t_inf(CRngElements, STRngElements), case erl_types:t_is_none(Inf) of true -> {error, invalid_contract}; false -> ok @@ -278,7 +286,7 @@ check_extraneous_1(Contract, SuccType) -> end. list_part(Type) -> - erl_types:t_inf(erl_types:t_list(), Type, opaque). + erl_types:t_inf(erl_types:t_list(), Type). is_not_nil_list(Type) -> erl_types:t_is_list(Type) andalso not erl_types:t_is_nil(Type). @@ -374,7 +382,7 @@ insert_constraints([], Dict) -> Dict. store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine), - %% io:format("contract: ~p\n", [Contract]), + %% io:format("contract: ~p\n", [TmpContract]), dict:store(MFA, {FileLine, TmpContract}, SpecDict). contract_from_form(Forms, RecDict, FileLine) -> @@ -494,30 +502,35 @@ general_domain([], AccSig) -> AccSig1 = erl_types:subst_all_vars_to_any(AccSig), erl_types:t_fun_args(AccSig1). --spec get_invalid_contract_warnings([module()], dialyzer_codeserver:codeserver(), dialyzer_plt:plt()) -> [dial_warning()]. +-spec get_invalid_contract_warnings([module()], + dialyzer_codeserver:codeserver(), + dialyzer_plt:plt(), + opaques_fun()) -> [dial_warning()]. -get_invalid_contract_warnings(Modules, CodeServer, Plt) -> - get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, []). +get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) -> + get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, FindOpaques, []). -get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, Acc) -> +get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) -> Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer), Contracts2 = dict:to_list(Contracts1), Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), - NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, Acc), - get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, NewAcc); -get_invalid_contract_warnings_modules([], _CodeServer, _Plt, Acc) -> + NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, FindOpaques, Acc), + get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, FindOpaques, NewAcc); +get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) -> Acc. get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], - Plt, RecDict, Acc) -> + Plt, RecDict, FindOpaques, Acc) -> case dialyzer_plt:lookup(Plt, MFA) of none -> %% This must be a contract for a non-available function. Just accept it. - get_invalid_contract_warnings_funs(Left, Plt, RecDict, Acc); + get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, Acc); {value, {Ret, Args}} -> Sig = erl_types:t_fun(Args, Ret), + {M, _F, _A} = MFA, + Opaques = FindOpaques(M), NewAcc = - case check_contract(Contract, Sig) of + case check_contract(Contract, Sig, Opaques) of {error, invalid_contract} -> [invalid_contract_warning(MFA, FileLine, Sig, RecDict)|Acc]; {error, {overlapping_contract, []}} -> @@ -551,7 +564,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], BifArgs = erl_bif_types:arg_types(M, F, A), BifRet = erl_bif_types:type(M, F, A), BifSig = erl_types:t_fun(BifArgs, BifRet), - case check_contract(Contract, BifSig) of + case check_contract(Contract, BifSig, Opaques) of {error, _} -> [invalid_contract_warning(MFA, FileLine, BifSig, RecDict) |Acc]; @@ -564,9 +577,9 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], RecDict, Acc) end end, - get_invalid_contract_warnings_funs(Left, Plt, RecDict, NewAcc) + get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, NewAcc) end; -get_invalid_contract_warnings_funs([], _Plt, _RecDict, Acc) -> +get_invalid_contract_warnings_funs([], _Plt, _RecDict, _FindOpaques, Acc) -> Acc. invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) -> @@ -601,16 +614,23 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> end. extra_contract_warning({M, F, A}, FileLine, Contract, CSig, Sig, RecDict) -> - SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)), - ContractString0 = lists:flatten(dialyzer_utils:format_sig(CSig, RecDict)), + %% We do not want to depend upon erl_types:t_to_string() possibly + %% hiding the contents of opaque types. + SigUnopaque = erl_types:t_unopaque(Sig), + CSigUnopaque = erl_types:t_unopaque(CSig), + SigString0 = + lists:flatten(dialyzer_utils:format_sig(SigUnopaque, RecDict)), + ContractString0 = + lists:flatten(dialyzer_utils:format_sig(CSigUnopaque, RecDict)), %% The only difference is in record fields containing 'undefined' or not. - IsUndefRecordFieldsRelated = SigString =:= ContractString0, + IsUndefRecordFieldsRelated = SigString0 =:= ContractString0, {IsRemoteTypesRelated, SubtypeRelation} = is_remote_types_related(Contract, CSig, Sig, RecDict), case IsUndefRecordFieldsRelated orelse IsRemoteTypesRelated of true -> no_warning; false -> + SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)), ContractString = contract_to_string(Contract), {Tag, Msg} = case SubtypeRelation of diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 922ccad599..3591d5be8e 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,27 +41,33 @@ -include("dialyzer.hrl"). +%%-import(helper, %% 'helper' could be any module doing sanity checks... -import(erl_types, - [any_none/1, t_any/0, t_atom/0, t_atom/1, t_atom_vals/1, + [t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, + t_inf_lists/3, t_is_equal/2, t_is_subtype/2, t_subtract/2, + t_sup/1, t_sup/2]). + +-import(erl_types, + [any_none/1, t_any/0, t_atom/0, t_atom/1, t_atom_vals/1, t_atom_vals/2, t_binary/0, t_boolean/0, t_bitstr/0, t_bitstr/2, t_bitstr_concat/1, t_bitstr_match/2, - t_cons/0, t_cons/2, t_cons_hd/1, t_cons_tl/1, t_contains_opaque/1, + t_cons/0, t_cons/2, t_cons_hd/2, t_cons_tl/2, + t_contains_opaque/2, t_find_opaque_mismatch/2, t_float/0, t_from_range/2, t_from_term/1, - t_fun/0, t_fun/2, t_fun_args/1, t_fun_range/1, - t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, t_inf_lists_masked/3, - t_integer/0, t_integers/1, - t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_boolean/1, t_is_equal/2, - t_is_integer/1, t_is_nil/1, t_is_none/1, t_is_none_or_unit/1, - t_is_number/1, t_is_reference/1, t_is_pid/1, t_is_port/1, - t_is_subtype/2, t_is_unit/1, + t_fun/0, t_fun/2, t_fun_args/1, t_fun_args/2, t_fun_range/1, + t_fun_range/2, t_integer/0, t_integers/1, + t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_any_atom/3, + t_is_boolean/2, + t_is_integer/2, t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, + t_is_number/2, t_is_reference/2, t_is_pid/2, t_is_port/2, + t_is_unit/1, t_limit/2, t_list/0, t_maybe_improper_list/0, t_module/0, - t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/1, - t_opaque_match_atom/2, t_opaque_match_record/2, - t_opaque_matching_structure/2, + t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/2, t_pid/0, t_port/0, t_product/1, t_reference/0, - t_sup/1, t_sup/2, t_subtract/2, t_to_string/2, t_to_tlist/1, - t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_subtypes/1, - t_unit/0, t_unopaque/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_subtypes/2, + t_unit/0, t_unopaque/2]). %%-define(DEBUG, true). %%-define(DEBUG_PP, true). @@ -204,7 +210,7 @@ analyze_loop(State) -> traverse(Tree, Map, State) -> ?debug("Handling ~p\n", [cerl:type(Tree)]), - %%debug_pp_map(Map), + %% debug_pp_map(Map), case cerl:type(Tree) of alias -> %% This only happens when checking for illegal record patterns @@ -256,12 +262,7 @@ traverse(Tree, Map, State) -> case cerl:unfold_literal(Tree) of Tree -> Type = literal_type(Tree), - NewType = - case erl_types:t_opaque_match_atom(Type, State#state.opaques) of - [Opaque] -> Opaque; - _ -> Type - end, - {State, Map, NewType}; + {State, Map, Type}; NewTree -> traverse(NewTree, Map, State) end; module -> @@ -286,8 +287,11 @@ traverse(Tree, Map, State) -> SMA; false -> State2 = - case (t_is_any(ArgType) orelse t_is_simple(ArgType) - orelse is_call_to_send(Arg)) of + case + t_is_any(ArgType) + orelse t_is_simple(ArgType, State) + orelse is_call_to_send(Arg) + of true -> % do not warn in these cases State1; false -> @@ -311,15 +315,7 @@ traverse(Tree, Map, State) -> case state__lookup_type_for_letrec(Tree, State) of error -> LType = lookup_type(Tree, Map), - Opaques = State#state.opaques, - case t_opaque_match_record(LType, Opaques) of - [Opaque] -> {State, Map, Opaque}; - _ -> - case t_opaque_match_atom(LType, Opaques) of - [Opaque] -> {State, Map, Opaque}; - _ -> {State, Map, LType} - end - end; + {State, Map, LType}; {ok, Type} -> {State, Map, Type} end; Other -> @@ -367,7 +363,8 @@ handle_apply(Tree, Map, State) -> Tree, Msg), {State3, Map2, t_none()}; false -> - NewArgs = t_inf_lists(ArgTypes, t_fun_args(OpType1)), + NewArgs = t_inf_lists(ArgTypes, + t_fun_args(OpType1, 'universe')), case any_none(NewArgs) of true -> Msg = {fun_app_args, @@ -378,7 +375,7 @@ handle_apply(Tree, Map, State) -> {State3, enter_type(Op, OpType1, Map2), t_none()}; false -> Map3 = enter_type_lists(Args, NewArgs, Map2), - Range0 = t_fun_range(OpType1), + Range0 = t_fun_range(OpType1, 'universe'), Range = case t_is_unit(Range0) of true -> t_none(); @@ -423,83 +420,55 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], {M, F, A} = Fun, case erl_bif_types:is_known(M, F, A) of true -> - IsBIF = true, BArgs = erl_bif_types:arg_types(M, F, A), BRange = fun(FunArgs) -> - ArgPos = erl_bif_types:structure_inspecting_args(M, F, A), - NewFunArgs = - case ArgPos =:= [] of - true -> FunArgs; - false -> % some positions need to be un-opaqued - N = length(FunArgs), - PFs = lists:zip(lists:seq(1, N), FunArgs), - [case ordsets:is_element(P, ArgPos) of - true -> erl_types:t_unopaque(FArg, Opaques); - false -> FArg - end || {P, FArg} <- PFs] - end, - erl_bif_types:type(M, F, A, NewFunArgs) + erl_bif_types:type(M, F, A, FunArgs, Opaques) end, {BArgs, BRange}; - false -> IsBIF = false, GenSig + false -> + GenSig end; - local -> IsBIF = false, GenSig + local -> GenSig end, {SigArgs, SigRange} = - %% if there is hard-coded or contract information with opaque types, - %% the checking for possible type violations needs to take place w.r.t. - %% this information and not w.r.t. the structure-based success typing. - case prefer_opaque_types(CArgs, BifArgs) of - true -> {AnyArgs, t_any()}; % effectively forgets the success typing - false -> - case Sig of - {value, {SR, SA}} -> {SA, SR}; - none -> {AnyArgs, t_any()} - end - end, - ArgModeMask = [case lists:member(Arg, Opaques) of - true -> opaque; - false -> structured - end || Arg <- ArgTypes], - NewArgsSig = t_inf_lists_masked(SigArgs, ArgTypes, ArgModeMask), - NewArgsContract = t_inf_lists_masked(CArgs, ArgTypes, ArgModeMask), - NewArgsBif = t_inf_lists_masked(BifArgs, ArgTypes, ArgModeMask), - NewArgTypes0 = t_inf_lists_masked(NewArgsSig, NewArgsContract, ArgModeMask), - NewArgTypes = t_inf_lists_masked(NewArgTypes0, NewArgsBif, ArgModeMask), - BifRet = BifRange(NewArgTypes), - {TmpArgTypes, TmpArgsContract} = - case (TypeOfApply =:= remote) andalso (not IsBIF) of - true -> - List1 = lists:zip(CArgs, NewArgTypes), - List2 = lists:zip(CArgs, NewArgsContract), - {[erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) - || {T1, T2} <- List1], - [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) - || {T1, T2} <- List2]}; - false -> {NewArgTypes, NewArgsContract} - end, - ContrRet = CRange(TmpArgTypes), - RetMode = - case t_contains_opaque(ContrRet) orelse t_contains_opaque(BifRet) of - true -> opaque; - false -> structured + case Sig of + {value, {SR, SA}} -> {SA, SR}; + none -> {AnyArgs, t_any()} end, - RetWithoutContr = t_inf(SigRange, BifRet, RetMode), - RetWithoutLocal = t_inf(ContrRet, RetWithoutContr, RetMode), + ?debug("--------------------------------------------------------\n", []), - ?debug("Fun: ~p\n", [Fun]), - ?debug("Args: ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]), + ?debug("Fun: ~p\n", [state__lookup_name(Fun, State)]), + ?debug("Module ~p\n", [State#state.module]), + ?debug("CArgs ~s\n", [erl_types:t_to_string(t_product(CArgs))]), + ?debug("ArgTypes ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]), + ?debug("BifArgs ~p\n", [erl_types:t_to_string(t_product(BifArgs))]), + + NewArgsSig = t_inf_lists(SigArgs, ArgTypes, Opaques), + ?debug("SigArgs ~s\n", [erl_types:t_to_string(t_product(SigArgs))]), ?debug("NewArgsSig: ~s\n", [erl_types:t_to_string(t_product(NewArgsSig))]), + NewArgsContract = t_inf_lists(CArgs, ArgTypes, Opaques), ?debug("NewArgsContract: ~s\n", [erl_types:t_to_string(t_product(NewArgsContract))]), + NewArgsBif = t_inf_lists(BifArgs, ArgTypes, Opaques), ?debug("NewArgsBif: ~s\n", [erl_types:t_to_string(t_product(NewArgsBif))]), - ?debug("NewArgTypes: ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]), + NewArgTypes0 = t_inf_lists(NewArgsSig, NewArgsContract), + NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif, Opaques), + ?debug("NewArgTypes ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]), + ?debug("\n", []), + + BifRet = BifRange(NewArgTypes), + ContrRet = CRange(NewArgTypes), + RetWithoutContr = t_inf(SigRange, BifRet), + RetWithoutLocal = t_inf(ContrRet, RetWithoutContr), + ?debug("RetWithoutContr: ~s\n",[erl_types:t_to_string(RetWithoutContr)]), ?debug("RetWithoutLocal: ~s\n", [erl_types:t_to_string(RetWithoutLocal)]), ?debug("BifRet: ~s\n", [erl_types:t_to_string(BifRange(NewArgTypes))]), - ?debug("ContrRet: ~s\n", [erl_types:t_to_string(CRange(TmpArgTypes))]), - ?debug("SigRet: ~s\n", [erl_types:t_to_string(SigRange)]), + ?debug("SigRange: ~s\n", [erl_types:t_to_string(SigRange)]), + ?debug("ContrRet: ~s\n", [erl_types:t_to_string(CRange(NewArgTypes))]), + ?debug("LocalRet: ~s\n", [erl_types:t_to_string(LocalRet)]), + State1 = case is_race_analysis_enabled(State) of true -> @@ -513,6 +482,9 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], FailedConj = any_none([RetWithoutLocal|NewArgTypes]), IsFailBif = t_is_none(BifRange(BifArgs)), IsFailSig = t_is_none(SigRange), + ?debug("FailedConj: ~p~n", [FailedConj]), + ?debug("IsFailBif: ~p~n", [IsFailBif]), + ?debug("IsFailSig: ~p~n", [IsFailSig]), State2 = case FailedConj andalso not (IsFailBif orelse IsFailSig) of true -> @@ -532,14 +504,14 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], false -> FailedSig = any_none(NewArgsSig), FailedContract = - any_none([CRange(TmpArgsContract)|NewArgsContract]), + any_none([CRange(NewArgsContract)|NewArgsContract]), FailedBif = any_none([BifRange(NewArgsBif)|NewArgsBif]), InfSig = t_inf(t_fun(SigArgs, SigRange), - t_fun(BifArgs, BifRange(BifArgs))), + t_fun(BifArgs, BifRange(BifArgs))), FailReason = apply_fail_reason(FailedSig, FailedBif, FailedContract), Msg = get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, InfSig, - Contr, CArgs, State1, FailReason), + Contr, CArgs, State1, FailReason, Opaques), WarnType = case Msg of {call, _} -> ?WARN_FAILING_CALL; {apply, _} -> ?WARN_FAILING_CALL; @@ -547,7 +519,8 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], {call_without_opaque, _} -> ?WARN_OPAQUE; {opaque_type_test, _} -> ?WARN_OPAQUE end, - state__add_warning(State1, WarnType, Tree, Msg) + Frc = {erlang, is_record, 3} =:= state__lookup_name(Fun, State), + state__add_warning(State1, WarnType, Tree, Msg, Frc) end; false -> State1 end, @@ -571,7 +544,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], TotalRet = case t_is_none(LocalRet) andalso t_is_unit(RetWithoutLocal) of true -> RetWithoutLocal; - false -> t_inf(RetWithoutLocal, LocalRet, opaque) + false -> t_inf(RetWithoutLocal, LocalRet) end, NewAccRet = t_sup(AccRet, TotalRet), ?debug("NewAccRet: ~s\n", [t_to_string(NewAccRet)]), @@ -590,7 +563,7 @@ apply_fail_reason(FailedSig, FailedBif, FailedContract) -> end. get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, - Sig, Contract, ContrArgs, State, FailReason) -> + Sig, Contract, ContrArgs, State, FailReason, Opaques) -> ArgStrings = format_args(Args, ArgTypes, State), ContractInfo = case Contract of @@ -599,44 +572,52 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, dialyzer_contracts:contract_to_string(C)}; none -> {false, none} end, - EnumArgTypes = - case NewArgTypes of - [] -> []; - _ -> lists:zip(lists:seq(1, length(NewArgTypes)), NewArgTypes) - end, + EnumArgTypes = lists:zip(lists:seq(1, length(NewArgTypes)), NewArgTypes), ArgNs = [Arg || {Arg, Type} <- EnumArgTypes, t_is_none(Type)], case state__lookup_name(Fun, State) of - {M, F, _A} -> - case is_opaque_type_test_problem(Fun, NewArgTypes, State) of - true -> - [Opaque] = NewArgTypes, - {opaque_type_test, [atom_to_list(F), erl_types:t_to_string(Opaque)]}; - false -> + {M, F, A} -> + case is_opaque_type_test_problem(Fun, Args, NewArgTypes, State) of + {yes, Arg, ArgType} -> + {opaque_type_test, [atom_to_list(F), ArgStrings, + format_arg(Arg), format_type(ArgType, State)]}; + no -> SigArgs = t_fun_args(Sig), - case is_opaque_related_problem(ArgNs, ArgTypes) of - true -> %% an opaque term is used where a structured term is expected - ExpectedArgs = - case FailReason of - only_sig -> SigArgs; - _ -> ContrArgs - end, - {call_with_opaque, [M, F, ArgStrings, ArgNs, ExpectedArgs]}; - false -> - case is_opaque_related_problem(ArgNs, SigArgs) orelse - is_opaque_related_problem(ArgNs, ContrArgs) of - true -> %% a structured term is used where an opaque is expected - ExpectedTriples = - case FailReason of - only_sig -> expected_arg_triples(ArgNs, SigArgs, State); - _ -> expected_arg_triples(ArgNs, ContrArgs, State) - end, - {call_without_opaque, [M, F, ArgStrings, ExpectedTriples]}; - false -> %% there is a structured term clash in some argument - {call, [M, F, ArgStrings, - ArgNs, FailReason, - format_sig_args(Sig, State), - format_type(t_fun_range(Sig), State), - ContractInfo]} + BadOpaque = + opaque_problems([SigArgs, ContrArgs], ArgTypes, Opaques, ArgNs), + %% In fact *both* 'call_with_opaque' and + %% 'call_without_opaque' are possible. + case lists:keyfind(decl, 1, BadOpaque) of + {decl, BadArgs} -> + %% a structured term is used where an opaque is expected + ExpectedTriples = + case FailReason of + only_sig -> expected_arg_triples(BadArgs, SigArgs, State); + _ -> expected_arg_triples(BadArgs, ContrArgs, State) + end, + {call_without_opaque, [M, F, ArgStrings, ExpectedTriples]}; + false -> + case lists:keyfind(use, 1, BadOpaque) of + {use, BadArgs} -> + %% an opaque term is used where a structured term is expected + ExpectedArgs = + case FailReason of + only_sig -> SigArgs; + _ -> ContrArgs + end, + {call_with_opaque, [M, F, ArgStrings, BadArgs, ExpectedArgs]}; + false -> + case + erl_bif_types:opaque_args(M, F, A, ArgTypes, Opaques) + of + [] -> %% there is a structured term clash in some argument + {call, [M, F, ArgStrings, + ArgNs, FailReason, + format_sig_args(Sig, State), + format_type(t_fun_range(Sig), State), + ContractInfo]}; + Ns -> + {call_with_opaque, [M, F, ArgStrings, Ns, ContrArgs]} + end end end end; @@ -648,20 +629,28 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, ContractInfo]} end. -%% returns 'true' if we are running with opaque on (not checked yet), -%% and there is either a contract or hard-coded type information with -%% opaque types -%% TODO: check that we are running with opaque types -%% TODO: check the return type also -prefer_opaque_types(CArgs, BifArgs) -> - t_contains_opaque(t_product(CArgs)) - orelse t_contains_opaque(t_product(BifArgs)). - -is_opaque_related_problem(ArgNs, ArgTypes) -> - Fun = fun (N) -> erl_types:t_contains_opaque(lists:nth(N, ArgTypes)) end, - ArgNs =/= [] andalso lists:all(Fun, ArgNs). - -is_opaque_type_test_problem(Fun, ArgTypes, State) -> +%% -> [{ElementI, [ArgN]}] where [ArgN] is a non-empty list of +%% arguments containing unknown opaque types and Element is 1 or 2. +opaque_problems(ContractOrSigList, ArgTypes, Opaques, ArgNs) -> + ArgElementList = find_unknown(ContractOrSigList, ArgTypes, Opaques, ArgNs), + F = fun(1) -> decl; (2) -> use end, + [{F(ElementI), lists:usort([ArgN || {ArgN, EI} <- ArgElementList, + EI =:= ElementI])} || + ElementI <- lists:usort([EI || {_, EI} <- ArgElementList])]. + +%% -> [{ArgN, ElementI}] where ElementI = 1 means there is an unknown +%% opaque type in argument ArgN of the the contract/signature, +%% and ElementI = 2 means that there is an unknown opaque type in +%% argument ArgN of the the (current) argument types. +find_unknown(ContractOrSigList, ArgTypes, Opaques, NoneArgNs) -> + ArgNs = lists:seq(1, length(ArgTypes)), + [{ArgN, ElementI} || + ContractOrSig <- ContractOrSigList, + {E1, E2, ArgN} <- lists:zip3(ContractOrSig, ArgTypes, ArgNs), + lists:member(ArgN, NoneArgNs), + ElementI <- erl_types:t_find_unknown_opaque(E1, E2, Opaques)]. + +is_opaque_type_test_problem(Fun, Args, ArgTypes, State) -> case Fun of {erlang, FN, 1} when FN =:= is_atom; FN =:= is_boolean; FN =:= is_binary; FN =:= is_bitstring; @@ -669,10 +658,18 @@ is_opaque_type_test_problem(Fun, ArgTypes, State) -> FN =:= is_integer; FN =:= is_list; FN =:= is_number; FN =:= is_pid; FN =:= is_port; FN =:= is_reference; FN =:= is_tuple -> - [Type] = ArgTypes, - erl_types:t_is_opaque(Type) andalso - not lists:member(Type, State#state.opaques); - _ -> false + type_test_opaque_arg(Args, ArgTypes, State#state.opaques); + {erlang, FN, 2} when FN =:= is_function -> + type_test_opaque_arg(Args, ArgTypes, State#state.opaques); + _ -> no + end. + +type_test_opaque_arg([], [], _Opaques) -> + no; +type_test_opaque_arg([Arg|Args], [ArgType|ArgTypes], Opaques) -> + case erl_types:t_has_opaque_subtype(ArgType, Opaques) of + true -> {yes, Arg, ArgType}; + false -> type_test_opaque_arg(Args, ArgTypes, Opaques) end. expected_arg_triples(ArgNs, ArgTypes, State) -> @@ -683,47 +680,56 @@ expected_arg_triples(ArgNs, ArgTypes, State) -> add_bif_warnings({erlang, Op, 2}, [T1, T2] = Ts, Tree, State) when Op =:= '=:='; Op =:= '==' -> - Type1 = erl_types:t_unopaque(T1, State#state.opaques), - Type2 = erl_types:t_unopaque(T2, State#state.opaques), - Inf = t_inf(T1, T2), - Inf1 = t_inf(Type1, Type2), - case t_is_none(Inf) andalso t_is_none(Inf1) andalso(not any_none(Ts)) - andalso (not is_int_float_eq_comp(T1, Op, T2)) of + Opaques = State#state.opaques, + Inf = t_inf(T1, T2, Opaques), + case + t_is_none(Inf) andalso (not any_none(Ts)) + andalso (not is_int_float_eq_comp(T1, Op, T2, Opaques)) + of true -> - Args = case erl_types:t_is_opaque(T1) of - true -> [format_type(T2, State), Op, format_type(T1, State)]; - false -> [format_type(T1, State), Op, format_type(T2, State)] - end, - case any_opaque(Ts) of - true -> - state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_eq, Args}); - false -> - state__add_warning(State, ?WARN_MATCHING, Tree, {exact_eq, Args}) + %% Give priority to opaque warning (as usual). + case erl_types:t_find_unknown_opaque(T1, T2, Opaques) of + [] -> + Args = comp_format_args([], T1, Op, T2, State), + state__add_warning(State, ?WARN_MATCHING, Tree, {exact_eq, Args}); + Ns -> + Args = comp_format_args(Ns, T1, Op, T2, State), + state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_eq, Args}) end; false -> State end; add_bif_warnings({erlang, Op, 2}, [T1, T2] = Ts, Tree, State) when Op =:= '=/='; Op =:= '/=' -> - Inf = t_inf(T1, T2), - case t_is_none(Inf) andalso (not any_none(Ts)) - andalso (not is_int_float_eq_comp(T1, Op, T2)) andalso any_opaque(Ts) of + Opaques = State#state.opaques, + case + (not any_none(Ts)) + andalso (not is_int_float_eq_comp(T1, Op, T2, Opaques)) + of true -> - Args = case erl_types:t_is_opaque(T1) of - true -> [format_type(T2, State), Op, format_type(T1, State)]; - false -> [format_type(T1, State), Op, format_type(T2, State)] - end, - state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_neq, Args}); + case erl_types:t_find_unknown_opaque(T1, T2, Opaques) of + [] -> State; + Ns -> + Args = comp_format_args(Ns, T1, Op, T2, State), + state__add_warning(State, ?WARN_OPAQUE, Tree, {opaque_neq, Args}) + end; false -> State end; add_bif_warnings(_, _, _, State) -> State. -is_int_float_eq_comp(T1, Op, T2) -> +is_int_float_eq_comp(T1, Op, T2, Opaques) -> (Op =:= '==' orelse Op =:= '/=') andalso - ((erl_types:t_is_float(T1) andalso erl_types:t_is_integer(T2)) orelse - (erl_types:t_is_integer(T1) andalso erl_types:t_is_float(T2))). + ((erl_types:t_is_float(T1, Opaques) + andalso t_is_integer(T2, Opaques)) orelse + (t_is_integer(T1, Opaques) + andalso erl_types:t_is_float(T2, Opaques))). + +comp_format_args([1|_], T1, Op, T2, State) -> + [format_type(T2, State), Op, format_type(T1, State)]; +comp_format_args(_, T1, Op, T2, State) -> + [format_type(T1, State), Op, format_type(T2, State)]. %%---------------------------------------- @@ -784,16 +790,27 @@ handle_bitstr(Tree, Map, State) -> {State3, Map2, t_none()}; false -> UnitVal = cerl:concrete(cerl:bitstr_unit(Tree)), - Type = - case t_number_vals(SizeType) of - [OneSize] -> t_bitstr(0, OneSize * UnitVal); - _ -> - MinSize = erl_types:number_min(SizeType), - t_bitstr(UnitVal, UnitVal * MinSize) - end, + Opaques = State2#state.opaques, + NumberVals = t_number_vals(SizeType, Opaques), + {State3, Type} = + case t_contains_opaque(SizeType, Opaques) of + true -> + Msg = {opaque_size, [format_type(SizeType, State2), + format_cerl(Size)]}, + {state__add_warning(State2, ?WARN_OPAQUE, Size, Msg), + t_none()}; + false -> + case NumberVals of + [OneSize] -> {State2, t_bitstr(0, OneSize * UnitVal)}; + unknown -> {State2, t_bitstr()}; + _ -> + MinSize = erl_types:number_min(SizeType, Opaques), + {State2, t_bitstr(UnitVal, UnitVal * MinSize)} + end + end, Map3 = enter_type_lists([Val, Size, Tree], [ValType, SizeType, Type], Map2), - {State2, Map3, Type} + {State3, Map3, Type} end end. @@ -805,34 +822,47 @@ handle_call(Tree, Map, State) -> Args = cerl:call_args(Tree), MFAList = [M, F|Args], {State1, Map1, [MType0, FType0|As]} = traverse_list(MFAList, Map, State), - %% Module and function names should be treated as *structured terms* - %% even if they happen to be identical to an atom (or tuple) which - %% is also involved in the definition of an opaque data type. - MType = t_inf(t_module(), t_unopaque(MType0)), - FType = t_inf(t_atom(), t_unopaque(FType0)), + Opaques = State#state.opaques, + MType = t_inf(t_module(), MType0, Opaques), + FType = t_inf(t_atom(), FType0, Opaques), Map2 = enter_type_lists([M, F], [MType, FType], Map1), + MOpaque = t_is_none(MType) andalso (not t_is_none(MType0)), + FOpaque = t_is_none(FType) andalso (not t_is_none(FType0)), case any_none([MType, FType|As]) of true -> State2 = - case t_is_none(MType) andalso (not t_is_none(MType0)) of - true -> % This is a problem we just detected; not a known one - MS = format_cerl(M), - Msg = {app_call, [MS, format_cerl(F), - format_args(Args, As, State1), - MS, format_type(t_module(), State1), - format_type(MType0, State1)]}, - state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg); - false -> - case t_is_none(FType) andalso (not t_is_none(FType0)) of - true -> - FS = format_cerl(F), - Msg = {app_call, [format_cerl(M), FS, - format_args(Args, As, State1), - FS, format_type(t_atom(), State1), - format_type(FType0, State1)]}, - state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg); - false -> State1 - end + if + MOpaque -> % This is a problem we just detected; not a known one + MS = format_cerl(M), + case t_is_none(t_inf(t_module(), MType0)) of + true -> + Msg = {app_call, [MS, format_cerl(F), + format_args(Args, As, State1), + MS, format_type(t_module(), State1), + format_type(MType0, State1)]}, + state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg); + false -> + Msg = {opaque_call, [MS, format_cerl(F), + format_args(Args, As, State1), + MS, format_type(MType0, State1)]}, + state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg) + end; + FOpaque -> + FS = format_cerl(F), + case t_is_none(t_inf(t_atom(), FType0)) of + true -> + Msg = {app_call, [format_cerl(M), FS, + format_args(Args, As, State1), + FS, format_type(t_atom(), State1), + format_type(FType0, State1)]}, + state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg); + false -> + Msg = {opaque_call, [format_cerl(M), FS, + format_args(Args, As, State1), + FS, format_type(FType0, State1)]}, + state__add_warning(State1, ?WARN_FAILING_CALL, Tree, Msg) + end; + true -> State1 end, {State2, Map2, t_none()}; false -> @@ -874,7 +904,7 @@ handle_case(Tree, Map, State) -> handle_clauses(Clauses, Arg, ArgType, ArgType, State2, [], Map2, [], []), Map3 = join_maps_end(MapList, Map2), - debug_pp_map(Map2), + debug_pp_map(Map3), {State3, Map3, Type} end. @@ -886,7 +916,7 @@ handle_cons(Tree, Map, State) -> {State1, Map1, HdType} = traverse(Hd, Map, State), {State2, Map2, TlType} = traverse(Tl, Map1, State1), State3 = - case t_is_none(t_inf(TlType, t_list())) of + case t_is_none(t_inf(TlType, t_list(), State2#state.opaques)) of true -> Msg = {improper_list_constr, [format_type(TlType, State2)]}, state__add_warning(State2, ?WARN_NON_PROPER_LIST, Tree, Msg); @@ -979,8 +1009,9 @@ handle_receive(Tree, Map, State) -> [], []), Map1 = join_maps(MapList, Map), {State3, Map2, TimeoutType} = traverse(Timeout, Map1, State2), - case (t_is_atom(TimeoutType) andalso - (t_atom_vals(TimeoutType) =:= ['infinity'])) of + Opaques = State3#state.opaques, + case (t_is_atom(TimeoutType, Opaques) andalso + (t_atom_vals(TimeoutType, Opaques) =:= ['infinity'])) of true -> {State3, Map2, ReceiveType}; false -> @@ -1031,55 +1062,46 @@ handle_tuple(Tree, Map, State) -> true -> {State1, Map1, t_none()}; false -> - %% Let's find out if this is a record or opaque construction. + %% Let's find out if this is a record case Elements of [Tag|Left] -> case cerl:is_c_atom(Tag) of true -> TagVal = cerl:atom_val(Tag), - case t_opaque_match_record(TupleType, State1#state.opaques) of - [Opaque] -> - RecStruct = t_opaque_matching_structure(TupleType, Opaque), - RecFields = t_tuple_args(RecStruct), - case bind_pat_vars(Elements, RecFields, [], Map1, State1) of - {error, _, ErrorPat, ErrorType, _} -> - Msg = {record_constr, - [TagVal, format_patterns(ErrorPat), - format_type(ErrorType, State1)]}, - State2 = state__add_warning(State1, ?WARN_MATCHING, - Tree, Msg), - {State2, Map1, t_none()}; - {Map2, _ETypes} -> - {State1, Map2, Opaque} - end; - _ -> - case state__lookup_record(TagVal, length(Left), State1) of - error -> {State1, Map1, TupleType}; - {ok, RecType} -> - InfTupleType = t_inf(RecType, TupleType), - case t_is_none(InfTupleType) of - true -> - RecC = format_type(TupleType, State1), - FieldDiffs = format_field_diffs(TupleType, State1), - Msg = {record_constr, [RecC, FieldDiffs]}, - State2 = state__add_warning(State1, ?WARN_MATCHING, - Tree, Msg), - {State2, Map1, t_none()}; - false -> - case bind_pat_vars(Elements, t_tuple_args(RecType), - [], Map1, State1) of - {error, bind, ErrorPat, ErrorType, _} -> - Msg = {record_constr, - [TagVal, format_patterns(ErrorPat), - format_type(ErrorType, State1)]}, - State2 = state__add_warning(State1, ?WARN_MATCHING, - Tree, Msg), - {State2, Map1, t_none()}; - {Map2, ETypes} -> - {State1, Map2, t_tuple(ETypes)} - end - end - end + case state__lookup_record(TagVal, length(Left), State1) of + error -> {State1, Map1, TupleType}; + {ok, RecType} -> + InfTupleType = t_inf(RecType, TupleType), + case t_is_none(InfTupleType) of + true -> + RecC = format_type(TupleType, State1), + FieldDiffs = format_field_diffs(TupleType, State1), + Msg = {record_constr, [RecC, FieldDiffs]}, + State2 = state__add_warning(State1, ?WARN_MATCHING, + Tree, Msg), + {State2, Map1, t_none()}; + false -> + case bind_pat_vars(Elements, t_tuple_args(RecType), + [], Map1, State1) of + {error, bind, ErrorPat, ErrorType, _} -> + Msg = {record_constr, + [TagVal, format_patterns(ErrorPat), + format_type(ErrorType, State1)]}, + State2 = state__add_warning(State1, ?WARN_MATCHING, + Tree, Msg), + {State2, Map1, t_none()}; + {error, opaque, ErrorPat, ErrorType, OpaqueType} -> + Msg = {opaque_match, + [format_patterns(ErrorPat), + format_type(ErrorType, State1), + format_type(OpaqueType, State1)]}, + State2 = state__add_warning(State1, ?WARN_OPAQUE, + Tree, Msg), + {State2, Map1, t_none()}; + {Map2, ETypes} -> + {State1, Map2, t_tuple(ETypes)} + end + end end; false -> {State1, Map1, t_tuple(EsType)} @@ -1356,7 +1378,9 @@ bind_pat_vars_reverse(Pats, Types, Acc, Map, State) -> end. bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> - ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)]), + ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)] +), + Opaques = State#state.opaques, {NewMap, TypeOut} = case cerl:type(Pat) of alias -> @@ -1372,9 +1396,15 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> case Rev of true -> {Map, t_bitstr()}; false -> - BinType = t_inf(t_bitstr(), Type), + BinType = t_inf(t_bitstr(), Type, Opaques), case t_is_none(BinType) of - true -> bind_error([Pat], Type, t_none(), bind); + true -> + case t_find_opaque_mismatch(t_bitstr(), Type) of + {ok, T1, T2} -> + bind_error([Pat], T1, T2, opaque); + error -> + bind_error([Pat], Type, t_none(), bind) + end; false -> Segs = cerl:binary_segments(Pat), {Map1, SegTypes} = bind_bin_segs(Segs, BinType, Map, State), @@ -1382,28 +1412,24 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> end end; cons -> - Cons = t_inf(Type, t_cons()), + Cons = t_inf(Type, t_cons(), Opaques), case t_is_none(Cons) of true -> bind_opaque_pats(t_cons(), Type, Pat, Map, State, Rev); false -> {Map1, [HdType, TlType]} = bind_pat_vars([cerl:cons_hd(Pat), cerl:cons_tl(Pat)], - [t_cons_hd(Cons), t_cons_tl(Cons)], + [t_cons_hd(Cons, Opaques), + t_cons_tl(Cons, Opaques)], [], Map, State, Rev), {Map1, t_cons(HdType, TlType)} end; literal -> Literal = literal_type(Pat), - LiteralOrOpaque = - case t_opaque_match_atom(Literal, State#state.opaques) of - [Opaque] -> Opaque; - _ -> Literal - end, - case t_is_none(t_inf(LiteralOrOpaque, Type)) of + case t_is_none(t_inf(Literal, Type, Opaques)) of true -> bind_opaque_pats(Literal, Type, Pat, Map, State, Rev); - false -> {Map, LiteralOrOpaque} + false -> {Map, Literal} end; tuple -> Es = cerl:tuple_es(Pat), @@ -1419,27 +1445,28 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> {ok, Record} -> [_Head|AnyTail] = [t_any() || _ <- Es], UntypedRecord = t_tuple([t_atom(TagAtom)|AnyTail]), - {not erl_types:t_is_equal(Record, UntypedRecord), Record} + {not t_is_equal(Record, UntypedRecord), Record} end; false -> {false, t_tuple(length(Es))} end end, - Tuple = t_inf(Prototype, Type), + Tuple = t_inf(Prototype, Type, Opaques), case t_is_none(Tuple) of true -> bind_opaque_pats(Prototype, Type, Pat, Map, State, Rev); false -> - SubTuples = t_tuple_subtypes(Tuple), + SubTuples = t_tuple_subtypes(Tuple, Opaques), %% Need to call the top function to get the try-catch wrapper MapJ = join_maps_begin(Map), Results = case Rev of true -> - [bind_pat_vars_reverse(Es, t_tuple_args(SubTuple), [], - MapJ, State) + [bind_pat_vars_reverse(Es, t_tuple_args(SubTuple, Opaques), + [], MapJ, State) || SubTuple <- SubTuples]; false -> - [bind_pat_vars(Es, t_tuple_args(SubTuple), [], MapJ, State) + [bind_pat_vars(Es, t_tuple_args(SubTuple, Opaques), [], + MapJ, State) || SubTuple <- SubTuples] end, case lists:keyfind(opaque, 2, Results) of @@ -1466,37 +1493,14 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> bind_pat_vars(Es, t_to_tlist(Type), [], Map, State, Rev), {Map1, t_product(EsTypes)}; var -> - Opaques = State#state.opaques, VarType1 = case state__lookup_type_for_letrec(Pat, State) of - error -> - LType = lookup_type(Pat, Map), - case t_opaque_match_record(LType, Opaques) of - [Opaque] -> Opaque; - _ -> - case t_opaque_match_atom(LType, Opaques) of - [Opaque] -> Opaque; - _ -> LType - end - end; + error -> lookup_type(Pat, Map); {ok, RecType} -> RecType end, %% Must do inf when binding args to pats. Vars in pats are fresh. - VarType2 = t_inf(VarType1, Type), - VarType3 = - case Opaques =/= [] of - true -> - case t_opaque_match_record(VarType2, Opaques) of - [OpaqueRec] -> OpaqueRec; - _ -> - case t_opaque_match_atom(VarType2, Opaques) of - [OpaqueAtom] -> OpaqueAtom; - _ -> VarType2 - end - end; - false -> VarType2 - end, - case t_is_none(VarType3) of + VarType2 = t_inf(VarType1, Type, Opaques), + case t_is_none(VarType2) of true -> case t_find_opaque_mismatch(VarType1, Type) of {ok, T1, T2} -> @@ -1505,8 +1509,8 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> bind_error([Pat], Type, t_none(), bind) end; false -> - Map1 = enter_type(Pat, VarType3, Map), - {Map1, VarType3} + Map1 = enter_type(Pat, VarType2, Map), + {Map1, VarType2} end; _Other -> %% Catch all is needed when binding args to pats @@ -1529,7 +1533,8 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> binary = SegType, [] = Segs, %% just an assert T = t_inf(t_bitstr(UnitVal, 0), BinType), {Map1, [Type]} = bind_pat_vars([Val], [T], [], Map, State, false), - bind_bin_segs(Segs, t_bitstr(0, 0), [Type|Acc], Map1, State); + Type1 = remove_local_opaque_types(Type, State#state.opaques), + bind_bin_segs(Segs, t_bitstr(0, 0), [Type1|Acc], Map1, State); utf -> % XXX: possibly can be strengthened true = lists:member(SegType, [utf8, utf16, utf32]), {Map1, [_]} = bind_pat_vars([Val], [t_integer()], [], Map, State, false), @@ -1539,11 +1544,17 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> Size = cerl:bitstr_size(Seg), {Map1, [SizeType]} = bind_pat_vars([Size], [t_non_neg_integer()], [], Map, State, false), + Opaques = State#state.opaques, + NumberVals = t_number_vals(SizeType, Opaques), + case t_contains_opaque(SizeType, Opaques) of + true -> bind_error([Seg], SizeType, t_none(), opaque); + false -> ok + end, Type = - case t_number_vals(SizeType) of + case NumberVals of [OneSize] -> t_bitstr(0, UnitVal * OneSize); - _ -> - MinSize = erl_types:number_min(SizeType), + _ -> % 'unknown' too + MinSize = erl_types:number_min(SizeType, Opaques), t_bitstr(UnitVal, UnitVal * MinSize) end, ValConstr = @@ -1551,7 +1562,7 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> binary -> Type; %% The same constraints as for the whole bitstr float -> t_float(); integer -> - case t_number_vals(SizeType) of + case NumberVals of unknown -> t_integer(); List -> SizeVal = lists:max(List), @@ -1579,7 +1590,7 @@ bind_error(Pats, Type, OpaqueType, Error) -> bind_opaque_pats(GenType, Type, Pat, Map, State, Rev) -> case t_find_opaque_mismatch(GenType, Type) of {ok, T1, T2} -> - case lists:member(T2, State#state.opaques) of + case erl_types:is_opaque_type(T2, State#state.opaques) of true -> NewType = erl_types:t_struct_from_opaque(Type, [T2]), {Map1, _} = @@ -1700,19 +1711,9 @@ handle_guard_call(Guard, Map, Env, Eval, State) -> handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State) -> Args = cerl:call_args(Guard), - {Map1, As0} = bind_guard_list(Args, Map, Env, dont_know, State), - MapFun = fun(Type) -> - case lists:member(Type, State#state.opaques) of - true -> erl_types:t_opaque_structure(Type); - false -> Type - end - end, - As = lists:map(MapFun, As0), - Mode = case As =:= As0 of - true -> structured; - false -> opaque - end, - BifRet = erl_bif_types:type(M, F, A, As), + {Map1, As} = bind_guard_list(Args, Map, Env, dont_know, State), + Opaques = State#state.opaques, + BifRet = erl_bif_types:type(M, F, A, As, Opaques), case t_is_none(BifRet) of true -> %% Is this an error-bif? @@ -1721,11 +1722,8 @@ handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State) -> false -> signal_guard_fatal_fail(Eval, Guard, As, State) end; false -> - BifArgs = case erl_bif_types:arg_types(M, F, A) of - unknown -> lists:duplicate(A, t_any()); - List -> List - end, - Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As0, Mode), Map1), + BifArgs = bif_args(M, F, A), + Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As, Opaques), Map1), Ret = case Eval of pos -> t_inf(t_atom(true), BifRet); @@ -1771,29 +1769,19 @@ bind_type_test(Eval, TypeTest, ArgType, State) -> is_reference -> t_reference(); is_tuple -> t_tuple() end, - Mode = determine_mode(ArgType, State#state.opaques), case Eval of pos -> - Inf = t_inf(Type, ArgType, Mode), + Inf = t_inf(Type, ArgType, State#state.opaques), case t_is_none(Inf) of true -> error; false -> {ok, Inf, t_atom(true)} end; neg -> - case Mode of - opaque -> - Struct = erl_types:t_opaque_structure(ArgType), - case t_is_none(t_subtract(Struct, Type)) of - true -> error; - false -> {ok, ArgType, t_atom(false)} - end; - structured -> - Sub = t_subtract(ArgType, Type), - case t_is_none(Sub) of - true -> error; - false -> {ok, Sub, t_atom(false)} - end - end; + Sub = t_subtract(ArgType, Type), + case t_is_none(Sub) of + true -> error; + false -> {ok, Sub, t_atom(false)} + end; dont_know -> {ok, ArgType, t_boolean()} end. @@ -1802,9 +1790,10 @@ handle_guard_comp(Guard, Comp, Map, Env, Eval, State) -> Args = cerl:call_args(Guard), [Arg1, Arg2] = Args, {Map1, ArgTypes} = bind_guard_list(Args, Map, Env, dont_know, State), + Opaques = State#state.opaques, [Type1, Type2] = ArgTypes, - IsInt1 = t_is_integer(Type1), - IsInt2 = t_is_integer(Type2), + IsInt1 = t_is_integer(Type1, Opaques), + IsInt2 = t_is_integer(Type2, Opaques), case {cerl:type(Arg1), cerl:type(Arg2)} of {literal, literal} -> case erlang:Comp(cerl:concrete(Arg1), cerl:concrete(Arg2)) of @@ -1817,12 +1806,13 @@ handle_guard_comp(Guard, Comp, Map, Env, Eval, State) -> false when Eval =:= neg -> {Map, t_atom(false)} end; {literal, var} when IsInt1 andalso IsInt2 andalso (Eval =:= pos) -> - case bind_comp_literal_var(Arg1, Arg2, Type2, Comp, Map1) of + case bind_comp_literal_var(Arg1, Arg2, Type2, Comp, Map1, Opaques) of error -> signal_guard_fail(Eval, Guard, ArgTypes, State); {ok, NewMap} -> {NewMap, t_atom(true)} end; {var, literal} when IsInt1 andalso IsInt2 andalso (Eval =:= pos) -> - case bind_comp_literal_var(Arg2, Arg1, Type1, invert_comp(Comp), Map1) of + case bind_comp_literal_var(Arg2, Arg1, Type1, invert_comp(Comp), + Map1, Opaques) of error -> signal_guard_fail(Eval, Guard, ArgTypes, State); {ok, NewMap} -> {NewMap, t_atom(true)} end; @@ -1835,10 +1825,10 @@ invert_comp('<') -> '>'; invert_comp('>=') -> '=<'; invert_comp('>') -> '<'. -bind_comp_literal_var(Lit, Var, VarType, CompOp, Map) -> +bind_comp_literal_var(Lit, Var, VarType, CompOp, Map, Opaques) -> LitVal = cerl:concrete(Lit), NewVarType = - case t_number_vals(VarType) of + case t_number_vals(VarType, Opaques) of unknown -> Range = case CompOp of @@ -1847,7 +1837,7 @@ bind_comp_literal_var(Lit, Var, VarType, CompOp, Map) -> '>=' -> t_from_range(neg_inf, LitVal); '>' -> t_from_range(neg_inf, LitVal - 1) end, - t_inf(Range, VarType); + t_inf(Range, VarType, Opaques); NumberVals -> NewNumberVals = [X || X <- NumberVals, erlang:CompOp(LitVal, X)], t_integers(NewNumberVals) @@ -1861,17 +1851,18 @@ handle_guard_is_function(Guard, Map, Env, Eval, State) -> Args = cerl:call_args(Guard), {Map1, ArgTypes0} = bind_guard_list(Args, Map, Env, dont_know, State), [FunType0, ArityType0] = ArgTypes0, - ArityType = t_inf(ArityType0, t_integer()), + Opaques = State#state.opaques, + ArityType = t_inf(ArityType0, t_integer(), Opaques), case t_is_none(ArityType) of true -> signal_guard_fail(Eval, Guard, ArgTypes0, State); false -> FunTypeConstr = - case t_number_vals(ArityType) of + case t_number_vals(ArityType, State#state.opaques) of unknown -> t_fun(); Vals -> t_sup([t_fun(lists:duplicate(X, t_any()), t_any()) || X <- Vals]) end, - FunType = t_inf(FunType0, FunTypeConstr), + FunType = t_inf(FunType0, FunTypeConstr, Opaques), case t_is_none(FunType) of true -> case Eval of @@ -1896,33 +1887,45 @@ handle_guard_is_record(Guard, Map, Env, Eval, State) -> Arity = cerl:int_val(Arity0), {Map1, RecType} = bind_guard(Rec, Map, Env, dont_know, State), ArityMin1 = Arity - 1, - TupleType = - case state__lookup_record(Tag, ArityMin1, State) of - error -> t_tuple([t_atom(Tag)|lists:duplicate(ArityMin1, t_any())]); - {ok, Prototype} -> Prototype - end, - Mode = determine_mode(RecType, State#state.opaques), - NewTupleType = - case t_opaque_match_record(TupleType, State#state.opaques) of - [Opaque] -> Opaque; - _ -> TupleType - end, - Type = t_inf(NewTupleType, RecType, Mode), - case t_is_none(Type) of + Opaques = State#state.opaques, + Tuple = t_tuple([t_atom(Tag)|lists:duplicate(ArityMin1, t_any())]), + case t_is_none(t_inf(Tuple, RecType, Opaques)) of true -> - case Eval of - pos -> signal_guard_fail(Eval, Guard, - [RecType, t_from_term(Tag), - t_from_term(Arity)], - State); - neg -> {Map1, t_atom(false)}; - dont_know -> {Map1, t_atom(false)} + case erl_types:t_has_opaque_subtype(RecType, Opaques) of + true -> + signal_guard_fail(Eval, Guard, + [RecType, t_from_term(Tag), + t_from_term(Arity)], + State); + false -> + case Eval of + pos -> signal_guard_fail(Eval, Guard, + [RecType, t_from_term(Tag), + t_from_term(Arity)], + State); + neg -> {Map1, t_atom(false)}; + dont_know -> {Map1, t_atom(false)} + end end; false -> - case Eval of - pos -> {enter_type(Rec, Type, Map1), t_atom(true)}; - neg -> {Map1, t_atom(false)}; - dont_know -> {Map1, t_boolean()} + TupleType = + case state__lookup_record(Tag, ArityMin1, State) of + error -> Tuple; + {ok, Prototype} -> Prototype + end, + Type = t_inf(TupleType, RecType, State#state.opaques), + case t_is_none(Type) of + true -> + %% No special handling of opaque errors. + FArgs = "record " ++ format_type(RecType, State), + Msg = {record_matching, [FArgs, Tag]}, + throw({fail, {Guard, Msg}}); + false -> + case Eval of + pos -> {enter_type(Rec, Type, Map1), t_atom(true)}; + neg -> {Map1, t_atom(false)}; + dont_know -> {Map1, t_boolean()} + end end end. @@ -1975,14 +1978,24 @@ handle_guard_eq(Guard, Map, Env, Eval, State) -> bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) -> {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State), {Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State), - case (t_is_nil(Type1) orelse t_is_nil(Type2) orelse - t_is_atom(Type1) orelse t_is_atom(Type2)) of + Opaques = State#state.opaques, + case + t_is_nil(Type1, Opaques) orelse t_is_nil(Type2, Opaques) + orelse t_is_atom(Type1, Opaques) orelse t_is_atom(Type2, Opaques) + of true -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State); false -> - case Eval of - pos -> {Map2, t_atom(true)}; - neg -> {Map2, t_atom(false)}; - dont_know -> {Map2, t_boolean()} + %% XXX. Is this test OK? + OpArgs = erl_types:t_find_unknown_opaque(Type1, Type2, Opaques), + case OpArgs =:= [] of + true -> + case Eval of + pos -> {Map2, t_atom(true)}; + neg -> {Map2, t_atom(false)}; + dont_know -> {Map2, t_boolean()} + end; + false -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State) end end. @@ -2021,44 +2034,52 @@ bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) -> {Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State), ?debug("Types are:~s =:= ~s\n", [t_to_string(Type1), t_to_string(Type2)]), - Inf = t_inf(Type1, Type2), + Opaques = State#state.opaques, + Inf = t_inf(Type1, Type2, Opaques), case t_is_none(Inf) of true -> - case Eval of - neg -> {Map2, t_atom(false)}; - dont_know -> {Map2, t_atom(false)}; - pos -> signal_guard_fail(Eval, Guard, [Type1, Type2], State) + OpArgs = erl_types:t_find_unknown_opaque(Type1, Type2, Opaques), + case OpArgs =:= [] of + true -> + case Eval of + neg -> {Map2, t_atom(false)}; + dont_know -> {Map2, t_atom(false)}; + pos -> signal_guard_fail(Eval, Guard, [Type1, Type2], State) + end; + false -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State) end; false -> case Eval of - pos -> - case {cerl:type(Arg1), cerl:type(Arg2)} of - {var, var} -> - Map3 = enter_subst(Arg1, Arg2, Map2), - Map4 = enter_type(Arg2, Inf, Map3), - {Map4, t_atom(true)}; - {var, _} -> - Map3 = enter_type(Arg1, Inf, Map2), - {Map3, t_atom(true)}; - {_, var} -> - Map3 = enter_type(Arg2, Inf, Map2), - {Map3, t_atom(true)}; - {_, _} -> - {Map2, t_atom(true)} - end; - neg -> - {Map2, t_atom(false)}; - dont_know -> - {Map2, t_boolean()} + pos -> + case {cerl:type(Arg1), cerl:type(Arg2)} of + {var, var} -> + Map3 = enter_subst(Arg1, Arg2, Map2), + Map4 = enter_type(Arg2, Inf, Map3), + {Map4, t_atom(true)}; + {var, _} -> + Map3 = enter_type(Arg1, Inf, Map2), + {Map3, t_atom(true)}; + {_, var} -> + Map3 = enter_type(Arg2, Inf, Map2), + {Map3, t_atom(true)}; + {_, _} -> + {Map2, t_atom(true)} + end; + neg -> + {Map2, t_atom(false)}; + dont_know -> + {Map2, t_boolean()} end end. bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) -> Eval = dont_know, + Opaques = State#state.opaques, case cerl:concrete(Arg1) of true -> {_, Type} = MT = bind_guard(Arg2, Map, Env, pos, State), - case t_is_atom(true, Type) of + case t_is_any_atom(true, Type, Opaques) of true -> MT; false -> {_, Type0} = bind_guard(Arg2, Map, Env, Eval, State), @@ -2066,7 +2087,7 @@ bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) -> end; false -> {Map1, Type} = bind_guard(Arg2, Map, Env, neg, State), - case t_is_atom(false, Type) of + case t_is_any_atom(false, Type, Opaques) of true -> {Map1, t_atom(true)}; false -> {_, Type0} = bind_guard(Arg2, Map, Env, Eval, State), @@ -2087,14 +2108,15 @@ bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) -> handle_guard_and(Guard, Map, Env, Eval, State) -> [Arg1, Arg2] = cerl:call_args(Guard), + Opaques = State#state.opaques, case Eval of pos -> {Map1, Type1} = bind_guard(Arg1, Map, Env, Eval, State), - case t_is_atom(true, Type1) of + case t_is_any_atom(true, Type1, Opaques) of false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State); true -> {Map2, Type2} = bind_guard(Arg2, Map1, Env, Eval, State), - case t_is_atom(true, Type2) of + case t_is_any_atom(true, Type2, Opaques) of false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State); true -> {Map2, t_atom(true)} end @@ -2109,7 +2131,10 @@ handle_guard_and(Guard, Map, Env, Eval, State) -> try bind_guard(Arg2, MapJ, Env, neg, State) catch throw:{fail, _} -> bind_guard(Arg1, MapJ, Env, pos, State) end, - case t_is_atom(false, Type1) orelse t_is_atom(false, Type2) of + case + t_is_any_atom(false, Type1, Opaques) + orelse t_is_any_atom(false, Type2, Opaques) + of true -> {join_maps_end([Map1, Map2], MapJ), t_atom(false)}; false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State) end; @@ -2124,11 +2149,16 @@ handle_guard_and(Guard, Map, Env, Eval, State) -> false -> NewMap = join_maps_end([Map1, Map2], MapJ), NewType = - case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of + case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of {['true'] , ['true'] } -> t_atom(true); {['false'], _ } -> t_atom(false); {_ , ['false']} -> t_atom(false); + {unknown , _ } -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State); + {_ , unknown } -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State); {_ , _ } -> t_boolean() + end, {NewMap, NewType} end @@ -2136,6 +2166,7 @@ handle_guard_and(Guard, Map, Env, Eval, State) -> handle_guard_or(Guard, Map, Env, Eval, State) -> [Arg1, Arg2] = cerl:call_args(Guard), + Opaques = State#state.opaques, case Eval of pos -> MapJ = join_maps_begin(Map), @@ -2149,19 +2180,23 @@ handle_guard_or(Guard, Map, Env, Eval, State) -> catch throw:{fail,_} -> bind_guard(Arg2, MapJ, Env, dont_know, State) end, - case ((t_is_atom(true, Bool1) andalso t_is_boolean(Bool2)) - orelse - (t_is_atom(true, Bool2) andalso t_is_boolean(Bool1))) of + case + ((t_is_any_atom(true, Bool1, Opaques) + andalso t_is_boolean(Bool2, Opaques)) + orelse + (t_is_any_atom(true, Bool2, Opaques) + andalso t_is_boolean(Bool1, Opaques))) + of true -> {join_maps_end([Map1, Map2], MapJ), t_atom(true)}; false -> signal_guard_fail(Eval, Guard, [Bool1, Bool2], State) end; neg -> {Map1, Type1} = bind_guard(Arg1, Map, Env, neg, State), - case t_is_atom(false, Type1) of + case t_is_any_atom(false, Type1, Opaques) of false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State); true -> {Map2, Type2} = bind_guard(Arg2, Map1, Env, neg, State), - case t_is_atom(false, Type2) of + case t_is_any_atom(false, Type2, Opaques) of false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State); true -> {Map2, t_atom(false)} end @@ -2177,10 +2212,14 @@ handle_guard_or(Guard, Map, Env, Eval, State) -> false -> NewMap = join_maps_end([Map1, Map2], MapJ), NewType = - case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of + case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of {['false'], ['false']} -> t_atom(false); {['true'] , _ } -> t_atom(true); {_ , ['true'] } -> t_atom(true); + {unknown , _ } -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State); + {_ , unknown } -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State); {_ , _ } -> t_boolean() end, {NewMap, NewType} @@ -2189,10 +2228,11 @@ handle_guard_or(Guard, Map, Env, Eval, State) -> handle_guard_not(Guard, Map, Env, Eval, State) -> [Arg] = cerl:call_args(Guard), + Opaques = State#state.opaques, case Eval of neg -> {Map1, Type} = bind_guard(Arg, Map, Env, pos, State), - case t_is_atom(true, Type) of + case t_is_any_atom(true, Type, Opaques) of true -> {Map1, t_atom(false)}; false -> {_, Type0} = bind_guard(Arg, Map, Env, Eval, State), @@ -2200,7 +2240,7 @@ handle_guard_not(Guard, Map, Env, Eval, State) -> end; pos -> {Map1, Type} = bind_guard(Arg, Map, Env, neg, State), - case t_is_atom(false, Type) of + case t_is_any_atom(false, Type, Opaques) of true -> {Map1, t_atom(true)}; false -> {_, Type0} = bind_guard(Arg, Map, Env, Eval, State), @@ -2212,10 +2252,11 @@ handle_guard_not(Guard, Map, Env, Eval, State) -> case t_is_none(Bool) of true -> throw({fatal_fail, none}); false -> - case t_atom_vals(Bool) of + case t_atom_vals(Bool, Opaques) of ['true'] -> {Map1, t_atom(false)}; ['false'] -> {Map1, t_atom(true)}; - [_, _] -> {Map1, Bool} + [_, _] -> {Map1, Bool}; + unknown -> signal_guard_fail(Eval, Guard, [Type], State) end end end. @@ -2235,27 +2276,40 @@ bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> state()) -> no_return(). signal_guard_fail(Eval, Guard, ArgTypes, State) -> + signal_guard_failure(Eval, Guard, ArgTypes, fail, State). + +signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) -> + signal_guard_failure(Eval, Guard, ArgTypes, fatal_fail, State). + +signal_guard_failure(Eval, Guard, ArgTypes, Tag, State) -> Args = cerl:call_args(Guard), F = cerl:atom_val(cerl:call_name(Guard)), - MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)}, - Msg = + {M, F, A} = MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)}, + Opaques = State#state.opaques, + {Kind, XInfo} = + case erl_bif_types:opaque_args(M, F, A, ArgTypes, Opaques) of + [] -> + {case Eval of + neg -> neg_guard_fail; + pos -> guard_fail; + dont_know -> guard_fail + end, + []}; + Ns -> {opaque_guard, [Ns]} + end, + FArgs = case is_infix_op(MFA) of true -> [ArgType1, ArgType2] = ArgTypes, [Arg1, Arg2] = Args, - Kind = - case Eval of - neg -> neg_guard_fail; - pos -> guard_fail; - dont_know -> guard_fail - end, - {Kind, [format_args_1([Arg1], [ArgType1], State), - atom_to_list(F), - format_args_1([Arg2], [ArgType2], State)]}; + [format_args_1([Arg1], [ArgType1], State), + atom_to_list(F), + format_args_1([Arg2], [ArgType2], State)] ++ XInfo; false -> - mk_guard_msg(Eval, F, Args, ArgTypes, State) + [F, format_args(Args, ArgTypes, State)] end, - throw({fail, {Guard, Msg}}). + Msg = {Kind, FArgs}, + throw({Tag, {Guard, Msg}}). is_infix_op({erlang, '=:=', 2}) -> true; is_infix_op({erlang, '==', 2}) -> true; @@ -2268,25 +2322,10 @@ is_infix_op({erlang, '>=', 2}) -> true; is_infix_op({M, F, A}) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> false. --spec signal_guard_fatal_fail(eval(), cerl:c_call(), [erl_types:erl_type()], - state()) -> no_return(). - -signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) -> - Args = cerl:call_args(Guard), - F = cerl:atom_val(cerl:call_name(Guard)), - Msg = mk_guard_msg(Eval, F, Args, ArgTypes, State), - throw({fatal_fail, {Guard, Msg}}). - -mk_guard_msg(Eval, F, Args, ArgTypes, State) -> - FArgs = [F, format_args(Args, ArgTypes, State)], - case any_has_opaque_subtype(ArgTypes) of - true -> {opaque_guard, FArgs}; - false -> - case Eval of - neg -> {neg_guard_fail, FArgs}; - pos -> {guard_fail, FArgs}; - dont_know -> {guard_fail, FArgs} - end +bif_args(M, F, A) -> + case erl_bif_types:arg_types(M, F, A) of + unknown -> lists:duplicate(A, t_any()); + List -> List end. bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State) -> @@ -2366,14 +2405,15 @@ bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left], end, {NewMap3, CType} = bind_guard(cerl:clause_body(Clause), NewMap2, Env, Eval, State), + Opaques = State#state.opaques, case Eval of pos -> - case t_is_atom(true, CType) of + case t_is_any_atom(true, CType, Opaques) of true -> ok; false -> throw({fail, none}) end; neg -> - case t_is_atom(false, CType) of + case t_is_any_atom(false, CType, Opaques) of true -> ok; false -> throw({fail, none}) end; @@ -2501,8 +2541,11 @@ enter_type(Key, Val, MS) -> error -> ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]), case dict:find(KeyLabel, Dict) of - {ok, Val} -> MS; - {ok, _OldVal} -> store_map(KeyLabel, Val, MS); + {ok, Value} -> + case erl_types:t_is_equal(Val, Value) of + true -> MS; + false -> store_map(KeyLabel, Val, MS) + end; error -> store_map(KeyLabel, Val, MS) end end @@ -2611,10 +2654,15 @@ get_label(L) when is_integer(L) -> get_label(T) -> cerl_trees:get_label(T). -t_is_simple(ArgType) -> - t_is_atom(ArgType) orelse t_is_number(ArgType) orelse t_is_port(ArgType) - orelse t_is_pid(ArgType) orelse t_is_reference(ArgType) - orelse t_is_nil(ArgType). +t_is_simple(ArgType, State) -> + Opaques = State#state.opaques, + t_is_atom(ArgType, Opaques) orelse t_is_number(ArgType, Opaques) + orelse t_is_port(ArgType, Opaques) + orelse t_is_pid(ArgType, Opaques) orelse t_is_reference(ArgType, Opaques) + orelse t_is_nil(ArgType, Opaques). + +remove_local_opaque_types(Type, Opaques) -> + t_unopaque(Type, Opaques). %% t_is_structured(ArgType) -> %% case t_is_nil(ArgType) of @@ -2638,12 +2686,6 @@ is_call_to_send(Tree) -> andalso (Arity =:= 2) end. -any_opaque(Ts) -> - lists:any(fun erl_types:t_is_opaque/1, Ts). - -any_has_opaque_subtype(Ts) -> - lists:any(fun erl_types:t_has_opaque_subtype/1, Ts). - filter_match_fail([Clause] = Cls) -> Body = cerl:clause_body(Clause), case cerl:type(Body) of @@ -2662,12 +2704,6 @@ filter_match_fail([]) -> %% receive after 1 -> ok end []. -determine_mode(Type, Opaques) -> - case lists:member(Type, Opaques) of - true -> opaque; - false -> structured - end. - %%% =========================================================================== %%% %%% The State. @@ -2679,7 +2715,7 @@ state__new(Callgraph, Tree, Plt, Module, Records) -> erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), Funs = dict:fetch_keys(TreeMap), - FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt, Opaques), + FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), ExportedFuns = [Fun || Fun <- Funs--[top], dialyzer_callgraph:is_escaping(Fun, Callgraph)], Work = init_work(ExportedFuns), @@ -2740,12 +2776,14 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, case Force of true -> Warn = {Tag, {get_file(Ann), abs(get_line(Ann))}, Msg}, + ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]), State#state{warnings = [Warn|Warnings]}; false -> case is_compiler_generated(Ann) of true -> State; false -> Warn = {Tag, {get_file(Ann), get_line(Ann)}, Msg}, + ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]), State#state{warnings = [Warn|Warnings]} end end. @@ -2875,10 +2913,10 @@ build_tree_map(Tree) -> end, cerl_trees:fold(Fun, dict:new(), Tree). -init_fun_tab([top|Left], Dict, TreeMap, Callgraph, Plt, Opaques) -> +init_fun_tab([top|Left], Dict, TreeMap, Callgraph, Plt) -> NewDict = dict:store(top, {[], t_none()}, Dict), - init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt, Opaques); -init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt, Opaques) -> + init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt); +init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt) -> Arity = cerl:fun_arity(dict:fetch(Fun, TreeMap)), FunEntry = case dialyzer_callgraph:is_escaping(Fun, Callgraph) of @@ -2895,8 +2933,8 @@ init_fun_tab([Fun|Left], Dict, TreeMap, Callgraph, Plt, Opaques) -> false -> {not_handled, {lists:duplicate(Arity, t_none()), t_unit()}} end, NewDict = dict:store(Fun, FunEntry, Dict), - init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt, Opaques); -init_fun_tab([], Dict, _TreeMap, _Callgraph, _Plt, _Opaques) -> + init_fun_tab(Left, NewDict, TreeMap, Callgraph, Plt); +init_fun_tab([], Dict, _TreeMap, _Callgraph, _Plt) -> ?debug("DICT:~p\n",[dict:to_list(Dict)]), Dict. @@ -2945,34 +2983,27 @@ state__update_fun_entry(Tree, ArgTypes, Out0, if Fun =:= top -> Out0; true -> case lookup_fun_sig(Fun, CG, Plt) of - {value, {SigRet, _}} -> t_inf(SigRet, Out0, opaque); + {value, {SigRet, _}} -> t_inf(SigRet, Out0); none -> Out0 end end, Out = t_limit(Out1, ?TYPE_LIMIT), - case dict:find(Fun, FunTab) of - {ok, {ArgTypes, OldOut}} -> - case t_is_equal(OldOut, Out) of - true -> - ?debug("Fixpoint for ~w: ~s\n", - [state__lookup_name(Fun, State), - t_to_string(t_fun(ArgTypes, Out))]), - State; - false -> - NewEntry = {ArgTypes, Out}, - ?debug("New Entry for ~w: ~s\n", - [state__lookup_name(Fun, State), - t_to_string(t_fun(ArgTypes, Out))]), - NewFunTab = dict:store(Fun, NewEntry, FunTab), - State1 = State#state{fun_tab = NewFunTab}, - state__add_work_from_fun(Tree, State1) - end; - {ok, {NewArgTypes, _OldOut}} -> - %% Can only happen in self-recursive functions. Only update the out type. - NewEntry = {NewArgTypes, Out}, + {ok, {OldArgTypes, OldOut}} = dict:find(Fun, FunTab), + SameArgs = lists:all(fun({A, B}) -> erl_types:t_is_equal(A, B) + end, lists:zip(OldArgTypes, ArgTypes)), + SameOut = t_is_equal(OldOut, Out), + if + SameArgs, SameOut -> + ?debug("Fixpoint for ~w: ~s\n", + [state__lookup_name(Fun, State), + t_to_string(t_fun(ArgTypes, Out))]), + State; + true -> + %% Can only happen in self-recursive functions. + NewEntry = {OldArgTypes, Out}, ?debug("New Entry for ~w: ~s\n", [state__lookup_name(Fun, State), - t_to_string(t_fun(NewArgTypes, Out))]), + t_to_string(t_fun(OldArgTypes, Out))]), NewFunTab = dict:store(Fun, NewEntry, FunTab), State1 = State#state{fun_tab = NewFunTab}, state__add_work_from_fun(Tree, State1) @@ -2993,7 +3024,7 @@ state__add_work_from_fun(Tree, #state{callgraph = Callgraph, %% Must filter the result for results in this module. FilteredList = [L || {ok, L} <- LabelList, dict:is_key(L, TreeMap)], ?debug("~w: Will try to add:~w\n", - [state__lookup_name(get_label(Tree), State), MFAList]), + [state__lookup_name(Label, State), MFAList]), lists:foldl(fun(L, AccState) -> state__add_work(L, AccState) end, State, FilteredList) @@ -3054,7 +3085,8 @@ forward_args(Fun, ArgTypes, #state{work = Work, fun_tab = FunTab} = State) -> case Fixpoint of true -> State; false -> - NewArgTypes = [t_sup(X, Y) || {X, Y} <- lists:zip(ArgTypes, OldArgTypes)], + NewArgTypes = [t_sup(X, Y) || + {X, Y} <- lists:zip(ArgTypes, OldArgTypes)], NewWork = add_work(Fun, Work), ?debug("~w: forwarding args ~s\n", [state__lookup_name(Fun, State), @@ -3238,13 +3270,13 @@ format_field_diffs(RecConstruction, #state{records = R}) -> -spec format_sig_args(erl_types:erl_type(), state()) -> string(). -format_sig_args(Type, #state{records = R}) -> - SigArgs = t_fun_args(Type), +format_sig_args(Type, #state{opaques = Opaques} = State) -> + SigArgs = t_fun_args(Type, Opaques), case SigArgs of [] -> "()"; [SArg|SArgs] -> - lists:flatten("(" ++ t_to_string(SArg, R) - ++ ["," ++ t_to_string(T, R) || T <- SArgs] ++ ")") + lists:flatten("(" ++ format_type(SArg, State) + ++ ["," ++ format_type(T, State) || T <- SArgs] ++ ")") end. format_cerl(Tree) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 84379642bf..f0488b5ee3 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -149,8 +149,10 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver, NewState = InitState#st{no_warn_unused = NoWarnUnused}, Mods = dialyzer_callgraph:modules(NewState#st.callgraph), MiniPlt = NewState#st.plt, + FindOpaques = lookup_and_find_opaques_fun(Codeserver), CWarns = - dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, MiniPlt), + dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, + MiniPlt, FindOpaques), MiniDocPlt = dialyzer_plt:get_mini_plt(DocPlt), ModWarns = ?timing(TimingServer, "warning", @@ -261,7 +263,16 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> FunTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt), NewFunTypes = dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, Records), - case reached_fixpoint(FunTypes, NewFunTypes) of + Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer), + Contracts = orddict:from_list(dict:to_list(Contracts1)), + FindOpaques = find_opaques_fun(Records), + DecoratedFunTypes = + decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques), + %% ?debug("NewFunTypes ~p\n ~n", [dict:to_list(NewFunTypes)]), + %% ?debug("refine DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]), + debug_pp_functions("Refine", NewFunTypes, DecoratedFunTypes, Callgraph), + + case reached_fixpoint(FunTypes, DecoratedFunTypes) of true -> []; {false, NotFixpoint} -> ?debug("Not fixpoint\n", []), @@ -357,9 +368,16 @@ find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) -> AllFunSet = sets:from_list([X || {X, _} <- AllFuns]), FilteredFunTypes = dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes), + FindOpaques = lookup_and_find_opaques_fun(Codeserver), + DecoratedFunTypes = + decorate_succ_typings(Contracts3, Callgraph, FilteredFunTypes, FindOpaques), %% Check contracts PltContracts = - dialyzer_contracts:check_contracts(Contracts3, Callgraph, FilteredFunTypes), + dialyzer_contracts:check_contracts(Contracts3, Callgraph, + DecoratedFunTypes, FindOpaques), + %% ?debug("FilteredFunTypes ~p\n ~n", [dict:to_list(FilteredFunTypes)]), + %% ?debug("SCC DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]), + debug_pp_functions("SCC", FilteredFunTypes, DecoratedFunTypes, Callgraph), ContractFixpoint = lists:all(fun({MFA, _C}) -> %% Check the non-deleted PLT @@ -368,16 +386,47 @@ find_succ_types_for_scc(SCC, {Codeserver, Callgraph, Plt, Solvers}) -> {value, _} -> true end end, PltContracts), - Plt = insert_into_plt(FilteredFunTypes, Callgraph, Plt), + Plt = insert_into_plt(DecoratedFunTypes, Callgraph, Plt), Plt = dialyzer_plt:insert_contract_list(Plt, PltContracts), case (ContractFixpoint andalso - reached_fixpoint_strict(PropTypes, FilteredFunTypes)) of + reached_fixpoint_strict(PropTypes, DecoratedFunTypes)) of true -> []; false -> ?debug("Not fixpoint for: ~w\n", [AllFuns]), [Fun || {Fun, _Arity} <- AllFuns] end. +decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) -> + F = fun(Label, Type) -> + case dialyzer_callgraph:lookup_name(Label, Callgraph) of + {ok, MFA} -> + case orddict:find(MFA, Contracts) of + {ok, {_FileLine, Contract}} -> + Args = dialyzer_contracts:get_contract_args(Contract), + Ret = dialyzer_contracts:get_contract_return(Contract), + C = erl_types:t_fun(Args, Ret), + {M, _, _} = MFA, + Opaques = FindOpaques(M), + erl_types:t_decorate_with_opaque(Type, C, Opaques); + error -> Type + end; + error -> Type + end + end, + dict:map(F, FunTypes). + +lookup_and_find_opaques_fun(Codeserver) -> + fun(Module) -> + Records = dialyzer_codeserver:lookup_mod_records(Module, Codeserver), + (find_opaques_fun(Records))(Module) + end. + +find_opaques_fun(Records) -> + fun(Module) -> + erl_types:module_builtin_opaques(Module) ++ + erl_types:t_opaque_from_records(Records) + end. + get_fun_types_from_plt(FunList, Callgraph, Plt) -> get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()). @@ -443,9 +492,30 @@ debug_pp_succ_typings(SuccTypes) -> || {MFA, {contract, RetFun, ArgT}} <- SuccTypes], ?debug("\n", []), ok. + +debug_pp_functions(Header, FunTypes, DecoratedFunTypes, Callgraph) -> + ?debug("FunTypes (~s)\n", [Header]), + FTypes = lists:keysort(1, dict:to_list(FunTypes)), + DTypes = lists:keysort(1, dict:to_list(DecoratedFunTypes)), + Fun = fun({{Label, Type},{Label, DecoratedType}}) -> + Name = lookup_name(Label, Callgraph), + ?debug("~w (~w): ~s\n", + [Name, Label, erl_types:t_to_string(Type)]), + case erl_types:t_is_equal(Type, DecoratedType) of + true -> ok; + false -> + ?debug(" With opaque types: ~s\n", + [erl_types:t_to_string(DecoratedType)]) + end + end, + lists:foreach(Fun, lists:zip(FTypes, DTypes)), + ?debug("\n", []). -else. debug_pp_succ_typings(_) -> ok. + +debug_pp_functions(_, _, _, _) -> + ok. -endif. lookup_name(F, CG) -> diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index a418a11e65..db7875704a 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -31,28 +31,30 @@ -export([analyze_scc/6]). -export([get_safe_underapprox/2]). +%%-import(helper, %% 'helper' could be any module doing sanity checks... +-import(erl_types, + [t_has_var/1, t_inf/2, t_is_equal/2, t_is_subtype/2, + t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2,t_unify/2]). + -import(erl_types, [t_any/0, t_atom/0, t_atom_vals/1, t_binary/0, t_bitstr/0, t_bitstr/2, t_bitstr_concat/1, t_boolean/0, t_collect_vars/1, t_cons/2, t_cons_hd/1, t_cons_tl/1, t_float/0, t_from_range/2, t_from_term/1, t_fun/0, t_fun/2, t_fun_args/1, t_fun_range/1, - t_has_var/1, - t_inf/2, t_inf/3, t_integer/0, - t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_cons/1, t_is_equal/2, + t_integer/0, + t_is_any/1, t_is_atom/1, t_is_any_atom/2, t_is_cons/1, t_is_float/1, t_is_fun/1, t_is_integer/1, t_non_neg_integer/0, t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1, - t_is_subtype/2, t_limit/2, t_list/0, t_list/1, + t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, t_module/0, t_number/0, t_number_vals/1, - t_opaque_match_record/2, t_opaque_matching_structure/2, - t_opaque_from_records/1, t_pid/0, t_port/0, t_product/1, t_reference/0, - t_subst/2, t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2, + t_subst/2, t_timeout/0, t_tuple/0, t_tuple/1, - t_unify/3, t_var/1, t_var_name/1, + t_var/1, t_var_name/1, t_none/0, t_unit/0]). -include("dialyzer.hrl"). @@ -105,11 +107,10 @@ module :: module(), name_map = dict:new() :: dict(), next_label = 0 :: label(), - self_rec :: erl_types:erl_type(), + self_rec :: 'false' | erl_types:erl_type(), plt :: dialyzer_plt:plt(), prop_types = {'d', dict:new()} :: dict_or_ets(), records = dict:new() :: dict(), - opaques = [] :: [erl_types:erl_type()], scc = [] :: [type_var()], mfas :: [tuple()], solvers = [] :: [solver()] @@ -192,11 +193,10 @@ solvers(Solvers) -> Solvers. %% %% ============================================================================ -traverse_scc([{MFA, Def, Rec}|Left], DefSet, AccState) -> +traverse_scc([{_MFA, Def, Rec}|Left], DefSet, AccState) -> TmpState1 = state__set_rec_dict(AccState, Rec), - TmpState2 = state__set_opaques(TmpState1, MFA), DummyLetrec = cerl:c_letrec([Def], cerl:c_atom(foo)), - {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2), + {NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState1), traverse_scc(Left, DefSet, NewAccState); traverse_scc([], _DefSet, AccState) -> AccState. @@ -386,12 +386,7 @@ traverse(Tree, DefinedVars, State) -> case cerl:unfold_literal(Tree) of Tree -> Type = t_from_term(cerl:concrete(Tree)), - NewType = - case erl_types:t_opaque_match_atom(Type, State#state.opaques) of - [Opaque] -> Opaque; - _ -> Type - end, - {State, NewType}; + {State, Type}; NewTree -> traverse(NewTree, DefinedVars, State) end; module -> @@ -462,25 +457,17 @@ traverse(Tree, DefinedVars, State) -> [Tag|Fields] -> case cerl:is_c_atom(Tag) of true -> - %% Check if an opaque term is constructed. - case t_opaque_match_record(TupleType, State#state.opaques) of - [Opaque] -> - OpStruct = t_opaque_matching_structure(TupleType, Opaque), - State3 = state__store_conj(TupleType, sub, OpStruct, State2), - {State3, Opaque}; - %% Check if a record is constructed. - _ -> - Arity = length(Fields), - Records = State2#state.records, - case lookup_record(Records, cerl:atom_val(Tag), Arity) of - error -> {State2, TupleType}; - {ok, RecType} -> - State3 = state__store_conj(TupleType, sub, RecType, State2), - {State3, TupleType} - end - end; + %% Check if a record is constructed. + Arity = length(Fields), + Records = State2#state.records, + case lookup_record(Records, cerl:atom_val(Tag), Arity) of + error -> {State2, TupleType}; + {ok, RecType} -> + State3 = state__store_conj(TupleType, sub, RecType, State2), + {State3, TupleType} + end; false -> {State2, TupleType} - end; + end; [] -> {State2, TupleType} end; values -> @@ -591,9 +578,13 @@ handle_try(Tree, DefinedVars, State) -> case state__is_in_guard(State) of true -> Conj1 = mk_conj_constraint_list([ArgBodyCs, - mk_constraint(BodyVar, eq, TreeVar)]), + mk_constraint(BodyVar, + eq, + TreeVar)]), Disj = mk_disj_constraint_list([Conj1, - mk_constraint(HandlerVar, eq, TreeVar)]), + mk_constraint(HandlerVar, + eq, + TreeVar)]), NewState1 = state__new_constraint_context(HandlerState), Conj2 = mk_conj_constraint_list([OldCs, Disj]), NewState2 = state__store_conj(Conj2, NewState1), @@ -604,19 +595,27 @@ handle_try(Tree, DefinedVars, State) -> {false, false} -> Conj1 = mk_conj_constraint_list([ArgBodyCs, - mk_constraint(TreeVar, eq, BodyVar)]), + mk_constraint(TreeVar, + eq, + BodyVar)]), Conj2 = mk_conj_constraint_list([HandlerCs, - mk_constraint(TreeVar, eq, HandlerVar)]), + mk_constraint(TreeVar, + eq, + HandlerVar)]), Disj = mk_disj_constraint_list([Conj1, Conj2]), {Disj, TreeVar}; {false, true} -> {mk_conj_constraint_list([ArgBodyCs, - mk_constraint(TreeVar, eq, BodyVar)]), + mk_constraint(TreeVar, + eq, + BodyVar)]), BodyVar}; {true, false} -> {mk_conj_constraint_list([HandlerCs, - mk_constraint(TreeVar, eq, HandlerVar)]), + mk_constraint(TreeVar, + eq, + HandlerVar)]), HandlerVar}; {true, true} -> ?debug("Throw failed\n", []), @@ -668,10 +667,7 @@ handle_call(Call, DefinedVars, State) -> get_plt_constr(MFA, Dst, ArgVars, State) -> Plt = state__plt(State), PltRes = dialyzer_plt:lookup(Plt, MFA), - Opaques = State#state.opaques, - Module = State#state.module, SCCMFAs = State#state.mfas, - {FunModule, _, _} = MFA, Contract = case lists:member(MFA, SCCMFAs) of true -> none; @@ -691,28 +687,24 @@ get_plt_constr(MFA, Dst, ArgVars, State) -> none -> {?mk_fun_var(fun(Map) -> ArgTypes = lookup_type_list(ArgVars, Map), - dialyzer_contracts:get_contract_return(C, ArgTypes) + get_contract_return(C, ArgTypes) end, ArgVars), GenArgs}; {value, {PltRetType, PltArgTypes}} -> %% Need to combine the contract with the success typing. {?mk_fun_var( fun(Map) -> - ArgTypes0 = lookup_type_list(ArgVars, Map), - ArgTypes = case FunModule =:= Module of - false -> - List = lists:zip(PltArgTypes, ArgTypes0), - [erl_types:t_unopaque_on_mismatch(T1, T2, Opaques) - || {T1, T2} <- List]; - true -> ArgTypes0 - end, - CRet = dialyzer_contracts:get_contract_return(C, ArgTypes), - t_inf(CRet, PltRetType, opaque) + ArgTypes = lookup_type_list(ArgVars, Map), + CRet = get_contract_return(C, ArgTypes), + t_inf(CRet, PltRetType) end, ArgVars), - [t_inf(X, Y, opaque) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]} + [t_inf(X, Y) || {X, Y} <- lists:zip(GenArgs, PltArgTypes)]} end, state__store_conj_lists([Dst|ArgVars], sub, [RetType|ArgCs], State) end. +get_contract_return(C, ArgTypes) -> + dialyzer_contracts:get_contract_return(C, ArgTypes). + filter_match_fail([Clause] = Cls) -> Body = cerl:clause_body(Clause), case cerl:type(Body) of @@ -1086,7 +1078,7 @@ get_bif_constr({erlang, Op, 2}, Dst, Args = [Arg1, Arg2], _State) when Op =:= '+'; Op =:= '-'; Op =:= '*' -> ReturnType = ?mk_fun_var(fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + bif_return(erlang, Op, 2, TmpArgTypes) end, Args), ArgFun = fun(A, Pos) -> @@ -1128,8 +1120,8 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State) fun(LocalArg1, LocalArg2, LocalOp) -> fun(Map) -> DstType = lookup_type(Dst, Map), - IsTrue = t_is_atom(true, DstType), - IsFalse = t_is_atom(false, DstType), + IsTrue = t_is_any_atom(true, DstType), + IsFalse = t_is_any_atom(false, DstType), case IsTrue orelse IsFalse of true -> Arg1Type = lookup_type(LocalArg1, Map), @@ -1176,7 +1168,7 @@ get_bif_constr({erlang, Op, 2}, Dst, [Arg1, Arg2] = Args, _State) Arg2Var = ?mk_fun_var(Arg2Fun, DstArgs), DstVar = ?mk_fun_var(fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, Op, 2, TmpArgTypes) + bif_return(erlang, Op, 2, TmpArgTypes) end, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstVar), mk_constraint(Arg1, sub, Arg1Var), @@ -1218,7 +1210,7 @@ get_bif_constr({erlang, '++', 2}, Dst, [Hd, Tl] = Args, _State) -> ArgTypes = erl_bif_types:arg_types(erlang, '++', 2), ReturnType = ?mk_fun_var(fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, '++', 2, TmpArgTypes) + bif_return(erlang, '++', 2, TmpArgTypes) end, Args), Cs = mk_constraints(Args, sub, ArgTypes), mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType), @@ -1240,7 +1232,7 @@ get_bif_constr({erlang, is_function, 1}, Dst, [Arg], State) -> get_bif_constr({erlang, is_function, 2}, Dst, [Fun, Arity], _State) -> ArgFun = fun(Map) -> DstType = lookup_type(Dst, Map), - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> ArityType = lookup_type(Arity, Map), case t_number_vals(ArityType) of @@ -1268,7 +1260,7 @@ get_bif_constr({erlang, is_reference, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_reference(), State); get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) -> ArgFun = fun(Map) -> - case t_is_atom(true, lookup_type(Dst, Map)) of + case t_is_any_atom(true, lookup_type(Dst, Map)) of true -> t_tuple(); false -> t_any() end @@ -1276,7 +1268,7 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) -> ArgV = ?mk_fun_var(ArgFun, [Dst]), DstFun = fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, is_record, 2, TmpArgTypes) + bif_return(erlang, is_record, 2, TmpArgTypes) end, DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), @@ -1285,10 +1277,9 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) -> get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> %% TODO: Revise this to make it precise for Tag and Arity. Records = State#state.records, - AllOpaques = State#state.opaques, ArgFun = fun(Map) -> - case t_is_atom(true, lookup_type(Dst, Map)) of + case t_is_any_atom(true, lookup_type(Dst, Map)) of true -> ArityType = lookup_type(Arity, Map), case t_is_integer(ArityType) of @@ -1304,10 +1295,7 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> [TagVal] -> case lookup_record(Records, TagVal, ArityVal - 1) of {ok, Type} -> - case t_opaque_match_record(Type, AllOpaques) of - [Opaque] -> Opaque; - _ -> Type - end; + Type; error -> GenRecord end; _ -> GenRecord @@ -1323,38 +1311,9 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) -> end, ArgV = ?mk_fun_var(ArgFun, [Tag, Arity, Dst]), DstFun = fun(Map) -> - [TmpVar, TmpTag, TmpArity] = TmpArgTypes = lookup_type_list(Args, Map), - TmpArgTypes2 = - case lists:member(TmpVar, AllOpaques) of - true -> - case t_is_integer(TmpArity) of - true -> - case t_number_vals(TmpArity) of - [TmpArityVal] -> - case t_is_atom(TmpTag) of - true -> - case t_atom_vals(TmpTag) of - [TmpTagVal] -> - case lookup_record(Records, TmpTagVal, - TmpArityVal - 1) of - {ok, TmpType} -> - case t_is_none(t_inf(TmpType, TmpVar, opaque)) of - true -> TmpArgTypes; - false -> [TmpType, TmpTag, TmpArity] - end; - error -> TmpArgTypes - end; - _ -> TmpArgTypes - end; - false -> TmpArgTypes - end; - _ -> TmpArgTypes - end; - false -> TmpArgTypes - end; - false -> TmpArgTypes - end, - erl_bif_types:type(erlang, is_record, 3, TmpArgTypes2) + [TmpVar, TmpTag, TmpArity] = lookup_type_list(Args, Map), + TmpArgTypes = [TmpVar,TmpTag,TmpArity], + bif_return(erlang, is_record, 3, TmpArgTypes) end, DstV = ?mk_fun_var(DstFun, Args), mk_conj_constraint_list([mk_constraint(Dst, sub, DstV), @@ -1369,12 +1328,14 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) -> ArgFun = fun(Var) -> fun(Map) -> DstType = lookup_type(Dst, Map), - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> True; false -> - case t_is_atom(false, DstType) of + case t_is_any_atom(false, DstType) of true -> - case t_is_atom(true, lookup_type(Var, Map)) of + case + t_is_any_atom(true, lookup_type(Var, Map)) + of true -> False; false -> t_boolean() end; @@ -1386,15 +1347,15 @@ get_bif_constr({erlang, 'and', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end, DstFun = fun(Map) -> Arg1Type = lookup_type(Arg1, Map), - case t_is_atom(false, Arg1Type) of + case t_is_any_atom(false, Arg1Type) of true -> False; false -> Arg2Type = lookup_type(Arg2, Map), - case t_is_atom(false, Arg2Type) of + case t_is_any_atom(false, Arg2Type) of true -> False; false -> - case (t_is_atom(true, Arg1Type) - andalso t_is_atom(true, Arg2Type)) of + case (t_is_any_atom(true, Arg1Type) + andalso t_is_any_atom(true, Arg2Type)) of true -> True; false -> t_boolean() end @@ -1413,12 +1374,14 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) -> ArgFun = fun(Var) -> fun(Map) -> DstType = lookup_type(Dst, Map), - case t_is_atom(false, DstType) of + case t_is_any_atom(false, DstType) of true -> False; false -> - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> - case t_is_atom(false, lookup_type(Var, Map)) of + case + t_is_any_atom(false, lookup_type(Var, Map)) + of true -> True; false -> t_boolean() end; @@ -1430,15 +1393,15 @@ get_bif_constr({erlang, 'or', 2}, Dst, [Arg1, Arg2] = Args, _State) -> end, DstFun = fun(Map) -> Arg1Type = lookup_type(Arg1, Map), - case t_is_atom(true, Arg1Type) of + case t_is_any_atom(true, Arg1Type) of true -> True; false -> Arg2Type = lookup_type(Arg2, Map), - case t_is_atom(true, Arg2Type) of + case t_is_any_atom(true, Arg2Type) of true -> True; false -> - case (t_is_atom(false, Arg1Type) - andalso t_is_atom(false, Arg2Type)) of + case (t_is_any_atom(false, Arg1Type) + andalso t_is_any_atom(false, Arg2Type)) of true -> False; false -> t_boolean() end @@ -1465,10 +1428,10 @@ get_bif_constr({erlang, 'not', 1}, Dst, [Arg] = Args, _State) -> Fun = fun(Var) -> fun(Map) -> Type = lookup_type(Var, Map), - case t_is_atom(true, Type) of + case t_is_any_atom(true, Type) of true -> False; false -> - case t_is_atom(false, Type) of + case t_is_any_atom(false, Type) of true -> True; false -> t_boolean() end @@ -1485,10 +1448,10 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> fun(Map) -> DstType = lookup_type(Dst, Map), OtherVarType = lookup_type(OtherVar, Map), - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> OtherVarType; false -> - case t_is_atom(false, DstType) of + case t_is_any_atom(false, DstType) of true -> case is_singleton_type(OtherVarType) of true -> t_subtract(lookup_type(Self, Map), OtherVarType); @@ -1518,7 +1481,7 @@ get_bif_constr({erlang, '=:=', 2}, Dst, [Arg1, Arg2] = Args, _State) -> get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> DstFun = fun(Map) -> TmpArgTypes = lookup_type_list(Args, Map), - erl_bif_types:type(erlang, '==', 2, TmpArgTypes) + bif_return(erlang, '==', 2, TmpArgTypes) end, ArgFun = fun(Var, Self) -> @@ -1527,16 +1490,16 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> DstType = lookup_type(Dst, Map), case is_singleton_non_number_type(VarType) of true -> - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> VarType; false -> - case t_is_atom(false, DstType) of + case t_is_any_atom(false, DstType) of true -> t_subtract(lookup_type(Self, Map), VarType); false -> t_any() end end; false -> - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> case t_is_number(VarType) of true -> t_number(); @@ -1560,18 +1523,14 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, - #state{cs = Constrs, opaques = Opaques}) -> + #state{cs = Constrs}) -> GenType = erl_bif_types:type(erlang, element, 2), case t_is_none(GenType) of true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error); false -> Fun = fun(Map) -> - [I, T] = ATs = lookup_type_list(Args, Map), - ATs2 = case lists:member(T, Opaques) of - true -> [I, erl_types:t_opaque_structure(T)]; - false -> ATs - end, - erl_bif_types:type(erlang, element, 2, ATs2) + ATs2 = lookup_type_list(Args, Map), + bif_return(erlang, element, 2, ATs2) end, ReturnType = ?mk_fun_var(Fun, Args), ArgTypes = erl_bif_types:arg_types(erlang, element, 2), @@ -1583,22 +1542,14 @@ get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, end, mk_conj_constraint_list([mk_constraint(Dst, sub, ReturnType)|NewCs]) end; -get_bif_constr({M, F, A} = _BIF, Dst, Args, State) -> +get_bif_constr({M, F, A} = _BIF, Dst, Args, _State) -> GenType = erl_bif_types:type(M, F, A), - Opaques = State#state.opaques, case t_is_none(GenType) of true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error); false -> - UnopaqueFun = - fun(T) -> case lists:member(T, Opaques) of - true -> erl_types:t_unopaque(T, [T]); - false -> T - end - end, ReturnType = ?mk_fun_var(fun(Map) -> - TmpArgTypes0 = lookup_type_list(Args, Map), - TmpArgTypes = [UnopaqueFun(T) || T<- TmpArgTypes0], - erl_bif_types:type(M, F, A, TmpArgTypes) + TmpArgTypes = lookup_type_list(Args, Map), + bif_return(M, F, A, TmpArgTypes) end, Args), case erl_bif_types:is_known(M, F, A) of false -> @@ -1616,12 +1567,12 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, State) -> end. eval_inv_arith('+', _Pos, Dst, Arg) -> - erl_bif_types:type(erlang, '-', 2, [Dst, Arg]); + bif_return(erlang, '-', 2, [Dst, Arg]); eval_inv_arith('*', _Pos, Dst, Arg) -> case t_number_vals(Arg) of [0] -> t_integer(); _ -> - TmpRet = erl_bif_types:type(erlang, 'div', 2, [Dst, Arg]), + TmpRet = bif_return(erlang, 'div', 2, [Dst, Arg]), Zero = t_from_term(0), %% If 0 is not part of the result, it cannot be part of the argument. case t_is_subtype(Zero, Dst) of @@ -1630,9 +1581,9 @@ eval_inv_arith('*', _Pos, Dst, Arg) -> end end; eval_inv_arith('-', 1, Dst, Arg) -> - erl_bif_types:type(erlang, '-', 2, [Arg, Dst]); + bif_return(erlang, '-', 2, [Arg, Dst]); eval_inv_arith('-', 2, Dst, Arg) -> - erl_bif_types:type(erlang, '+', 2, [Arg, Dst]). + bif_return(erlang, '+', 2, [Arg, Dst]). range_inc(neg_inf) -> neg_inf; range_inc(pos_inf) -> pos_inf; @@ -1642,33 +1593,20 @@ range_dec(neg_inf) -> neg_inf; range_dec(pos_inf) -> pos_inf; range_dec(Int) when is_integer(Int) -> Int - 1. -get_bif_test_constr(Dst, Arg, Type, State) -> +get_bif_test_constr(Dst, Arg, Type, _State) -> ArgFun = fun(Map) -> DstType = lookup_type(Dst, Map), - case t_is_atom(true, DstType) of + case t_is_any_atom(true, DstType) of true -> Type; false -> t_any() end end, ArgV = ?mk_fun_var(ArgFun, [Dst]), - Opaques = State#state.opaques, DstFun = fun(Map) -> ArgType = lookup_type(Arg, Map), case t_is_none(t_inf(ArgType, Type)) of true -> - case lists:member(ArgType, Opaques) of - true -> - OpaqueStruct = erl_types:t_opaque_structure(ArgType), - case t_is_none(t_inf(OpaqueStruct, Type)) of - true -> t_from_term(false); - false -> - case t_is_subtype(ArgType, Type) of - true -> t_from_term(true); - false -> t_boolean() - end - end; - false -> t_from_term(false) - end; + t_from_term(false); false -> case t_is_subtype(ArgType, Type) of true -> t_from_term(true); @@ -1784,7 +1722,6 @@ minimize_state(#state{ fun_arities = FunArities, self_rec = SelfRec, prop_types = {d, PropTypes}, - opaques = Opaques, solvers = Solvers }) -> Opts = [{read_concurrency, true}], @@ -1798,7 +1735,6 @@ minimize_state(#state{ fun_arities = FunArities, self_rec = SelfRec, prop_types = {e, ETSPropTypes}, - opaques = Opaques, solvers = Solvers }. @@ -1956,8 +1892,7 @@ v2_solve_ref(Fun, Map, State) -> {ok, NewMap}. v2_solve(#constraint{}=C, Map, V2State) -> - State = V2State#v2_state.state, - case solve_one_c(C, Map, State#state.opaques) of + case solve_one_c(C, Map) of error -> report_failed_constraint(C, Map), {error, V2State}; @@ -2031,7 +1966,7 @@ v2_solve_self_recursive(Cs, Map, Id, RecType0, V2State0) -> {ok, NewMap, V2State, U} -> pp_map("recursive finished", NewMap), NewRecType = unsafe_lookup_type(Id, NewMap), - case t_is_equal(NewRecType, RecType0) of + case is_equal(NewRecType, RecType0) of true -> {NewMap2, U1} = enter_var_type(RecVar, NewRecType, NewMap), {ok, NewMap2, V2State, lists:umerge(U, U1)}; @@ -2397,7 +2332,7 @@ solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) -> {ok, NewMapDict, NewMap} -> pp_map("NewMap", NewMap), NewRecType = unsafe_lookup_type(Id, NewMap), - case t_is_equal(NewRecType, RecType0) of + case is_equal(NewRecType, RecType0) of true -> {ok, NewMapDict, enter_type(RecVar, NewRecType, NewMap)}; false -> @@ -2447,7 +2382,7 @@ solve_cs([#constraint_list{} = C|Tail], Map, MapDict, State) -> {error, _NewMapDict} = Error -> Error end; solve_cs([#constraint{} = C|Tail], Map, MapDict, State) -> - case solve_one_c(C, Map, State#state.opaques) of + case solve_one_c(C, Map) of error -> report_failed_constraint(C, Map), {error, MapDict}; @@ -2457,10 +2392,10 @@ solve_cs([#constraint{} = C|Tail], Map, MapDict, State) -> solve_cs([], Map, MapDict, _State) -> {ok, MapDict, Map}. -solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) -> +solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map) -> LhsType = lookup_type(Lhs, Map), RhsType = lookup_type(Rhs, Map), - Inf = t_inf(LhsType, RhsType, opaque), + Inf = t_inf(LhsType, RhsType), ?debug("Solving: ~s :: ~s ~w ~s :: ~s\n\tInf: ~s\n", [format_type(Lhs), format_type(LhsType), Op, format_type(Rhs), format_type(RhsType), format_type(Inf)]), @@ -2468,12 +2403,12 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) -> true -> error; false -> case Op of - sub -> solve_subtype(Lhs, Inf, Map, Opaques); + sub -> solve_subtype(Lhs, Inf, Map); eq -> - case solve_subtype(Lhs, Inf, Map, Opaques) of + case solve_subtype(Lhs, Inf, Map) of error -> error; {ok, {Map1, U1}} -> - case solve_subtype(Rhs, Inf, Map1, Opaques) of + case solve_subtype(Rhs, Inf, Map1) of error -> error; {ok, {Map2, U2}} -> {ok, {Map2, lists:umerge(U1, U2)}} end @@ -2481,7 +2416,7 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map, Opaques) -> end end. -solve_subtype(Type, Inf, Map, Opaques) -> +solve_subtype(Type, Inf, Map) -> %% case cerl:is_literal(Type) of %% true -> %% case t_is_subtype(t_from_term(cerl:concrete(Type)), Inf) of @@ -2489,7 +2424,7 @@ solve_subtype(Type, Inf, Map, Opaques) -> %% false -> error %% end; %% false -> - try t_unify(Type, Inf, Opaques) of + try t_unify(Type, Inf) of {_, List} -> {ok, enter_type_list(List, Map)} catch throw:{mismatch, _T1, _T2} -> @@ -2540,7 +2475,7 @@ join_one_key(Key, [Map|Maps], Type) -> true -> Type; false -> NewType = lookup_type(Key, Map), - case t_is_equal(NewType, Type) of + case is_equal(NewType, Type) of true -> join_one_key(Key, Maps, Type); false -> join_one_key(Key, Maps, t_sup(NewType, Type)) end @@ -2555,7 +2490,7 @@ maps_are_equal(Map1, Map2, Deps) -> maps_are_equal_1(Map1, Map2, [H|Tail]) -> T1 = lookup_type(H, Map1), T2 = lookup_type(H, Map2), - case t_is_equal(T1, T2) of + case is_equal(T1, T2) of true -> maps_are_equal_1(Map1, Map2, Tail); false -> ?debug("~w: ~s =/= ~s\n", [H, format_type(T1), format_type(T2)]), @@ -2587,14 +2522,20 @@ prune_keys(Map1, Map2, Deps) -> enter_type(Key, Val, Map) when is_integer(Key) -> ?debug("Entering ~s :: ~s\n", [format_type(t_var(Key)), format_type(Val)]), - case t_is_any(Val) of + %% Keep any() in the map if it is opaque: + case is_equal(Val, t_any()) of true -> erase_type(Key, Map); false -> LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT), + [?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) || + not is_equal(LimitedVal, Val)], case dict:find(Key, Map) of - {ok, LimitedVal} -> Map; - {ok, _} -> map_store(Key, LimitedVal, Map); + {ok, Value} -> + case is_equal(Value, LimitedVal) of + true -> Map; + false -> map_store(Key, LimitedVal, Map) + end; error -> map_store(Key, LimitedVal, Map) end end; @@ -2681,7 +2622,10 @@ updated_vars_only(U, OldMap, NewMap) -> [V || V <- U, not is_same(V, OldMap, NewMap)]. is_same(Key, Map1, Map2) -> - t_is_equal(lookup_type(Key, Map1), lookup_type(Key, Map2)). + is_equal(lookup_type(Key, Map1), lookup_type(Key, Map2)). + +is_equal(Type1, Type2) -> + t_is_equal(Type1, Type2). pp_map(_S, _Map) -> ?debug("\t~s: ~p\n", @@ -2716,11 +2660,6 @@ new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> state__set_rec_dict(State, RecDict) -> State#state{records = RecDict}. -state__set_opaques(#state{records = RecDict} = State, {M, _F, _A}) -> - Opaques = - erl_types:module_builtin_opaques(M) ++ t_opaque_from_records(RecDict), - State#state{opaques = Opaques, module = M}. - state__set_in_match(State, Bool) -> State#state{in_match = Bool}. @@ -2760,7 +2699,8 @@ state__lookup_undef_var(Tree, #state{callgraph = CG, plt = Plt}) -> {ok, MFA} -> case dialyzer_plt:lookup(Plt, MFA) of none -> error; - {value, {RetType, ArgTypes}} -> {ok, t_fun(ArgTypes, RetType)} + {value, {RetType, ArgTypes}} -> + {ok, t_fun(ArgTypes, RetType)} end end. @@ -2897,7 +2837,7 @@ state__get_cs(Var, #state{cmap = {d, Dict}}) -> dict:fetch(Var, Dict). state__is_self_rec(Fun, #state{self_rec = SelfRec}) -> - Fun =:= SelfRec. + not (SelfRec =:= 'false') andalso is_equal(Fun, SelfRec). state__store_funs(Vars0, Funs0, #state{fun_map = Map} = State) -> debug_make_name_map(Vars0, Funs0), @@ -2923,7 +2863,9 @@ state__finalize(State) -> %% %% ============================================================================ --spec mk_constraint(erl_types:erl_type(), constr_op(), fvar_or_type()) -> #constraint{}. +-spec mk_constraint(erl_types:erl_type(), + constr_op(), + fvar_or_type()) -> #constraint{}. mk_constraint(Lhs, Op, Rhs) -> case t_is_any(Lhs) orelse constraint_opnd_is_any(Rhs) of @@ -2934,9 +2876,9 @@ mk_constraint(Lhs, Op, Rhs) -> case Deps =:= [] of true -> %% This constraint is constant. Solve it immediately. - case solve_one_c(C, map_new(), []) of + case solve_one_c(C, map_new()) of error -> throw(error); - _ -> + _R -> %% This is always true, keep it anyway for logistic reasons C end; @@ -2944,10 +2886,13 @@ mk_constraint(Lhs, Op, Rhs) -> C end; true -> - C = mk_constraint_1(t_any(), Op, t_any()), - C#constraint{deps = []} + mk_constraint_any(Op) end. +mk_constraint_any(Op) -> + C = mk_constraint_1(t_any(), Op, t_any()), + C#constraint{deps = []}. + %% the following function is used so that we do not call %% erl_types:t_is_any/1 with a term other than an erl_type() -spec constraint_opnd_is_any(fvar_or_type()) -> boolean(). @@ -3002,7 +2947,8 @@ mk_constraint_1(Lhs, Op, Rhs) -> #constraint{lhs = Lhs, op = Op, rhs = Rhs}. mk_constraints([Lhs|LhsTail], Op, [Rhs|RhsTail]) -> - [mk_constraint(Lhs, Op, Rhs)|mk_constraints(LhsTail, Op, RhsTail)]; + [mk_constraint(Lhs, Op, Rhs) | + mk_constraints(LhsTail, Op, RhsTail)]; mk_constraints([], _Op, []) -> []. @@ -3017,7 +2963,7 @@ mk_constraint_list(Type, List) -> Deps = calculate_deps(List2), case Deps =:= [] of true -> #constraint_list{type = conj, - list = [mk_constraint(t_any(), eq, t_any())], + list = [mk_constraint_any(eq)], deps = []}; false -> #constraint_list{type = Type, list = List2, deps = Deps} end. @@ -3236,6 +3182,9 @@ calculate_masks([], _I, L) -> %% %% ============================================================================ +bif_return(M, F, A, Xs) -> + erl_bif_types:type(M, F, A, Xs). + is_singleton_non_number_type(Type) -> case t_is_number(Type) of true -> false; @@ -3265,7 +3214,7 @@ is_singleton_type(Type) -> find_element(Args, Cs) -> [Pos, Tuple] = Args, - case erl_types:t_is_number(Pos) of + case t_is_number(Pos) of true -> case erl_types:t_number_vals(Pos) of 'unknown' -> 'unknown'; @@ -3301,8 +3250,10 @@ find_constraint(Tuple, [_|Cs]) -> lookup_record(Records, Tag, Arity) -> case erl_types:lookup_record(Tag, Arity, Records) of {ok, Fields} -> - {ok, t_tuple([t_from_term(Tag)| - [FieldType || {_FieldName, FieldType} <- Fields]])}; + RecType = + t_tuple([t_from_term(Tag)| + [FieldType || {_FieldName, FieldType} <- Fields]]), + {ok, RecType}; error -> error end. diff --git a/lib/dialyzer/test/Makefile b/lib/dialyzer/test/Makefile index 9f8a3f1194..27cabc8ef8 100644 --- a/lib/dialyzer/test/Makefile +++ b/lib/dialyzer/test/Makefile @@ -7,6 +7,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk AUXILIARY_FILES=\ dialyzer.spec\ + dialyzer.cover\ dialyzer_test_constants.hrl\ dialyzer_common.erl\ file_utils.erl\ diff --git a/lib/dialyzer/test/dialyzer.cover b/lib/dialyzer/test/dialyzer.cover new file mode 100644 index 0000000000..cc61ea1901 --- /dev/null +++ b/lib/dialyzer/test/dialyzer.cover @@ -0,0 +1,3 @@ +%% -*- erlang -*- +{incl_app,dialyzer,details}. +%{incl_mods,dialyzer,[erl_types,erl_bif_types]}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 1ddae5149f..69bdc00257 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,6 +1,6 @@ crash_1.erl:45: Record construction #targetlist{list::[]} violates the declared type of field list::'undefined' | crash_1:target() -crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +crash_1.erl:48: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::'undefined' | crash_1:target()) will never return since it differs in the 2nd argument from the success typing arguments: (any(),maybe_improper_list()) crash_1.erl:50: The pattern <_Branch, []> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> crash_1.erl:52: The pattern <Branch, [H = {'target', _, _} | _T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> crash_1.erl:54: The pattern <Branch, [{'target', _, _} | T]> can never match the type <maybe_improper_list(),'undefined' | crash_1:target()> diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/ets b/lib/dialyzer/test/opaque_SUITE_data/results/ets index 5498ba1538..e79696bc30 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/ets +++ b/lib/dialyzer/test/opaque_SUITE_data/results/ets @@ -1,3 +1,4 @@ ets_use.erl:12: Guard test is_integer(T::atom() | tid()) breaks the opaqueness of its argument +ets_use.erl:20: The type test is_integer(atom() | tid()) breaks the opaqueness of the term atom() | tid() ets_use.erl:7: Guard test is_integer(T::tid()) breaks the opaqueness of its argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/ewgi b/lib/dialyzer/test/opaque_SUITE_data/results/ewgi index 3c8cfb59f8..5bc6b87fbb 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/ewgi +++ b/lib/dialyzer/test/opaque_SUITE_data/results/ewgi @@ -1,4 +1,4 @@ ewgi_api.erl:55: The call gb_trees:to_list({non_neg_integer(),'nil' | {_,_,_,_}}) does not have an opaque term of type gb_tree() as 1st argument -ewgi_testapp.erl:35: The call ewgi_testapp:htmlise_data("request_data",{non_neg_integer(),'nil' | {_,_,_,_}}) will never return since it differs in the 2nd argument from the success typing arguments: ([95 | 97 | 100 | 101 | 104 | 112 | 113 | 114 | 115 | 116 | 117,...],[{_,_}]) +ewgi_testapp.erl:35: The call ewgi_testapp:htmlise_data("request_data",{non_neg_integer(),'nil' | {_,_,_,_}}) does not have a term of type [{_,_}] | gb_tree() (with opaque subterms) as 2nd argument ewgi_testapp.erl:43: The call gb_trees:to_list(T::{non_neg_integer(),'nil' | {_,_,_,_}}) does not have an opaque term of type gb_tree() as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 index eb8f304905..4fe5fcfe2d 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 +++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 @@ -2,4 +2,4 @@ inf_loop1.erl:119: The pattern [{_, LNorms}] can never match the type [] inf_loop1.erl:121: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type [] inf_loop1.erl:129: The pattern [{_, Norm} | _] can never match the type [] -inf_loop1.erl:71: The call gb_trees:get(Edge::any(),Etab::array()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +inf_loop1.erl:71: The call gb_trees:get(Edge::any(),Etab::array()) does not have an opaque term of type gb_tree() as 2nd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 new file mode 100644 index 0000000000..4f0b79eb35 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 @@ -0,0 +1,5 @@ + +inf_loop2.erl:122: The pattern [{_, LNorms}] can never match the type [] +inf_loop2.erl:124: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type [] +inf_loop2.erl:132: The pattern [{_, Norm} | _] can never match the type [] +inf_loop2.erl:74: The call gb_trees:get(Edge::any(),Etab::array()) does not have an opaque term of type gb_tree() as 2nd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/int b/lib/dialyzer/test/opaque_SUITE_data/results/int index 3ee4def34b..dc806fa12c 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/int +++ b/lib/dialyzer/test/opaque_SUITE_data/results/int @@ -1,3 +1,3 @@ -int_adt.erl:28: Invalid type specification for function int_adt:add_f/2. The success typing is (number(),float()) -> number() -int_adt.erl:32: Invalid type specification for function int_adt:div_f/2. The success typing is (number(),number()) -> float() +int_adt.erl:28: Invalid type specification for function int_adt:add_f/2. The success typing is (number() | int_adt:int(),float()) -> number() | int_adt:int() +int_adt.erl:32: Invalid type specification for function int_adt:div_f/2. The success typing is (number() | int_adt:int(),number() | int_adt:int()) -> float() diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque index ab850b613e..0363be544d 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque +++ b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque @@ -1,2 +1,2 @@ -mixed_opaque_use.erl:31: The call mixed_opaque_rec_adt:get_a(Q::mixed_opaque_queue_adt:my_queue()) contains an opaque term as 1st argument when an opaque term of type mixed_opaque_rec_adt:rec() is expected +mixed_opaque_use.erl:31: The call mixed_opaque_rec_adt:get_a(Q::mixed_opaque_queue_adt:my_queue()) does not have an opaque term of type mixed_opaque_rec_adt:rec() as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/modules b/lib/dialyzer/test/opaque_SUITE_data/results/modules new file mode 100644 index 0000000000..f71334b9de --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/modules @@ -0,0 +1,3 @@ + +opaque_digraph.erl:353: Cons will produce an improper list since its 2nd argument is number() +opaque_digraph.erl:365: Cons will produce an improper list since its 2nd argument is number() diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue index 2860b91084..1f25a6f9c3 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue +++ b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue @@ -4,4 +4,4 @@ my_queue_use.erl:19: The call my_queue_adt:add(42,Q0::[]) does not have an opaqu my_queue_use.erl:24: The attempt to match a term of type my_queue_adt:my_queue() against the pattern [42 | Q2] breaks the opaqueness of the term my_queue_use.erl:30: Attempt to test for equality between a term of type [] and a term of opaque type my_queue_adt:my_queue() my_queue_use.erl:34: Cons will produce an improper list since its 2nd argument is my_queue_adt:my_queue() -my_queue_use.erl:34: The call my_queue_adt:dequeue(nonempty_improper_list(42,my_queue_adt:my_queue())) does not have an opaque term of type my_queue_adt:my_queue() as 1st argument +my_queue_use.erl:34: The call my_queue_adt:dequeue(nonempty_maybe_improper_list(42,my_queue_adt:my_queue())) does not have an opaque term of type my_queue_adt:my_queue() as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/opaque b/lib/dialyzer/test/opaque_SUITE_data/results/opaque index ca76f57b54..5747f9061f 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/opaque +++ b/lib/dialyzer/test/opaque_SUITE_data/results/opaque @@ -1,2 +1,3 @@ +opaque_bug3.erl:19: The pattern 'a' can never match the type #c{} opaque_bug4.erl:20: The attempt to match a term of type opaque_adt:abc() against the pattern 'a' breaks the opaqueness of the term diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/queue b/lib/dialyzer/test/opaque_SUITE_data/results/queue index c3f04ea64d..59ce33f098 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/queue +++ b/lib/dialyzer/test/opaque_SUITE_data/results/queue @@ -5,7 +5,6 @@ queue_use.erl:27: The attempt to match a term of type queue() against the patter queue_use.erl:33: Attempt to test for equality between a term of type {[42,...],[]} and a term of opaque type queue() queue_use.erl:36: The attempt to match a term of type queue() against the pattern {F, _R} breaks the opaqueness of the term queue_use.erl:40: The call queue:out({[42,...],[]}) does not have an opaque term of type queue() as 1st argument -queue_use.erl:48: The call queue_use:add_unique(42,#db{p::[],q::queue()}) contains an opaque term as 2nd argument when terms of different types are expected in these positions queue_use.erl:51: The call queue_use:is_in_queue(E::42,DB::#db{p::[],q::queue()}) contains an opaque term as 2nd argument when terms of different types are expected in these positions queue_use.erl:56: The attempt to match a term of type #db{p::[],q::queue()} against the pattern {'db', _, {L1, L2}} breaks the opaqueness of queue() queue_use.erl:62: The call queue_use:tuple_queue({42,'gazonk'}) does not have a term of type {_,queue()} (with opaque subterms) as 1st argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple new file mode 100644 index 0000000000..f55b384cbe --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -0,0 +1,87 @@ + +exact_api.erl:17: The call exact_api:set_type(A::#digraph{vtab::'notable',etab::'notable',ntab::'notable',cyclic::'true'}) does not have an opaque term of type digraph() as 1st argument +exact_api.erl:23: The call digraph:delete(G::#digraph{vtab::'notable',etab::'notable',ntab::'notable',cyclic::'true'}) does not have an opaque term of type digraph() as 1st argument +exact_api.erl:55: The attempt to match a term of type exact_adt:exact_adt() against the pattern {'exact_adt'} breaks the opaqueness of the term +exact_api.erl:59: The call exact_adt:exact_adt_set_type2(A::#exact_adt{}) does not have an opaque term of type exact_adt:exact_adt() as 1st argument +is_rec.erl:10: The call erlang:is_record(simple1_adt:d1(),'r',2) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:15: The call erlang:is_record(A::simple1_adt:d1(),'r',I::1 | 2 | 3) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:19: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opaqueness of its argument +is_rec.erl:23: Guard test is_record({simple1_adt:d1(),1},'r',2) breaks the opaqueness of its argument +is_rec.erl:41: The call erlang:is_record(A::simple1_adt:d1(),R::'a') contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:45: The call erlang:is_record(A::simple1_adt:d1(),A::simple1_adt:d1(),1) contains an opaque term as 2nd argument when terms of different types are expected in these positions +is_rec.erl:49: The call erlang:is_record(A::simple1_adt:d1(),any(),1) contains an opaque term as 1st argument when terms of different types are expected in these positions +is_rec.erl:53: The call erlang:is_record(A::simple1_adt:d1(),A::simple1_adt:d1(),any()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +is_rec.erl:57: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opaqueness of its argument +is_rec.erl:61: The record #r{f1::simple1_adt:d1()} violates the declared type for #r{} +is_rec.erl:65: The call erlang:is_record({simple1_adt:d1(),1},'r',2) contains an opaque term as 1st argument when terms of different types are expected in these positions +rec_api.erl:22: Record construction #r1{f1::10} violates the declared type of field f1::'undefined' | rec_api:a() +rec_api.erl:23: The pattern {'r1', 10} violates the declared type for #r1{} +rec_api.erl:27: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opaqueness of the term +rec_api.erl:29: Invalid type specification for function rec_api:adt_t1/1. The success typing is (#r1{f1::'a'}) -> #r1{f1::'a'} +rec_api.erl:34: Invalid type specification for function rec_api:adt_r1/0. The success typing is () -> #r1{f1::'a'} +rec_api.erl:77: The attempt to match a term of type rec_api:f() against the variable _ breaks the opaqueness of the term +simple1_api.erl:113: The test simple1_api:d1() =:= simple1_api:d2() can never evaluate to 'true' +simple1_api.erl:118: Guard test simple1_api:d2() =:= A::simple1_api:d1() can never succeed +simple1_api.erl:142: Attempt to test for equality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1() +simple1_api.erl:148: Guard test simple1_adt:o2() =:= A::simple1_adt:o1() contains an opaque term as 1st argument +simple1_api.erl:154: Attempt to test for inequality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1() +simple1_api.erl:160: Attempt to test for inequality between a term of type simple1_adt:o2() and a term of opaque type simple1_adt:o1() +simple1_api.erl:165: Attempt to test for equality between a term of type simple1_adt:c2() and a term of opaque type simple1_adt:c1() +simple1_api.erl:181: Guard test A::simple1_adt:d1() =< B::simple1_adt:d2() contains an opaque term as 1st argument +simple1_api.erl:185: Guard test 'a' =< B::simple1_adt:d2() contains an opaque term as 2nd argument +simple1_api.erl:189: Guard test A::simple1_adt:d1() =< 'd' contains an opaque term as 1st argument +simple1_api.erl:197: The type test is_integer(A::simple1_adt:d1()) breaks the opaqueness of the term A::simple1_adt:d1() +simple1_api.erl:221: Guard test A::simple1_api:i1() > 3 can never succeed +simple1_api.erl:225: Guard test A::simple1_adt:i1() > 3 contains an opaque term as 1st argument +simple1_api.erl:233: Guard test A::simple1_adt:i1() < 3 contains an opaque term as 1st argument +simple1_api.erl:239: Guard test A::1 > 3 can never succeed +simple1_api.erl:243: Guard test A::1 > 3 can never succeed +simple1_api.erl:257: Guard test is_function(T::simple1_api:o1()) can never succeed +simple1_api.erl:265: Guard test is_function(T::simple1_adt:o1()) breaks the opaqueness of its argument +simple1_api.erl:269: The type test is_function(T::simple1_adt:o1()) breaks the opaqueness of the term T::simple1_adt:o1() +simple1_api.erl:274: Guard test is_function(T::simple1_api:o1(),A::simple1_api:i1()) can never succeed +simple1_api.erl:284: Guard test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opaqueness of its argument +simple1_api.erl:289: The type test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opaqueness of the term T::simple1_adt:o1() +simple1_api.erl:294: The call erlang:is_function(T::simple1_api:o1(),A::simple1_adt:i1()) contains an opaque term as 2nd argument when terms of different types are expected in these positions +simple1_api.erl:300: The type test is_function(T::simple1_adt:o1(),A::simple1_api:i1()) breaks the opaqueness of the term T::simple1_adt:o1() +simple1_api.erl:306: Guard test B::simple1_api:b2() =:= 'true' can never succeed +simple1_api.erl:315: Guard test A::simple1_api:b1() =:= 'false' can never succeed +simple1_api.erl:319: Guard test not('and'('true','true')) can never succeed +simple1_api.erl:337: Clause guard cannot succeed. +simple1_api.erl:342: Guard test B::simple1_adt:b2() =:= 'true' contains an opaque term as 1st argument +simple1_api.erl:347: Guard test A::simple1_adt:b1() =:= 'true' contains an opaque term as 1st argument +simple1_api.erl:355: Invalid type specification for function simple1_api:bool_adt_t6/1. The success typing is ('true') -> 1 +simple1_api.erl:365: Clause guard cannot succeed. +simple1_api.erl:368: Invalid type specification for function simple1_api:bool_adt_t8/2. The success typing is (boolean(),boolean()) -> 1 +simple1_api.erl:378: Clause guard cannot succeed. +simple1_api.erl:381: Invalid type specification for function simple1_api:bool_adt_t9/2. The success typing is ('false','false') -> 1 +simple1_api.erl:407: The size simple1_adt:i1() breaks the opaqueness of A +simple1_api.erl:418: The attempt to match a term of type non_neg_integer() against the variable A breaks the opaqueness of simple1_adt:i1() +simple1_api.erl:425: The attempt to match a term of type non_neg_integer() against the variable B breaks the opaqueness of simple1_adt:i1() +simple1_api.erl:432: The attempt to match a term of type non_neg_integer() against the variable B breaks the opaqueness of simple1_api:o1() +simple1_api.erl:448: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opaqueness of simple1_adt:i1() +simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary-unit:8>> breaks the opaqueness of the term +simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a() +simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a() +simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() +simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() +simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i() +simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i() +simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains an opaque term as 1st argument +simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument +simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument +simple1_api.erl:538: Guard test A::simple1_adt:d1() =:= 3 contains an opaque term as 1st argument +simple1_api.erl:548: The call erlang:'<'(A::simple1_adt:d1(),3) contains an opaque term as 1st argument when terms of different types are expected in these positions +simple1_api.erl:558: The call erlang:'=<'(A::simple1_adt:d1(),B::simple1_adt:d2()) contains an opaque term as 1st argument when terms of different types are expected in these positions +simple1_api.erl:565: Guard test {digraph(),3} > {digraph(),atom() | tid()} contains an opaque term as 2nd argument +simple1_api.erl:91: Invalid type specification for function simple1_api:tup/0. The success typing is () -> {'a','b'} +simple2_api.erl:100: The call lists:flatten(A::simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type [any()] is expected +simple2_api.erl:116: The call lists:flatten({simple1_adt:tuple1()}) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +simple2_api.erl:121: Guard test {simple1_adt:d1(),3} > {simple1_adt:d1(),simple1_adt:tuple1()} contains an opaque term as 2nd argument +simple2_api.erl:125: The call erlang:tuple_to_list(B::simple1_adt:tuple1()) contains an opaque term as 1st argument when a structured term of type tuple() is expected +simple2_api.erl:31: The call erlang:'!'(A::simple1_adt:d1(),'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:35: The call erlang:send(A::simple1_adt:d1(),'foo') contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:51: The call erlang:'<'(A::simple1_adt:d1(),3) contains an opaque term as 1st argument when terms of different types are expected in these positions +simple2_api.erl:59: The call lists:keysearch(1,A::simple1_adt:d1(),[]) contains an opaque term as 2nd argument when terms of different types are expected in these positions +simple2_api.erl:67: The call lists:keysearch('key',1,A::simple1_adt:tuple1()) contains an opaque term as 3rd argument when terms of different types are expected in these positions +simple2_api.erl:96: The call lists:keyreplace('a',1,[{1, 2}],A::simple1_adt:tuple1()) contains an opaque term as 4th argument when terms of different types are expected in these positions diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/wings b/lib/dialyzer/test/opaque_SUITE_data/results/wings index a9571441f8..0ca91ae331 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/wings +++ b/lib/dialyzer/test/opaque_SUITE_data/results/wings @@ -4,7 +4,7 @@ wings_dissolve.erl:19: Guard test is_list(Faces::gb_set()) breaks the opaqueness wings_dissolve.erl:272: Guard test is_list(Faces::gb_set()) breaks the opaqueness of its argument wings_dissolve.erl:31: The call gb_sets:is_empty(Faces::[any(),...]) does not have an opaque term of type gb_set() as 1st argument wings_edge.erl:205: The pattern <Edge, 'hard', Htab> can never match the type <_,'soft',_> -wings_edge_cmd.erl:30: The call gb_trees:size(P::gb_set()) contains an opaque term as 1st argument when an opaque term of type gb_tree() is expected +wings_edge_cmd.erl:30: The call gb_trees:size(P::gb_set()) does not have an opaque term of type gb_tree() as 1st argument wings_edge_cmd.erl:32: The pattern [_ | Parts] can never match the type [] wings_edge_cmd.erl:32: The pattern [{_, P} | _] can never match the type [] wings_io.erl:30: The attempt to match a term of type {'empty',queue()} against the pattern {'empty', {In, Out}} breaks the opaqueness of queue() diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl index d65af0af4e..4eb202f16a 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/ets/ets_use.erl @@ -1,5 +1,5 @@ -module(ets_use). --export([t1/0, t2/0]). +-export([t1/0, t2/0, t3/0, t4/0]). t1() -> case n() of @@ -13,4 +13,10 @@ t2() -> T when is_atom(T) -> atm end. -n() -> ets:new(n, [named_table]). +t3() -> + is_atom(n()). % no warning since atom() is possible + +t4() -> + is_integer(n()). % opaque warning since tid() is opaque + +n() -> ets:new(n, [named_table]). % -> atom() | tid() diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl new file mode 100644 index 0000000000..659ccaf015 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/inf_loop2.erl @@ -0,0 +1,175 @@ +%% -*- erlang-indent-level: 2 -*- +%%---------------------------------------------------------------------------- +%% Copy of inf_loop1.erl, where the calls mentioned below have been +%% restored. + +%% Non-sensical (i.e., stripped-down) program that sends the analysis +%% into an infinite loop. The #we.es field was originally a gb_tree() +%% but the programmer declared it as an array in order to change it to +%% that data type instead. In the file, there are two calls to function +%% gb_trees:get/2 which seem to be the ones responsible for sending the +%% analysis into an infinite loop. Currently, these calls are marked and +%% have been changed to gbee_trees:get/2 in order to be able to see that +%% the analysis works if these two calls are taken out of the picture. +%%---------------------------------------------------------------------------- +-module(inf_loop2). + +-export([command/1]). + +-record(we, {id, + es = array:new() :: array(), + vp, + mirror = none}). +-record(edge, {vs,ve,a = none,b = none,lf,rf,ltpr,ltsu,rtpr,rtsu}). + +command(St) -> + State = drag_mode(offset_region), + SetupSt = wings_sel_conv:more(St), + Tvs = wings_sel:fold(fun(Faces, #we{id = Id} = We, Acc) -> + FaceRegions = wings_sel:face_regions(Faces, We), + {AllVs0,VsData} = + collect_offset_regions_data(FaceRegions, We, [], []), + AllVs = ordsets:from_list(AllVs0), + [{Id,{AllVs,offset_regions_fun(VsData, State)}}|Acc] + end, + [], + SetupSt), + wings_drag:setup(Tvs, 42, [], St). + +drag_mode(Type) -> + {Mode,Norm} = wings_pref:get_value(Type, {average,loop}), + {Type,Mode,Norm}. + +collect_offset_regions_data([Faces|Regions], We, AllVs, VsData) -> + {FaceNormTab,OuterEdges,RegVs} = + some_fake_module:faces_data_0(Faces, We, [], [], []), + {LoopNorm,LoopVsData,LoopVs} = + offset_regions_loop_data(OuterEdges, Faces, We, FaceNormTab), + Vs = RegVs -- LoopVs, + RegVsData = vertex_normals(Vs, FaceNormTab, We, LoopVsData), + collect_offset_regions_data(Regions, We, RegVs ++ AllVs, + [{LoopNorm,RegVsData}|VsData]); +collect_offset_regions_data([], _, AllVs, VsData) -> + {AllVs,VsData}. + +offset_regions_loop_data(Edges, Faces, We, FNtab) -> + EdgeSet = gb_sets:from_list(Edges), + offset_loop_data_0(EdgeSet, Faces, We, FNtab, [], [], []). + +offset_loop_data_0(EdgeSet0, Faces, We, FNtab, LNorms, VData0, Vs0) -> + case gb_sets:is_empty(EdgeSet0) of + false -> + {Edge,EdgeSet1} = gb_sets:take_smallest(EdgeSet0), + {EdgeSet,VData,Links,LoopNorm,Vs} = + offset_loop_data_1(Edge, EdgeSet1, Faces, We, FNtab, VData0, Vs0), + offset_loop_data_0(EdgeSet, Faces, We, FNtab, + [{Links,LoopNorm}|LNorms], VData, Vs); + true -> + AvgLoopNorm = average_loop_norm(LNorms), + {AvgLoopNorm,VData0,Vs0} + end. + +offset_loop_data_1(Edge, EdgeSet, _Faces, + #we{es = Etab, vp = Vtab} = We, FNtab, VData, Vs) -> + #edge{vs = Va, ve = Vb, lf = Lf, ltsu = NextLeft} = gb_trees:get(Edge, Etab), + VposA = gb_trees:get(Va, Vtab), + VposB = gb_trees:get(Vb, Vtab), + VDir = e3d_vec:sub(VposB, VposA), + FNorm = wings_face:normal(Lf, We), + EdgeData = gb_trees:get(NextLeft, Etab), + offset_loop_data_2(NextLeft, EdgeData, Va, VposA, Lf, Edge, We, FNtab, + EdgeSet, VDir, [], [FNorm], VData, [], Vs, 0). + +offset_loop_data_2(CurE, #edge{vs = Va, ve = Vb, lf = PrevFace, + rtsu = NextEdge, ltsu = IfCurIsMember}, + Vb, VposB, PrevFace, LastE, + #we{mirror = M} = We, + FNtab, EdgeSet0, VDir, EDir0, VNorms0, VData0, VPs0, Vs0, + Links) -> + Mirror = M == PrevFace, + offset_loop_is_member(Mirror, Vb, Va, VposB, CurE, IfCurIsMember, VNorms0, + NextEdge, EdgeSet0, VDir, EDir0, FNtab, PrevFace, + LastE, We, VData0, VPs0, Vs0, Links). + +offset_loop_is_member(Mirror, V1, V2, Vpos1, CurE, NextE, VNorms0, NEdge, + EdgeSet0, VDir, EDir0, FNtab, PFace, LastE, We, + VData0, VPs0, Vs0, Links) -> + #we{es = Etab, vp = Vtab} = We, + Vpos2 = gb_trees:get(V2, Vtab), + Dir = e3d_vec:sub(Vpos2, Vpos1), + NextVDir = e3d_vec:neg(Dir), + EdgeSet = gb_sets:delete(CurE, EdgeSet0), + EdgeData = gb_trees:get(NextE, Etab), %% HERE + [FNorm|_] = VNorms0, + VData = offset_loop_data_3(Mirror, V1, Vpos1, VNorms0, NEdge, VDir, + Dir, EDir0, FNtab, We, VData0), + VPs = [Vpos1|VPs0], + Vs = [V1|Vs0], + offset_loop_data_2(NextE, EdgeData, V2, Vpos2, PFace, LastE, We, FNtab, + EdgeSet, NextVDir, [], [FNorm], VData, VPs, Vs, Links + 1). + +offset_loop_data_3(false, V, Vpos, VNorms0, NextEdge, + VDir, Dir, EDir0, FNtab, We, VData0) -> + #we{es = Etab} = We, + VNorm = e3d_vec:norm(e3d_vec:add(VNorms0)), + NV = wings_vertex:other(V, gb_trees:get(NextEdge, Etab)), %% HERE + ANorm = vertex_normal(NV, FNtab, We), + EDir = some_fake_module:average_edge_dir(VNorm, VDir, Dir, EDir0), + AvgDir = some_fake_module:evaluate_vdata(VDir, Dir, VNorm), + ScaledDir = some_fake_module:along_edge_scale_factor(VDir, Dir, EDir, ANorm), + [{V,{Vpos,AvgDir,EDir,ScaledDir}}|VData0]. + +average_loop_norm([{_,LNorms}]) -> + e3d_vec:norm(LNorms); +average_loop_norm([{LinksA,LNormA},{LinksB,LNormB}]) -> + case LinksA < LinksB of + true -> + e3d_vec:norm(e3d_vec:add(e3d_vec:neg(LNormA), LNormB)); + false -> + e3d_vec:norm(e3d_vec:add(e3d_vec:neg(LNormB), LNormA)) + end; +average_loop_norm(LNorms) -> + LoopNorms = [Norm || {_,Norm} <- LNorms], + e3d_vec:norm(e3d_vec:neg(e3d_vec:add(LoopNorms))). + +vertex_normals([V|Vs], FaceNormTab, #we{vp = Vtab, mirror = M} = We, Acc) -> + FaceNorms = + wings_vertex:fold(fun(_, Face, _, A) when Face == M -> + [e3d_vec:neg(wings_face:normal(M, We))|A]; + (_, Face, _, A) -> + [gb_trees:get(Face, FaceNormTab)|A] + end, [], V, We), + VNorm = e3d_vec:norm(e3d_vec:add(FaceNorms)), + Vpos = gb_trees:get(V, Vtab), + vertex_normals(Vs, FaceNormTab, We, [{V,{Vpos,VNorm}}|Acc]); +vertex_normals([], _, _, Acc) -> + Acc. + +vertex_normal(V, FaceNormTab, #we{mirror = M} = We) -> + wings_vertex:fold(fun(_, Face, _, A) when Face == M -> + [e3d_vec:neg(wings_face:normal(Face, We))|A]; + (_, Face, _, A) -> + N = gb_trees:get(Face, FaceNormTab), + case e3d_vec:is_zero(N) of + true -> A; + false -> [N|A] + end + end, [], V, We). + +offset_regions_fun(OffsetData, {_,Solution,_} = State) -> + fun(new_mode_data, {NewState,_}) -> + offset_regions_fun(OffsetData, NewState); + ([Dist,_,_,Bump|_], A) -> + lists:foldl(fun({LoopNormal,VsData}, VsAcc0) -> + lists:foldl(fun({V,{Vpos0,VNorm}}, VsAcc) -> + [{V,Vpos0}|VsAcc]; + ({V,{Vpos0,Dir,EDir,ScaledEDir}}, VsAcc) -> + Vec = case Solution of + average -> Dir; + along_edges -> EDir; + scaled -> ScaledEDir + end, + [{V,Vpos0}|VsAcc] + end, VsAcc0, VsData) + end, A, OffsetData) + end. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl new file mode 100644 index 0000000000..09d4229e28 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_digraph.erl @@ -0,0 +1,655 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%% The Erlang scanner. All types are opaque, which puts some stress +%%% on Dialyzer. + +-module(opaque_digraph). + +-export([new/0, new/1, delete/1, info/1]). + +-export([add_vertex/1, add_vertex/2, add_vertex/3]). +-export([del_vertex/2, del_vertices/2]). +-export([vertex/2, no_vertices/1, vertices/1]). +-export([source_vertices/1, sink_vertices/1]). + +-export([add_edge/3, add_edge/4, add_edge/5]). +-export([del_edge/2, del_edges/2, del_path/3]). +-export([edge/2, no_edges/1, edges/1]). + +-export([out_neighbours/2, in_neighbours/2]). +-export([out_edges/2, in_edges/2, edges/2]). +-export([out_degree/2, in_degree/2]). +-export([get_path/3, get_cycle/2]). + +-export([get_short_path/3, get_short_cycle/2]). + +-export_type([local_digraph/0, d_type/0, vertex/0]). + +-record(digraph, {vtab = notable :: ets:tab(), + etab = notable :: ets:tab(), + ntab = notable :: ets:tab(), + cyclic = true :: boolean()}). + +-opaque local_digraph() :: #digraph{}. + +-export_type([edge/0, label/0, add_edge_err_rsn/0, + d_protection/0, d_cyclicity/0]). + +-opaque edge() :: term(). +-opaque label() :: term(). +-opaque vertex() :: term(). + +-opaque add_edge_err_rsn() :: {'bad_edge', Path :: [vertex()]} + | {'bad_vertex', V :: vertex()}. + +%% +%% Type is a list of +%% protected | private +%% acyclic | cyclic +%% +%% default is [cyclic,protected] +%% +-opaque d_protection() :: 'private' | 'protected'. +-opaque d_cyclicity() :: 'acyclic' | 'cyclic'. +-opaque d_type() :: d_cyclicity() | d_protection(). + +-spec new() -> local_digraph(). + +new() -> new([]). + +-spec new(Type) -> local_digraph() when + Type :: [d_type()]. + +new(Type) -> + case check_type(Type, protected, []) of + {Access, Ts} -> + V = ets:new(vertices, [set, Access]), + E = ets:new(edges, [set, Access]), + N = ets:new(neighbours, [bag, Access]), + ets:insert(N, [{'$vid', 0}, {'$eid', 0}]), + set_type(Ts, #digraph{vtab=V, etab=E, ntab=N}); + error -> + erlang:error(badarg) + end. + +%% +%% Check type of graph +%% +%-spec check_type([d_type()], d_protection(), [{'cyclic', boolean()}]) -> +% {d_protection(), [{'cyclic', boolean()}]}. + +check_type([acyclic|Ts], A, L) -> + check_type(Ts, A,[{cyclic,false} | L]); +check_type([cyclic | Ts], A, L) -> + check_type(Ts, A, [{cyclic,true} | L]); +check_type([protected | Ts], _, L) -> + check_type(Ts, protected, L); +check_type([private | Ts], _, L) -> + check_type(Ts, private, L); +check_type([], A, L) -> {A, L}; +check_type(_, _, _) -> error. + +%% +%% Set graph type +%% +-spec set_type([{'cyclic', boolean()}], local_digraph()) -> local_digraph(). + +set_type([{cyclic,V} | Ks], G) -> + set_type(Ks, G#digraph{cyclic = V}); +set_type([], G) -> G. + + +%% Data access functions + +-spec delete(G) -> 'true' when + G :: local_digraph(). + +delete(G) -> + ets:delete(G#digraph.vtab), + ets:delete(G#digraph.etab), + ets:delete(G#digraph.ntab). + +-spec info(G) -> InfoList when + G :: local_digraph(), + InfoList :: [{'cyclicity', Cyclicity :: d_cyclicity()} | + {'memory', NoWords :: non_neg_integer()} | + {'protection', Protection :: d_protection()}]. + +info(G) -> + VT = G#digraph.vtab, + ET = G#digraph.etab, + NT = G#digraph.ntab, + Cyclicity = case G#digraph.cyclic of + true -> cyclic; + false -> acyclic + end, + Protection = ets:info(VT, protection), + Memory = ets:info(VT, memory) + ets:info(ET, memory) + ets:info(NT, memory), + [{cyclicity, Cyclicity}, {memory, Memory}, {protection, Protection}]. + +-spec add_vertex(G) -> vertex() when + G :: local_digraph(). + +add_vertex(G) -> + do_add_vertex({new_vertex_id(G), []}, G). + +-spec add_vertex(G, V) -> vertex() when + G :: local_digraph(), + V :: vertex(). + +add_vertex(G, V) -> + do_add_vertex({V, []}, G). + +-spec add_vertex(G, V, Label) -> vertex() when + G :: local_digraph(), + V :: vertex(), + Label :: label(). + +add_vertex(G, V, D) -> + do_add_vertex({V, D}, G). + +-spec del_vertex(G, V) -> 'true' when + G :: local_digraph(), + V :: vertex(). + +del_vertex(G, V) -> + do_del_vertex(V, G). + +-spec del_vertices(G, Vertices) -> 'true' when + G :: local_digraph(), + Vertices :: [vertex()]. + +del_vertices(G, Vs) -> + do_del_vertices(Vs, G). + +-spec vertex(G, V) -> {V, Label} | 'false' when + G :: local_digraph(), + V :: vertex(), + Label :: label(). + +vertex(G, V) -> + case ets:lookup(G#digraph.vtab, V) of + [] -> false; + [Vertex] -> Vertex + end. + +-spec no_vertices(G) -> non_neg_integer() when + G :: local_digraph(). + +no_vertices(G) -> + ets:info(G#digraph.vtab, size). + +-spec vertices(G) -> Vertices when + G :: local_digraph(), + Vertices :: [vertex()]. + +vertices(G) -> + ets:select(G#digraph.vtab, [{{'$1', '_'}, [], ['$1']}]). + +-spec source_vertices(local_digraph()) -> [vertex()]. + +source_vertices(G) -> + collect_vertices(G, in). + +-spec sink_vertices(local_digraph()) -> [vertex()]. + +sink_vertices(G) -> + collect_vertices(G, out). + +-spec in_degree(G, V) -> non_neg_integer() when + G :: local_digraph(), + V :: vertex(). + +in_degree(G, V) -> + length(ets:lookup(G#digraph.ntab, {in, V})). + +-spec in_neighbours(G, V) -> Vertex when + G :: local_digraph(), + V :: vertex(), + Vertex :: [vertex()]. + +in_neighbours(G, V) -> + ET = G#digraph.etab, + NT = G#digraph.ntab, + collect_elems(ets:lookup(NT, {in, V}), ET, 2). + +-spec in_edges(G, V) -> Edges when + G :: local_digraph(), + V :: vertex(), + Edges :: [edge()]. + +in_edges(G, V) -> + ets:select(G#digraph.ntab, [{{{in, V}, '$1'}, [], ['$1']}]). + +-spec out_degree(G, V) -> non_neg_integer() when + G :: local_digraph(), + V :: vertex(). + +out_degree(G, V) -> + length(ets:lookup(G#digraph.ntab, {out, V})). + +-spec out_neighbours(G, V) -> Vertices when + G :: local_digraph(), + V :: vertex(), + Vertices :: [vertex()]. + +out_neighbours(G, V) -> + ET = G#digraph.etab, + NT = G#digraph.ntab, + collect_elems(ets:lookup(NT, {out, V}), ET, 3). + +-spec out_edges(G, V) -> Edges when + G :: local_digraph(), + V :: vertex(), + Edges :: [edge()]. + +out_edges(G, V) -> + ets:select(G#digraph.ntab, [{{{out, V}, '$1'}, [], ['$1']}]). + +-spec add_edge(G, V1, V2) -> edge() | {'error', add_edge_err_rsn()} when + G :: local_digraph(), + V1 :: vertex(), + V2 :: vertex(). + +add_edge(G, V1, V2) -> + do_add_edge({new_edge_id(G), V1, V2, []}, G). + +-spec add_edge(G, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when + G :: local_digraph(), + V1 :: vertex(), + V2 :: vertex(), + Label :: label(). + +add_edge(G, V1, V2, D) -> + do_add_edge({new_edge_id(G), V1, V2, D}, G). + +-spec add_edge(G, E, V1, V2, Label) -> edge() | {'error', add_edge_err_rsn()} when + G :: local_digraph(), + E :: edge(), + V1 :: vertex(), + V2 :: vertex(), + Label :: label(). + +add_edge(G, E, V1, V2, D) -> + do_add_edge({E, V1, V2, D}, G). + +-spec del_edge(G, E) -> 'true' when + G :: local_digraph(), + E :: edge(). + +del_edge(G, E) -> + do_del_edges([E], G). + +-spec del_edges(G, Edges) -> 'true' when + G :: local_digraph(), + Edges :: [edge()]. + +del_edges(G, Es) -> + do_del_edges(Es, G). + +-spec no_edges(G) -> non_neg_integer() when + G :: local_digraph(). + +no_edges(G) -> + ets:info(G#digraph.etab, size). + +-spec edges(G) -> Edges when + G :: local_digraph(), + Edges :: [edge()]. + +edges(G) -> + ets:select(G#digraph.etab, [{{'$1', '_', '_', '_'}, [], ['$1']}]). + +-spec edges(G, V) -> Edges when + G :: local_digraph(), + V :: vertex(), + Edges :: [edge()]. + +edges(G, V) -> + ets:select(G#digraph.ntab, [{{{out, V},'$1'}, [], ['$1']}, + {{{in, V}, '$1'}, [], ['$1']}]). + +-spec edge(G, E) -> {E, V1, V2, Label} | 'false' when + G :: local_digraph(), + E :: edge(), + V1 :: vertex(), + V2 :: vertex(), + Label :: label(). + +edge(G, E) -> + case ets:lookup(G#digraph.etab,E) of + [] -> false; + [Edge] -> Edge + end. + +%% +%% Generate a "unique" edge identifier (relative to this graph) +%% +-spec new_edge_id(local_digraph()) -> edge(). + +new_edge_id(G) -> + NT = G#digraph.ntab, + [{'$eid', K}] = ets:lookup(NT, '$eid'), + true = ets:delete(NT, '$eid'), + true = ets:insert(NT, {'$eid', K+1}), + ['$e' | K]. + +%% +%% Generate a "unique" vertex identifier (relative to this graph) +%% +-spec new_vertex_id(local_digraph()) -> vertex(). + +new_vertex_id(G) -> + NT = G#digraph.ntab, + [{'$vid', K}] = ets:lookup(NT, '$vid'), + true = ets:delete(NT, '$vid'), + true = ets:insert(NT, {'$vid', K+1}), + ['$v' | K]. + +%% +%% Collect elements for a index in a tuple +%% +collect_elems(Keys, Table, Index) -> + collect_elems(Keys, Table, Index, []). + +collect_elems([{_,Key}|Keys], Table, Index, Acc) -> + collect_elems(Keys, Table, Index, + [ets:lookup_element(Table, Key, Index)|Acc]); +collect_elems([], _, _, Acc) -> Acc. + +-spec do_add_vertex({vertex(), label()}, local_digraph()) -> vertex(). + +do_add_vertex({V, _Label} = VL, G) -> + ets:insert(G#digraph.vtab, VL), + V. + +%% +%% Collect either source or sink vertices. +%% +collect_vertices(G, Type) -> + Vs = vertices(G), + lists:foldl(fun(V, A) -> + case ets:member(G#digraph.ntab, {Type, V}) of + true -> A; + false -> [V|A] + end + end, [], Vs). + +%% +%% Delete vertices +%% +do_del_vertices([V | Vs], G) -> + do_del_vertex(V, G), + do_del_vertices(Vs, G); +do_del_vertices([], #digraph{}) -> true. + +do_del_vertex(V, G) -> + do_del_nedges(ets:lookup(G#digraph.ntab, {in, V}), G), + do_del_nedges(ets:lookup(G#digraph.ntab, {out, V}), G), + ets:delete(G#digraph.vtab, V). + +do_del_nedges([{_, E}|Ns], G) -> + case ets:lookup(G#digraph.etab, E) of + [{E, V1, V2, _}] -> + do_del_edge(E, V1, V2, G), + do_del_nedges(Ns, G); + [] -> % cannot happen + do_del_nedges(Ns, G) + end; +do_del_nedges([], #digraph{}) -> true. + +%% +%% Delete edges +%% +do_del_edges([E|Es], G) -> + case ets:lookup(G#digraph.etab, E) of + [{E,V1,V2,_}] -> + do_del_edge(E,V1,V2,G), + do_del_edges(Es, G); + [] -> + do_del_edges(Es, G) + end; +do_del_edges([], #digraph{}) -> true. + +do_del_edge(E, V1, V2, G) -> + ets:select_delete(G#digraph.ntab, [{{{in, V2}, E}, [], [true]}, + {{{out,V1}, E}, [], [true]}]), + ets:delete(G#digraph.etab, E). + +-spec rm_edges([vertex(),...], local_digraph()) -> 'true'. + +rm_edges([V1, V2|Vs], G) -> + rm_edge(V1, V2, G), + rm_edges([V2|Vs], G); +rm_edges(_, _) -> true. + +-spec rm_edge(vertex(), vertex(), local_digraph()) -> 'ok'. + +rm_edge(V1, V2, G) -> + Es = out_edges(G, V1), + rm_edge_0(Es, V1, V2, G). + +rm_edge_0([E|Es], V1, V2, G) -> + case ets:lookup(G#digraph.etab, E) of + [{E, V1, V2, _}] -> + do_del_edge(E, V1, V2, G), + rm_edge_0(Es, V1, V2, G); + _ -> + rm_edge_0(Es, V1, V2, G) + end; +rm_edge_0([], _, _, #digraph{}) -> ok. + +%% +%% Check that endpoints exist +%% +-spec do_add_edge({edge(), vertex(), vertex(), label()}, local_digraph()) -> + edge() | {'error', add_edge_err_rsn()}. + +do_add_edge({E, V1, V2, Label}, G) -> + case ets:member(G#digraph.vtab, V1) of + false -> {error, {bad_vertex, V1}}; + true -> + case ets:member(G#digraph.vtab, V2) of + false -> {error, {bad_vertex, V2}}; + true -> + case other_edge_exists(G, E, V1, V2) of + true -> {error, {bad_edge, [V1, V2]}}; + false when G#digraph.cyclic =:= false -> + acyclic_add_edge(E, V1, V2, Label, G); + false -> + do_insert_edge(E, V1, V2, Label, G) + end + end + end. + +other_edge_exists(#digraph{etab = ET}, E, V1, V2) -> + case ets:lookup(ET, E) of + [{E, Vert1, Vert2, _}] when Vert1 =/= V1; Vert2 =/= V2 -> + true; + _ -> + false + end. + +-spec do_insert_edge(edge(), vertex(), vertex(), label(), local_digraph()) -> edge(). + +do_insert_edge(E, V1, V2, Label, #digraph{ntab=NT, etab=ET}) -> + ets:insert(NT, [{{out, V1}, E}, {{in, V2}, E}]), + ets:insert(ET, {E, V1, V2, Label}), + E. + +-spec acyclic_add_edge(edge(), vertex(), vertex(), label(), local_digraph()) -> + edge() | {'error', {'bad_edge', [vertex()]}}. + +acyclic_add_edge(_E, V1, V2, _L, _G) when V1 =:= V2 -> + {error, {bad_edge, [V1, V2]}}; +acyclic_add_edge(E, V1, V2, Label, G) -> + case get_path(G, V2, V1) of + false -> do_insert_edge(E, V1, V2, Label, G); + Path -> {error, {bad_edge, Path}} + end. + +%% +%% Delete all paths from vertex V1 to vertex V2 +%% + +-spec del_path(G, V1, V2) -> 'true' when + G :: local_digraph(), + V1 :: vertex(), + V2 :: vertex(). + +del_path(G, V1, V2) -> + case get_path(G, V1, V2) of + false -> true; + Path -> + rm_edges(Path, G), + del_path(G, V1, V2) + end. + +%% +%% Find a cycle through V +%% return the cycle as list of vertices [V ... V] +%% if no cycle exists false is returned +%% if only a cycle of length one exists it will be +%% returned as [V] but only after longer cycles have +%% been searched. +%% + +-spec get_cycle(G, V) -> Vertices | 'false' when + G :: local_digraph(), + V :: vertex(), + Vertices :: [vertex(),...]. + +get_cycle(G, V) -> + case one_path(out_neighbours(G, V), V, [], [V], [V], 2, G, 1) of + false -> + case lists:member(V, out_neighbours(G, V)) of + true -> [V]; + false -> false + end; + Vs -> Vs + end. + +%% +%% Find a path from V1 to V2 +%% return the path as list of vertices [V1 ... V2] +%% if no path exists false is returned +%% + +-spec get_path(G, V1, V2) -> Vertices | 'false' when + G :: local_digraph(), + V1 :: vertex(), + V2 :: vertex(), + Vertices :: [vertex(),...]. + +get_path(G, V1, V2) -> + one_path(out_neighbours(G, V1), V2, [], [V1], [V1], 1, G, 1). + +%% +%% prune_short_path (evaluate conditions on path) +%% short : if path is too short +%% ok : if path is ok +%% +prune_short_path(Counter, Min) when Counter < Min -> + short; +prune_short_path(_Counter, _Min) -> + ok. + +one_path([W|Ws], W, Cont, Xs, Ps, Prune, G, Counter) -> + case prune_short_path(Counter, Prune) of + short -> one_path(Ws, W, Cont, Xs, Ps, Prune, G, Counter); + ok -> lists:reverse([W|Ps]) + end; +one_path([V|Vs], W, Cont, Xs, Ps, Prune, G, Counter) -> + case lists:member(V, Xs) of + true -> one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter); + false -> one_path(out_neighbours(G, V), W, + [{Vs,Ps} | Cont], [V|Xs], [V|Ps], + Prune, G, Counter+1) + end; +one_path([], W, [{Vs,Ps}|Cont], Xs, _, Prune, G, Counter) -> + one_path(Vs, W, Cont, Xs, Ps, Prune, G, Counter-1); +one_path([], _, [], _, _, _, _, _Counter) -> false. + +%% +%% Like get_cycle/2, but a cycle of length one is preferred. +%% + +-spec get_short_cycle(G, V) -> Vertices | 'false' when + G :: local_digraph(), + V :: vertex(), + Vertices :: [vertex(),...]. + +get_short_cycle(G, V) -> + get_short_path(G, V, V). + +%% +%% Like get_path/3, but using a breadth-first search makes it possible +%% to find a short path. +%% + +-spec get_short_path(G, V1, V2) -> Vertices | 'false' when + G :: local_digraph(), + V1 :: vertex(), + V2 :: vertex(), + Vertices :: [vertex(),...]. + +get_short_path(G, V1, V2) -> + T = new(), + add_vertex(T, V1), + Q = queue:new(), + Q1 = queue_out_neighbours(V1, G, Q), + L = spath(Q1, G, V2, T), + delete(T), + L. + +spath(Q, G, Sink, T) -> + case queue:out(Q) of + {{value, E}, Q1} -> + {_E, V1, V2, _Label} = edge(G, E), + if + Sink =:= V2 -> + follow_path(V1, T, [V2]); + true -> + case vertex(T, V2) of + false -> + add_vertex(T, V2), + add_edge(T, V2, V1), + NQ = queue_out_neighbours(V2, G, Q1), + spath(NQ, G, Sink, T); + _V -> + spath(Q1, G, Sink, T) + end + end; + {empty, _Q1} -> + false + end. + +follow_path(V, T, P) -> + P1 = [V | P], + case out_neighbours(T, V) of + [N] -> + follow_path(N, T, P1); + [] -> + P1 + end. + +queue_out_neighbours(V, G, Q0) -> + lists:foldl(fun(E, Q) -> queue:in(E, Q) end, Q0, out_edges(G, V)). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl new file mode 100644 index 0000000000..9ecd4f92a1 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/modules/opaque_erl_scan.erl @@ -0,0 +1,1300 @@ +%% -*- coding: utf-8 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%% The Erlang scanner. All types are opaque, which puts some stress +%%% on Dialyzer. + +-module(opaque_erl_scan). + +%%% External exports + +-export([string/1,string/2,string/3,tokens/3,tokens/4, + format_error/1,reserved_word/1, + token_info/1,token_info/2, + attributes_info/1,attributes_info/2,set_attribute/3]). + +%%% Private +-export([continuation_location/1]). + +-export_type([error_info/0, + line/0, + location/0, + options/0, + return_cont/0, + token/0, + tokens_result/0]). + +%%% +%%% Defines and type definitions +%%% + +-define(COLUMN(C), (is_integer(C) andalso C >= 1)). +%% Line numbers less than zero have always been allowed: +-define(ALINE(L), is_integer(L)). +-define(STRING(S), is_list(S)). +-define(RESWORDFUN(F), is_function(F, 1)). +-define(SETATTRFUN(F), is_function(F, 1)). + +-export_type([category/0, column/0, resword_fun/0, option/0, symbol/0, + info_line/0, attributes_data/0, attributes/0, tokens/0, + error_description/0, char_spec/0, cont_fun/0, + attribute_item/0, info_location/0, attribute_info/0, + token_item/0, token_info/0]). + +-opaque category() :: atom(). +-opaque column() :: pos_integer(). +-opaque line() :: integer(). +-opaque location() :: line() | {line(),column()}. +-opaque resword_fun() :: fun((atom()) -> boolean()). +-opaque option() :: 'return' | 'return_white_spaces' | 'return_comments' + | 'text' | {'reserved_word_fun', resword_fun()}. +-opaque options() :: option() | [option()]. +-opaque symbol() :: atom() | float() | integer() | string(). +-opaque info_line() :: integer() | term(). +-opaque attributes_data() + :: [{'column', column()} | {'line', info_line()} | {'text', string()}] + | {line(), column()}. +%% The fact that {line(),column()} is a possible attributes() type +%% is hidden. +-opaque attributes() :: line() | attributes_data(). +-opaque token() :: {category(), attributes(), symbol()} + | {category(), attributes()}. +-opaque tokens() :: [token()]. +-opaque error_description() :: term(). +-opaque error_info() :: {location(), module(), error_description()}. + +%%% Local record. +-record(erl_scan, + {resword_fun = fun reserved_word/1 :: resword_fun(), + ws = false :: boolean(), + comment = false :: boolean(), + text = false :: boolean()}). + +%%---------------------------------------------------------------------------- + +-spec format_error(ErrorDescriptor) -> string() when + ErrorDescriptor :: error_description(). +format_error({string,Quote,Head}) -> + lists:flatten(["unterminated " ++ string_thing(Quote) ++ + " starting with " ++ + io_lib:write_string(Head, Quote)]); +format_error({illegal,Type}) -> + lists:flatten(io_lib:fwrite("illegal ~w", [Type])); +format_error(char) -> "unterminated character"; +format_error({base,Base}) -> + lists:flatten(io_lib:fwrite("illegal base '~w'", [Base])); +format_error(Other) -> + lists:flatten(io_lib:write(Other)). + +-spec string(String) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + EndLocation :: location(), + ErrorLocation :: location(). +string(String) -> + string(String, 1, []). + +-spec string(String, StartLocation) -> Return when + String :: string(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + StartLocation :: location(), + EndLocation :: location(), + ErrorLocation :: location(). +string(String, StartLocation) -> + string(String, StartLocation, []). + +-spec string(String, StartLocation, Options) -> Return when + String :: string(), + Options :: options(), + Return :: {'ok', Tokens :: tokens(), EndLocation} + | {'error', ErrorInfo :: error_info(), ErrorLocation}, + StartLocation :: location(), + EndLocation :: location(), + ErrorLocation :: location(). +string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> + string1(String, options(Options), Line, no_col, []); +string(String, {Line,Column}, Options) when ?STRING(String), + ?ALINE(Line), + ?COLUMN(Column) -> + string1(String, options(Options), Line, Column, []). + +-opaque char_spec() :: string() | 'eof'. +-opaque cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), + tokens(), any()) -> any()). +-opaque return_cont() :: {erl_scan_continuation, + string(), column(), tokens(), line(), + #erl_scan{}, any(), cont_fun()}. +-opaque tokens_result() :: {'ok', Tokens :: tokens(), EndLocation :: location()} + | {'eof', EndLocation :: location()} + | {'error', ErrorInfo :: error_info(), + EndLocation :: location()}. + +-spec tokens(Continuation, CharSpec, StartLocation) -> Return when + Continuation :: return_cont() | [], + CharSpec :: char_spec(), + StartLocation :: location(), + Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} + | {'more', Continuation1 :: return_cont()}. +tokens(Cont, CharSpec, StartLocation) -> + tokens(Cont, CharSpec, StartLocation, []). + +-spec tokens(Continuation, CharSpec, StartLocation, Options) -> Return when + Continuation :: return_cont() | [], + CharSpec :: char_spec(), + StartLocation :: location(), + Options :: options(), + Return :: {'done',Result :: tokens_result(),LeftOverChars :: char_spec()} + | {'more', Continuation1 :: return_cont()}. +tokens([], CharSpec, Line, Options) when ?ALINE(Line) -> + tokens1(CharSpec, options(Options), Line, no_col, [], fun scan/6, []); +tokens([], CharSpec, {Line,Column}, Options) when ?ALINE(Line), + ?COLUMN(Column) -> + tokens1(CharSpec, options(Options), Line, Column, [], fun scan/6, []); +tokens({erl_scan_continuation,Cs,Col,Toks,Line,St,Any,Fun}, + CharSpec, _Loc, _Opts) -> + tokens1(Cs++CharSpec, St, Line, Col, Toks, Fun, Any). + +continuation_location({erl_scan_continuation,_,no_col,_,Line,_,_,_}) -> + Line; +continuation_location({erl_scan_continuation,_,Col,_,Line,_,_,_}) -> + {Line,Col}. + +-opaque attribute_item() :: 'column' | 'length' | 'line' + | 'location' | 'text'. +-opaque info_location() :: location() | term(). +-opaque attribute_info() :: {'column', column()}| {'length', pos_integer()} + | {'line', info_line()} + | {'location', info_location()} + | {'text', string()}. +-opaque token_item() :: 'category' | 'symbol' | attribute_item(). +-opaque token_info() :: {'category', category()} | {'symbol', symbol()} + | attribute_info(). + +-spec token_info(Token) -> TokenInfo when + Token :: token(), + TokenInfo :: [TokenInfoTuple :: token_info()]. +token_info(Token) -> + Items = [category,column,length,line,symbol,text], % undefined order + token_info(Token, Items). + +-spec token_info(Token, TokenItem) -> TokenInfoTuple | 'undefined' when + Token :: token(), + TokenItem :: token_item(), + TokenInfoTuple :: token_info(); + (Token, TokenItems) -> TokenInfo when + Token :: token(), + TokenItems :: [TokenItem :: token_item()], + TokenInfo :: [TokenInfoTuple :: token_info()]. +token_info(_Token, []) -> + []; +token_info(Token, [Item|Items]) when is_atom(Item) -> + case token_info(Token, Item) of + undefined -> + token_info(Token, Items); + TokenInfo when is_tuple(TokenInfo) -> + [TokenInfo|token_info(Token, Items)] + end; +token_info({Category,_Attrs}, category=Item) -> + {Item,Category}; +token_info({Category,_Attrs,_Symbol}, category=Item) -> + {Item,Category}; +token_info({Category,_Attrs}, symbol=Item) -> + {Item,Category}; +token_info({_Category,_Attrs,Symbol}, symbol=Item) -> + {Item,Symbol}; +token_info({_Category,Attrs}, Item) -> + attributes_info(Attrs, Item); +token_info({_Category,Attrs,_Symbol}, Item) -> + attributes_info(Attrs, Item). + +-spec attributes_info(Attributes) -> AttributesInfo when + Attributes :: attributes(), + AttributesInfo :: [AttributeInfoTuple :: attribute_info()]. +attributes_info(Attributes) -> + Items = [column,length,line,text], % undefined order + attributes_info(Attributes, Items). + +-spec attributes_info + (Attributes, AttributeItem) -> AttributeInfoTuple | 'undefined' when + Attributes :: attributes(), + AttributeItem :: attribute_item(), + AttributeInfoTuple :: attribute_info(); + (Attributes, AttributeItems) -> AttributeInfo when + Attributes :: attributes(), + AttributeItems :: [AttributeItem :: attribute_item()], + AttributeInfo :: [AttributeInfoTuple :: attribute_info()]. +attributes_info(_Attrs, []) -> + []; +attributes_info(Attrs, [A|As]) when is_atom(A) -> + case attributes_info(Attrs, A) of + undefined -> + attributes_info(Attrs, As); + AttributeInfo when is_tuple(AttributeInfo) -> + [AttributeInfo|attributes_info(Attrs, As)] + end; +attributes_info({Line,Column}, column=Item) when ?ALINE(Line), + ?COLUMN(Column) -> + {Item,Column}; +attributes_info(Line, column) when ?ALINE(Line) -> + undefined; +attributes_info(Attrs, column=Item) -> + attr_info(Attrs, Item); +attributes_info(Attrs, length=Item) -> + case attributes_info(Attrs, text) of + undefined -> + undefined; + {text,Text} -> + {Item,length(Text)} + end; +attributes_info(Line, line=Item) when ?ALINE(Line) -> + {Item,Line}; +attributes_info({Line,Column}, line=Item) when ?ALINE(Line), + ?COLUMN(Column) -> + {Item,Line}; +attributes_info(Attrs, line=Item) -> + attr_info(Attrs, Item); +attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), + ?COLUMN(Column) -> + {Item,Location}; +attributes_info(Line, location=Item) when ?ALINE(Line) -> + {Item,Line}; +attributes_info(Attrs, location=Item) -> + {line,Line} = attributes_info(Attrs, line), % assume line is present + case attributes_info(Attrs, column) of + undefined -> + %% If set_attribute() has assigned a term such as {17,42} + %% to 'line', then Line will look like {Line,Column}. One + %% should not use 'location' but 'line' and 'column' in + %% such special cases. + {Item,Line}; + {column,Column} -> + {Item,{Line,Column}} + end; +attributes_info({Line,Column}, text) when ?ALINE(Line), ?COLUMN(Column) -> + undefined; +attributes_info(Line, text) when ?ALINE(Line) -> + undefined; +attributes_info(Attrs, text=Item) -> + attr_info(Attrs, Item); +attributes_info(T1, T2) -> + erlang:error(badarg, [T1,T2]). + +-spec set_attribute(AttributeItem, Attributes, SetAttributeFun) -> Attributes when + AttributeItem :: 'line', + Attributes :: attributes(), + SetAttributeFun :: fun((info_line()) -> info_line()). +set_attribute(Tag, Attributes, Fun) when ?SETATTRFUN(Fun) -> + set_attr(Tag, Attributes, Fun). + +%%% +%%% Local functions +%%% + +string_thing($') -> "atom"; %' Stupid Emacs +string_thing(_) -> "string". + +-define(WHITE_SPACE(C), + is_integer(C) andalso + (C >= $\000 andalso C =< $\s orelse C >= $\200 andalso C =< $\240)). +-define(DIGIT(C), C >= $0, C =< $9). +-define(CHAR(C), is_integer(C), C >= 0). +-define(UNICODE(C), + is_integer(C) andalso + (C >= 0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF)). + +-define(UNI255(C), C >= 0, C =< 16#ff). + +options(Opts0) when is_list(Opts0) -> + Opts = lists:foldr(fun expand_opt/2, [], Opts0), + [RW_fun] = + case opts(Opts, [reserved_word_fun], []) of + badarg -> + erlang:error(badarg, [Opts0]); + R -> + R + end, + Comment = proplists:get_bool(return_comments, Opts), + WS = proplists:get_bool(return_white_spaces, Opts), + Txt = proplists:get_bool(text, Opts), + #erl_scan{resword_fun = RW_fun, + comment = Comment, + ws = WS, + text = Txt}; +options(Opt) -> + options([Opt]). + +opts(Options, [Key|Keys], L) -> + V = case lists:keyfind(Key, 1, Options) of + {reserved_word_fun,F} when ?RESWORDFUN(F) -> + {ok,F}; + {Key,_} -> + badarg; + false -> + {ok,default_option(Key)} + end, + case V of + badarg -> + badarg; + {ok,Value} -> + opts(Options, Keys, [Value|L]) + end; +opts(_Options, [], L) -> + lists:reverse(L). + +default_option(reserved_word_fun) -> + fun reserved_word/1. + +expand_opt(return, Os) -> + [return_comments,return_white_spaces|Os]; +expand_opt(O, Os) -> + [O|Os]. + +attr_info(Attrs, Item) -> + try lists:keyfind(Item, 1, Attrs) of + {_Item, _Value} = T -> + T; + false -> + undefined + catch + _:_ -> + erlang:error(badarg, [Attrs, Item]) + end. + +-spec set_attr('line', attributes(), fun((line()) -> line())) -> attributes(). + +set_attr(line, Line, Fun) when ?ALINE(Line) -> + Ln = Fun(Line), + if + ?ALINE(Ln) -> + Ln; + true -> + [{line,Ln}] + end; +set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> + Ln = Fun(Line), + if + ?ALINE(Ln) -> + {Ln,Column}; + true -> + [{line,Ln},{column,Column}] + end; +set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> + {line,Line} = lists:keyfind(Tag, 1, Attrs), + case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of + [{line,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end; +set_attr(T1, T2, T3) -> + erlang:error(badarg, [T1,T2,T3]). + +tokens1(Cs, St, Line, Col, Toks, Fun, Any) when ?STRING(Cs); Cs =:= eof -> + case Fun(Cs, St, Line, Col, Toks, Any) of + {more,{Cs0,Ncol,Ntoks,Nline,Nany,Nfun}} -> + {more,{erl_scan_continuation,Cs0,Ncol,Ntoks,Nline,St,Nany,Nfun}}; + {ok,Toks0,eof,Nline,Ncol} -> + Res = case Toks0 of + [] -> + {eof,location(Nline, Ncol)}; + _ -> + {ok,lists:reverse(Toks0),location(Nline,Ncol)} + end, + {done,Res,eof}; + {ok,Toks0,Rest,Nline,Ncol} -> + {done,{ok,lists:reverse(Toks0),location(Nline, Ncol)},Rest}; + {{error,_,_}=Error,Rest} -> + {done,Error,Rest} + end. + +string1(Cs, St, Line, Col, Toks) -> + case scan1(Cs, St, Line, Col, Toks) of + {more,{Cs0,Ncol,Ntoks,Nline,Any,Fun}} -> + case Fun(Cs0++eof, St, Nline, Ncol, Ntoks, Any) of + {ok,Toks1,_Rest,Line2,Col2} -> + {ok,lists:reverse(Toks1),location(Line2, Col2)}; + {{error,_,_}=Error,_Rest} -> + Error + end; + {ok,Ntoks,[_|_]=Rest,Nline,Ncol} -> + string1(Rest, St, Nline, Ncol, Ntoks); + {ok,Ntoks,_,Nline,Ncol} -> + {ok,lists:reverse(Ntoks),location(Nline, Ncol)}; + {{error,_,_}=Error,_Rest} -> + Error + end. + +scan(Cs, St, Line, Col, Toks, _) -> + scan1(Cs, St, Line, Col, Toks). + +scan1([$\s|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> + scan_spcs(Cs, St, Line, Col, Toks, 1); +scan1([$\s|Cs], St, Line, Col, Toks) -> + skip_white_space(Cs, St, Line, Col, Toks, 1); +scan1([$\n|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> + scan_newline(Cs, St, Line, Col, Toks); +scan1([$\n|Cs], St, Line, Col, Toks) -> + skip_white_space(Cs, St, Line+1, new_column(Col, 1), Toks, 0); +scan1([C|Cs], St, Line, Col, Toks) when C >= $A, C =< $Z -> + scan_variable(Cs, St, Line, Col, Toks, [C]); +scan1([C|Cs], St, Line, Col, Toks) when C >= $a, C =< $z -> + scan_atom(Cs, St, Line, Col, Toks, [C]); +%% Optimization: some very common punctuation characters: +scan1([$,|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ",", ',', 1); +scan1([$(|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "(", '(', 1); +scan1([$)|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ")", ')', 1); +scan1([${|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "{", '{', 1); +scan1([$}|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "}", '}', 1); +scan1([$[|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "[", '[', 1); +scan1([$]|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "]", ']', 1); +scan1([$;|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ";", ';', 1); +scan1([$_=C|Cs], St, Line, Col, Toks) -> + scan_variable(Cs, St, Line, Col, Toks, [C]); +%% More punctuation characters below. +scan1([$\%|Cs], St, Line, Col, Toks) when not St#erl_scan.comment -> + skip_comment(Cs, St, Line, Col, Toks, 1); +scan1([$\%=C|Cs], St, Line, Col, Toks) -> + scan_comment(Cs, St, Line, Col, Toks, [C]); +scan1([C|Cs], St, Line, Col, Toks) when ?DIGIT(C) -> + scan_number(Cs, St, Line, Col, Toks, [C]); +scan1("..."++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "...", '...', 3); +scan1(".."=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +scan1(".."++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "..", '..', 2); +scan1("."=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +scan1([$.=C|Cs], St, Line, Col, Toks) -> + scan_dot(Cs, St, Line, Col, Toks, [C]); +scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs + State0 = {[],[],Line,Col}, + scan_string(Cs, St, Line, incr_column(Col, 1), Toks, State0); +scan1([$'|Cs], St, Line, Col, Toks) -> %' Emacs + State0 = {[],[],Line,Col}, + scan_qatom(Cs, St, Line, incr_column(Col, 1), Toks, State0); +scan1([$$|Cs], St, Line, Col, Toks) -> + scan_char(Cs, St, Line, Col, Toks); +scan1([$\r|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> + white_space_end(Cs, St, Line, Col, Toks, 1, "\r"); +scan1([C|Cs], St, Line, Col, Toks) when C >= $ß, C =< $ÿ, C =/= $÷ -> + scan_atom(Cs, St, Line, Col, Toks, [C]); +scan1([C|Cs], St, Line, Col, Toks) when C >= $À, C =< $Þ, C /= $× -> + scan_variable(Cs, St, Line, Col, Toks, [C]); +scan1([$\t|Cs], St, Line, Col, Toks) when St#erl_scan.ws -> + scan_tabs(Cs, St, Line, Col, Toks, 1); +scan1([$\t|Cs], St, Line, Col, Toks) -> + skip_white_space(Cs, St, Line, Col, Toks, 1); +scan1([C|Cs], St, Line, Col, Toks) when ?WHITE_SPACE(C) -> + case St#erl_scan.ws of + true -> + scan_white_space(Cs, St, Line, Col, Toks, [C]); + false -> + skip_white_space(Cs, St, Line, Col, Toks, 1) + end; +%% Punctuation characters and operators, first recognise multiples. +%% << <- <= +scan1("<<"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "<<", '<<', 2); +scan1("<-"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "<-", '<-', 2); +scan1("<="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "<=", '<=', 2); +scan1("<"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% >> >= +scan1(">>"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ">>", '>>', 2); +scan1(">="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ">=", '>=', 2); +scan1(">"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% -> -- +scan1("->"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "->", '->', 2); +scan1("--"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "--", '--', 2); +scan1("-"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% ++ +scan1("++"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "++", '++', 2); +scan1("+"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% =:= =/= =< == +scan1("=:="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=:=", '=:=', 3); +scan1("=:"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +scan1("=/="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=/=", '=/=', 3); +scan1("=/"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +scan1("=<"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=<", '=<', 2); +scan1("=="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "==", '==', 2); +scan1("="=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% /= +scan1("/="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "/=", '/=', 2); +scan1("/"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% || +scan1("||"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "||", '||', 2); +scan1("|"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% :- +scan1(":-"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ":-", ':-', 2); +%% :: for typed records +scan1("::"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "::", '::', 2); +scan1(":"=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +%% Optimization: punctuation characters less than 127: +scan1([$=|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "=", '=', 1); +scan1([$:|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ":", ':', 1); +scan1([$||Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "|", '|', 1); +scan1([$#|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "#", '#', 1); +scan1([$/|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "/", '/', 1); +scan1([$?|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "?", '?', 1); +scan1([$-|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "-", '-', 1); +scan1([$+|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "+", '+', 1); +scan1([$*|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "*", '*', 1); +scan1([$<|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "<", '<', 1); +scan1([$>|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, ">", '>', 1); +scan1([$!|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "!", '!', 1); +scan1([$@|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "@", '@', 1); +scan1([$\\|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "\\", '\\', 1); +scan1([$^|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "^", '^', 1); +scan1([$`|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "`", '`', 1); +scan1([$~|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "~", '~', 1); +scan1([$&|Cs], St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "&", '&', 1); +%% End of optimization. +scan1([C|Cs], St, Line, Col, Toks) when ?UNI255(C) -> + Str = [C], + tok2(Cs, St, Line, Col, Toks, Str, list_to_atom(Str), 1); +scan1([C|Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> + Ncol = incr_column(Col, 1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs); +scan1([]=Cs, _St, Line, Col, Toks) -> + {more,{Cs,Col,Toks,Line,[],fun scan/6}}; +scan1(eof=Cs, _St, Line, Col, Toks) -> + {ok,Toks,Cs,Line,Col}. + +scan_atom(Cs0, St, Line, Col, Toks, Ncs0) -> + case scan_name(Cs0, Ncs0) of + {more,Ncs} -> + {more,{[],Col,Toks,Line,Ncs,fun scan_atom/6}}; + {Wcs,Cs} -> + case catch list_to_atom(Wcs) of + Name when is_atom(Name) -> + case (St#erl_scan.resword_fun)(Name) of + true -> + tok2(Cs, St, Line, Col, Toks, Wcs, Name); + false -> + tok3(Cs, St, Line, Col, Toks, atom, Wcs, Name) + end; + _Error -> + Ncol = incr_column(Col, length(Wcs)), + scan_error({illegal,atom}, Line, Col, Line, Ncol, Cs) + end + end. + +scan_variable(Cs0, St, Line, Col, Toks, Ncs0) -> + case scan_name(Cs0, Ncs0) of + {more,Ncs} -> + {more,{[],Col,Toks,Line,Ncs,fun scan_variable/6}}; + {Wcs,Cs} -> + case catch list_to_atom(Wcs) of + Name when is_atom(Name) -> + tok3(Cs, St, Line, Col, Toks, var, Wcs, Name); + _Error -> + Ncol = incr_column(Col, length(Wcs)), + scan_error({illegal,var}, Line, Col, Line, Ncol, Cs) + end + end. + +scan_name([C|Cs], Ncs) when C >= $a, C =< $z -> + scan_name(Cs, [C|Ncs]); +scan_name([C|Cs], Ncs) when C >= $A, C =< $Z -> + scan_name(Cs, [C|Ncs]); +scan_name([$_=C|Cs], Ncs) -> + scan_name(Cs, [C|Ncs]); +scan_name([C|Cs], Ncs) when ?DIGIT(C) -> + scan_name(Cs, [C|Ncs]); +scan_name([$@=C|Cs], Ncs) -> + scan_name(Cs, [C|Ncs]); +scan_name([C|Cs], Ncs) when C >= $ß, C =< $ÿ, C =/= $÷ -> + scan_name(Cs, [C|Ncs]); +scan_name([C|Cs], Ncs) when C >= $À, C =< $Þ, C =/= $× -> + scan_name(Cs, [C|Ncs]); +scan_name([], Ncs) -> + {more,Ncs}; +scan_name(Cs, Ncs) -> + {lists:reverse(Ncs),Cs}. + +-define(STR(St, S), if St#erl_scan.text -> S; true -> [] end). + +scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) -> + Attrs = attributes(Line, Col, St, Ncs), + {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; +scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) -> + Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)}; +scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> + Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)}; +scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) -> + Attrs = attributes(Line, Col, St, Ncs), + {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; +scan_dot(Cs, St, Line, Col, Toks, Ncs) -> + tok2(Cs, St, Line, Col, Toks, Ncs, '.', 1). + +%%% White space characters are very common, so it is worthwhile to +%%% scan them fast and store them compactly. (The words "whitespace" +%%% and "white space" usually mean the same thing. The Erlang +%%% specification denotes the characters with ASCII code in the +%%% interval 0 to 32 as "white space".) +%%% +%%% Convention: if there is a white newline ($\n) it will always be +%%% the first character in the text string. As a consequence, there +%%% cannot be more than one newline in a white_space token string. +%%% +%%% Some common combinations are recognized, some are not. Examples +%%% of the latter are tab(s) followed by space(s), like "\t ". +%%% (They will be represented by two (or more) tokens.) +%%% +%%% Note: the character sequence "\r\n" is *not* recognized since it +%%% would violate the property that $\n will always be the first +%%% character. (But since "\r\n\r\n" is common, it pays off to +%%% recognize "\n\r".) + +scan_newline([$\s|Cs], St, Line, Col, Toks) -> + scan_nl_spcs(Cs, St, Line, Col, Toks, 2); +scan_newline([$\t|Cs], St, Line, Col, Toks) -> + scan_nl_tabs(Cs, St, Line, Col, Toks, 2); +scan_newline([$\r|Cs], St, Line, Col, Toks) -> + newline_end(Cs, St, Line, Col, Toks, 2, "\n\r"); +scan_newline([$\f|Cs], St, Line, Col, Toks) -> + newline_end(Cs, St, Line, Col, Toks, 2, "\n\f"); +scan_newline([], _St, Line, Col, Toks) -> + {more,{[$\n],Col,Toks,Line,[],fun scan/6}}; +scan_newline(Cs, St, Line, Col, Toks) -> + scan_nl_white_space(Cs, St, Line, Col, Toks, "\n"). + +scan_nl_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 17 -> + scan_nl_spcs(Cs, St, Line, Col, Toks, N+1); +scan_nl_spcs([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun scan_nl_spcs/6}}; +scan_nl_spcs(Cs, St, Line, Col, Toks, N) -> + newline_end(Cs, St, Line, Col, Toks, N, nl_spcs(N)). + +scan_nl_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 11 -> + scan_nl_tabs(Cs, St, Line, Col, Toks, N+1); +scan_nl_tabs([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun scan_nl_tabs/6}}; +scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> + newline_end(Cs, St, Line, Col, Toks, N, nl_tabs(N)). + +%% Note: returning {more,Cont} is meaningless here; one could just as +%% well return several tokens. But since tokens() scans up to a full +%% stop anyway, nothing is gained by not collecting all white spaces. +scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, + Toks0, Ncs) -> + Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], + scan_newline(Cs, St, Line+1, Col, Toks); +scan_nl_white_space([$\n|Cs], St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + Attrs = attributes(Line, Col, St, Ncs), + Token = {white_space,Attrs,Ncs}, + scan_newline(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]); +scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> + scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; +scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, + Toks, Ncs) -> + scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); +scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + Attrs = attributes(Line, Col, St, Ncs), + Token = {white_space,Attrs,Ncs}, + scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). + +newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, + Toks, _N, Ncs) -> + scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); +newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> + Attrs = attributes(Line, Col, St, Ncs), + scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Attrs,Ncs}|Toks]). + +scan_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 16 -> + scan_spcs(Cs, St, Line, Col, Toks, N+1); +scan_spcs([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun scan_spcs/6}}; +scan_spcs(Cs, St, Line, Col, Toks, N) -> + white_space_end(Cs, St, Line, Col, Toks, N, spcs(N)). + +scan_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 10 -> + scan_tabs(Cs, St, Line, Col, Toks, N+1); +scan_tabs([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun scan_tabs/6}}; +scan_tabs(Cs, St, Line, Col, Toks, N) -> + white_space_end(Cs, St, Line, Col, Toks, N, tabs(N)). + +skip_white_space([$\n|Cs], St, Line, Col, Toks, _N) -> + skip_white_space(Cs, St, Line+1, new_column(Col, 1), Toks, 0); +skip_white_space([C|Cs], St, Line, Col, Toks, N) when ?WHITE_SPACE(C) -> + skip_white_space(Cs, St, Line, Col, Toks, N+1); +skip_white_space([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun skip_white_space/6}}; +skip_white_space(Cs, St, Line, Col, Toks, N) -> + scan1(Cs, St, Line, incr_column(Col, N), Toks). + +%% Maybe \t and \s should break the loop. +scan_white_space([$\n|_]=Cs, St, Line, Col, Toks, Ncs) -> + white_space_end(Cs, St, Line, Col, Toks, length(Ncs), lists:reverse(Ncs)); +scan_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> + scan_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_white_space/6}}; +scan_white_space(Cs, St, Line, Col, Toks, Ncs) -> + white_space_end(Cs, St, Line, Col, Toks, length(Ncs), lists:reverse(Ncs)). + +-compile({inline,[white_space_end/7]}). + +white_space_end(Cs, St, Line, Col, Toks, N, Ncs) -> + tok3(Cs, St, Line, Col, Toks, white_space, Ncs, Ncs, N). + +scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> + case scan_escape(Cs, incr_column(Col, 2)) of + more -> + {more,{[$$|Cs0],Col,Toks,Line,[],fun scan/6}}; + {error,Ncs,Error,Ncol} -> + scan_error(Error, Line, Col, Line, Ncol, Ncs); + {eof,Ncol} -> + scan_error(char, Line, Col, Line, Ncol, eof); + {nl,Val,Str,Ncs,Ncol} -> + Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Attrs,Val}|Toks], + scan1(Ncs, St, Line+1, Ncol, Ntoks); + {Val,Str,Ncs,Ncol} -> + Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Attrs,Val}|Toks], + scan1(Ncs, St, Line, Ncol, Ntoks) + end; +scan_char([$\n=C|Cs], St, Line, Col, Toks) -> + Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); +scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) -> + Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line, incr_column(Col, 2), [{char,Attrs,C}|Toks]); +scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> + scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof); +scan_char([], _St, Line, Col, Toks) -> + {more,{[$$],Col,Toks,Line,[],fun scan/6}}; +scan_char(eof, _St, Line, Col, _Toks) -> + scan_error(char, Line, Col, Line, incr_column(Col, 1), eof). + +scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\", Str, Wcs) of %" + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, + {more,{Ncs,Ncol,Toks,Nline,State,fun scan_string/6}}; + {char_error,Ncs,Error,Nline,Ncol,EndCol} -> + scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); + {error,Nline,Ncol,Nwcs,Ncs} -> + Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. + scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" + {Ncs,Nline,Ncol,Nstr,Nwcs} -> + Attrs = attributes(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]) + end. + +scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\', Str, Wcs) of %' + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, + {more,{Ncs,Ncol,Toks,Nline,State,fun scan_qatom/6}}; + {char_error,Ncs,Error,Nline,Ncol,EndCol} -> + scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); + {error,Nline,Ncol,Nwcs,Ncs} -> + Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. + scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %' + {Ncs,Nline,Ncol,Nstr,Nwcs} -> + case catch list_to_atom(Nwcs) of + A when is_atom(A) -> + Attrs = attributes(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{atom,Attrs,A}|Toks]); + _ -> + scan_error({illegal,atom}, Line0, Col0, Nline, Ncol, Ncs) + end + end. + +scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, [], Wcs) -> + scan_string_no_col(Cs, Line, Col, Q, Wcs); +scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs); +scan_string0(Cs, St, Line, Col, Q, [], Wcs) -> + scan_string_col(Cs, St, Line, Col, Q, Wcs); +scan_string0(Cs, _St, Line, Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs). + +%% Optimization. Col =:= no_col. +scan_string_no_col([Q|Cs], Line, Col, Q, Wcs) -> + {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs)}; +scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs) -> + scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs]); +scan_string_no_col([C|Cs], Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_no_col(Cs, Line, Col, Q, [C|Wcs]); +scan_string_no_col(Cs, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). + +%% Optimization. Col =/= no_col. +scan_string_col([Q|Cs], St, Line, Col, Q, Wcs0) -> + Wcs = lists:reverse(Wcs0), + Str = ?STR(St, [Q|Wcs++[Q]]), + {Cs,Line,Col+1,Str,Wcs}; +scan_string_col([$\n=C|Cs], St, Line, _xCol, Q, Wcs) -> + scan_string_col(Cs, St, Line+1, 1, Q, [C|Wcs]); +scan_string_col([C|Cs], St, Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_col(Cs, St, Line, Col+1, Q, [C|Wcs]); +scan_string_col(Cs, _St, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). + +%% Note: in those cases when a 'char_error' tuple is returned below it +%% is tempting to skip over characters up to the first Q character, +%% but then the end location of the error tuple would not correspond +%% to the start location of the returned Rest string. (Maybe the end +%% location could be modified, but that too is ugly.) +scan_string1([Q|Cs], Line, Col, Q, Str0, Wcs0) -> + Wcs = lists:reverse(Wcs0), + Str = [Q|lists:reverse(Str0, [Q])], + {Cs,Line,incr_column(Col, 1),Str,Wcs}; +scan_string1([$\n=C|Cs], Line, Col, Q, Str, Wcs) -> + Ncol = new_column(Col, 1), + scan_string1(Cs, Line+1, Ncol, Q, [C|Str], [C|Wcs]); +scan_string1([$\\|Cs]=Cs0, Line, Col, Q, Str, Wcs) -> + case scan_escape(Cs, Col) of + more -> + {more,Cs0,Line,Col,Str,Wcs}; + {error,Ncs,Error,Ncol} -> + {char_error,Ncs,Error,Line,Col,incr_column(Ncol, 1)}; + {eof,Ncol} -> + {error,Line,incr_column(Ncol, 1),lists:reverse(Wcs),eof}; + {nl,Val,ValStr,Ncs,Ncol} -> + Nstr = lists:reverse(ValStr, [$\\|Str]), + Nwcs = [Val|Wcs], + scan_string1(Ncs, Line+1, Ncol, Q, Nstr, Nwcs); + {Val,ValStr,Ncs,Ncol} -> + Nstr = lists:reverse(ValStr, [$\\|Str]), + Nwcs = [Val|Wcs], + scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs) + end; +scan_string1([C|Cs], Line, no_col=Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col+1, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, _Q, _Str, _Wcs) when ?CHAR(C) -> + {char_error,Cs,{illegal,character},Line,Col,incr_column(Col, 1)}; +scan_string1([]=Cs, Line, Col, _Q, Str, Wcs) -> + {more,Cs,Line,Col,Str,Wcs}; +scan_string1(eof, Line, Col, _Q, _Str, Wcs) -> + {error,Line,Col,lists:reverse(Wcs),eof}. + +-define(OCT(C), C >= $0, C =< $7). +-define(HEX(C), C >= $0 andalso C =< $9 orelse + C >= $A andalso C =< $F orelse + C >= $a andalso C =< $f). + +%% \<1-3> octal digits +scan_escape([O1,O2,O3|Cs], Col) when ?OCT(O1), ?OCT(O2), ?OCT(O3) -> + Val = (O1*8 + O2)*8 + O3 - 73*$0, + {Val,[O1,O2,O3],Cs,incr_column(Col, 3)}; +scan_escape([O1,O2], _Col) when ?OCT(O1), ?OCT(O2) -> + more; +scan_escape([O1,O2|Cs], Col) when ?OCT(O1), ?OCT(O2) -> + Val = (O1*8 + O2) - 9*$0, + {Val,[O1,O2],Cs,incr_column(Col, 2)}; +scan_escape([O1], _Col) when ?OCT(O1) -> + more; +scan_escape([O1|Cs], Col) when ?OCT(O1) -> + {O1 - $0,[O1],Cs,incr_column(Col, 1)}; +%% \x{<hex digits>} +scan_escape([$x,${|Cs], Col) -> + scan_hex(Cs, incr_column(Col, 2), []); +scan_escape([$x], _Col) -> + more; +scan_escape([$x|eof], Col) -> + {eof,incr_column(Col, 1)}; +%% \x<2> hexadecimal digits +scan_escape([$x,H1,H2|Cs], Col) when ?HEX(H1), ?HEX(H2) -> + Val = erlang:list_to_integer([H1,H2], 16), + {Val,[$x,H1,H2],Cs,incr_column(Col, 3)}; +scan_escape([$x,H1], _Col) when ?HEX(H1) -> + more; +scan_escape([$x|Cs], Col) -> + {error,Cs,{illegal,character},incr_column(Col, 1)}; +%% \^X -> CTL-X +scan_escape([$^=C0,$\n=C|Cs], Col) -> + {nl,C,[C0,C],Cs,new_column(Col, 1)}; +scan_escape([$^=C0,C|Cs], Col) when ?CHAR(C) -> + Val = C band 31, + {Val,[C0,C],Cs,incr_column(Col, 2)}; +scan_escape([$^], _Col) -> + more; +scan_escape([$^|eof], Col) -> + {eof,incr_column(Col, 1)}; +scan_escape([$\n=C|Cs], Col) -> + {nl,C,[C],Cs,new_column(Col, 1)}; +scan_escape([C0|Cs], Col) when ?UNICODE(C0) -> + C = escape_char(C0), + {C,[C0],Cs,incr_column(Col, 1)}; +scan_escape([C|Cs], Col) when ?CHAR(C) -> + {error,Cs,{illegal,character},incr_column(Col, 1)}; +scan_escape([], _Col) -> + more; +scan_escape(eof, Col) -> + {eof,Col}. + +scan_hex([C|Cs], no_col=Col, Wcs) when ?HEX(C) -> + scan_hex(Cs, Col, [C|Wcs]); +scan_hex([C|Cs], Col, Wcs) when ?HEX(C) -> + scan_hex(Cs, Col+1, [C|Wcs]); +scan_hex(Cs, Col, Wcs) -> + scan_esc_end(Cs, Col, Wcs, 16, "x{"). + +scan_esc_end([$}|Cs], Col, Wcs0, B, Str0) -> + Wcs = lists:reverse(Wcs0), + case catch erlang:list_to_integer(Wcs, B) of + Val when ?UNICODE(Val) -> + {Val,Str0++Wcs++[$}],Cs,incr_column(Col, 1)}; + _ -> + {error,Cs,{illegal,character},incr_column(Col, 1)} + end; +scan_esc_end([], _Col, _Wcs, _B, _Str0) -> + more; +scan_esc_end(eof, Col, _Wcs, _B, _Str0) -> + {eof,Col}; +scan_esc_end(Cs, Col, _Wcs, _B, _Str0) -> + {error,Cs,{illegal,character},Col}. + +escape_char($n) -> $\n; % \n = LF +escape_char($r) -> $\r; % \r = CR +escape_char($t) -> $\t; % \t = TAB +escape_char($v) -> $\v; % \v = VT +escape_char($b) -> $\b; % \b = BS +escape_char($f) -> $\f; % \f = FF +escape_char($e) -> $\e; % \e = ESC +escape_char($s) -> $\s; % \s = SPC +escape_char($d) -> $\d; % \d = DEL +escape_char(C) -> C. + +scan_number([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> + scan_number(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_number([$.,C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> + scan_fraction(Cs, St, Line, Col, Toks, [C,$.|Ncs]); +scan_number([$.]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}}; +scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + case catch list_to_integer(Ncs) of + B when B >= 2, B =< 1+$Z-$A+10 -> + Bcs = ?STR(St, Ncs++[$#]), + scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); + B -> + Len = length(Ncs), + scan_error({base,B}, Line, Col, Line, incr_column(Col, Len), Cs0) + end; +scan_number([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_number/6}}; +scan_number(Cs, St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + case catch list_to_integer(Ncs) of + N when is_integer(N) -> + tok3(Cs, St, Line, Col, Toks, integer, Ncs, N); + _ -> + Ncol = incr_column(Col, length(Ncs)), + scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) + end. + +scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) + when ?DIGIT(C), C < $0+B -> + scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); +scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) + when C >= $A, B > 10, C < $A+B-10 -> + scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); +scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) + when C >= $a, B > 10, C < $a+B-10 -> + scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); +scan_based_int([]=Cs, _St, Line, Col, Toks, State) -> + {more,{Cs,Col,Toks,Line,State,fun scan_based_int/6}}; +scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> + Ncs = lists:reverse(Ncs0), + case catch erlang:list_to_integer(Ncs, B) of + N when is_integer(N) -> + tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); + _ -> + Len = length(Bcs)+length(Ncs), + Ncol = incr_column(Col, Len), + scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) + end. + +scan_fraction([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> + scan_fraction(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_fraction([E|Cs], St, Line, Col, Toks, Ncs) when E =:= $e; E =:= $E -> + scan_exponent_sign(Cs, St, Line, Col, Toks, [E|Ncs]); +scan_fraction([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_fraction/6}}; +scan_fraction(Cs, St, Line, Col, Toks, Ncs) -> + float_end(Cs, St, Line, Col, Toks, Ncs). + +scan_exponent_sign([C|Cs], St, Line, Col, Toks, Ncs) when C =:= $+; C =:= $- -> + scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_exponent_sign([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent_sign/6}}; +scan_exponent_sign(Cs, St, Line, Col, Toks, Ncs) -> + scan_exponent(Cs, St, Line, Col, Toks, Ncs). + +scan_exponent([C|Cs], St, Line, Col, Toks, Ncs) when ?DIGIT(C) -> + scan_exponent(Cs, St, Line, Col, Toks, [C|Ncs]); +scan_exponent([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_exponent/6}}; +scan_exponent(Cs, St, Line, Col, Toks, Ncs) -> + float_end(Cs, St, Line, Col, Toks, Ncs). + +float_end(Cs, St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + case catch list_to_float(Ncs) of + F when is_float(F) -> + tok3(Cs, St, Line, Col, Toks, float, Ncs, F); + _ -> + Ncol = incr_column(Col, length(Ncs)), + scan_error({illegal,float}, Line, Col, Line, Ncol, Cs) + end. + +skip_comment([C|Cs], St, Line, Col, Toks, N) when C =/= $\n, ?CHAR(C) -> + case ?UNICODE(C) of + true -> + skip_comment(Cs, St, Line, Col, Toks, N+1); + false -> + Ncol = incr_column(Col, N+1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) + end; +skip_comment([]=Cs, _St, Line, Col, Toks, N) -> + {more,{Cs,Col,Toks,Line,N,fun skip_comment/6}}; +skip_comment(Cs, St, Line, Col, Toks, N) -> + scan1(Cs, St, Line, incr_column(Col, N), Toks). + +scan_comment([C|Cs], St, Line, Col, Toks, Ncs) when C =/= $\n, ?CHAR(C) -> + case ?UNICODE(C) of + true -> + scan_comment(Cs, St, Line, Col, Toks, [C|Ncs]); + false -> + Ncol = incr_column(Col, length(Ncs)+1), + scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) + end; +scan_comment([]=Cs, _St, Line, Col, Toks, Ncs) -> + {more,{Cs,Col,Toks,Line,Ncs,fun scan_comment/6}}; +scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> + Ncs = lists:reverse(Ncs0), + tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs). + +tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P) -> + scan1(Cs, St, Line, Col, [{P,Line}|Toks]); +tok2(Cs, St, Line, Col, Toks, Wcs, P) -> + Attrs = attributes(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Attrs}|Toks]). + +tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P, _N) -> + scan1(Cs, St, Line, Col, [{P,Line}|Toks]); +tok2(Cs, St, Line, Col, Toks, Wcs, P, N) -> + Attrs = attributes(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, N), [{P,Attrs}|Toks]). + +tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _S, Sym) -> + scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); +tok3(Cs, St, Line, Col, Toks, Item, String, Sym) -> + Token = {Item,attributes(Line, Col, St, String),Sym}, + scan1(Cs, St, Line, incr_column(Col, length(String)), [Token|Toks]). + +tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, + _String, Sym, _Length) -> + scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); +tok3(Cs, St, Line, Col, Toks, Item, String, Sym, Length) -> + Token = {Item,attributes(Line, Col, St, String),Sym}, + scan1(Cs, St, Line, incr_column(Col, Length), [Token|Toks]). + +scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> + Loc = location(Line, Col), + EndLoc = location(EndLine, EndCol), + scan_error(Error, Loc, EndLoc, Rest). + +scan_error(Error, ErrorLoc, EndLoc, Rest) -> + {{error,{ErrorLoc,?MODULE,Error},EndLoc},Rest}. + +-compile({inline,[attributes/4]}). + +attributes(Line, no_col, #erl_scan{text = false}, _String) -> + Line; +attributes(Line, no_col, #erl_scan{text = true}, String) -> + [{line,Line},{text,String}]; +attributes(Line, Col, #erl_scan{text = false}, _String) -> + {Line,Col}; +attributes(Line, Col, #erl_scan{text = true}, String) -> + [{line,Line},{column,Col},{text,String}]. + +location(Line, no_col) -> + Line; +location(Line, Col) when is_integer(Col) -> + {Line,Col}. + +-compile({inline,[incr_column/2,new_column/2]}). + +incr_column(no_col=Col, _N) -> + Col; +incr_column(Col, N) when is_integer(Col) -> + Col + N. + +new_column(no_col=Col, _Ncol) -> + Col; +new_column(Col, Ncol) when is_integer(Col) -> + Ncol. + +nl_spcs(2) -> "\n "; +nl_spcs(3) -> "\n "; +nl_spcs(4) -> "\n "; +nl_spcs(5) -> "\n "; +nl_spcs(6) -> "\n "; +nl_spcs(7) -> "\n "; +nl_spcs(8) -> "\n "; +nl_spcs(9) -> "\n "; +nl_spcs(10) -> "\n "; +nl_spcs(11) -> "\n "; +nl_spcs(12) -> "\n "; +nl_spcs(13) -> "\n "; +nl_spcs(14) -> "\n "; +nl_spcs(15) -> "\n "; +nl_spcs(16) -> "\n "; +nl_spcs(17) -> "\n ". + +spcs(1) -> " "; +spcs(2) -> " "; +spcs(3) -> " "; +spcs(4) -> " "; +spcs(5) -> " "; +spcs(6) -> " "; +spcs(7) -> " "; +spcs(8) -> " "; +spcs(9) -> " "; +spcs(10) -> " "; +spcs(11) -> " "; +spcs(12) -> " "; +spcs(13) -> " "; +spcs(14) -> " "; +spcs(15) -> " "; +spcs(16) -> " ". + +nl_tabs(2) -> "\n\t"; +nl_tabs(3) -> "\n\t\t"; +nl_tabs(4) -> "\n\t\t\t"; +nl_tabs(5) -> "\n\t\t\t\t"; +nl_tabs(6) -> "\n\t\t\t\t\t"; +nl_tabs(7) -> "\n\t\t\t\t\t\t"; +nl_tabs(8) -> "\n\t\t\t\t\t\t\t"; +nl_tabs(9) -> "\n\t\t\t\t\t\t\t\t"; +nl_tabs(10) -> "\n\t\t\t\t\t\t\t\t\t"; +nl_tabs(11) -> "\n\t\t\t\t\t\t\t\t\t\t". + +tabs(1) -> "\t"; +tabs(2) -> "\t\t"; +tabs(3) -> "\t\t\t"; +tabs(4) -> "\t\t\t\t"; +tabs(5) -> "\t\t\t\t\t"; +tabs(6) -> "\t\t\t\t\t\t"; +tabs(7) -> "\t\t\t\t\t\t\t"; +tabs(8) -> "\t\t\t\t\t\t\t\t"; +tabs(9) -> "\t\t\t\t\t\t\t\t\t"; +tabs(10) -> "\t\t\t\t\t\t\t\t\t\t". + +-spec reserved_word(Atom :: atom()) -> boolean(). +reserved_word('after') -> true; +reserved_word('begin') -> true; +reserved_word('case') -> true; +reserved_word('try') -> true; +reserved_word('cond') -> true; +reserved_word('catch') -> true; +reserved_word('andalso') -> true; +reserved_word('orelse') -> true; +reserved_word('end') -> true; +reserved_word('fun') -> true; +reserved_word('if') -> true; +reserved_word('let') -> true; +reserved_word('of') -> true; +reserved_word('receive') -> true; +reserved_word('when') -> true; +reserved_word('bnot') -> true; +reserved_word('not') -> true; +reserved_word('div') -> true; +reserved_word('rem') -> true; +reserved_word('band') -> true; +reserved_word('and') -> true; +reserved_word('bor') -> true; +reserved_word('bxor') -> true; +reserved_word('bsl') -> true; +reserved_word('bsr') -> true; +reserved_word('or') -> true; +reserved_word('xor') -> true; +reserved_word(_) -> false. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl index 3456f0e9c6..cdcaa5f9e8 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_adt.erl @@ -3,6 +3,8 @@ -opaque abc() :: 'a' | 'b' | 'c'. +-spec atom_or_list(_) -> abc() | list(). + atom_or_list(1) -> a; atom_or_list(2) -> b; atom_or_list(3) -> c; diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl new file mode 100644 index 0000000000..7103847ae7 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_adt.erl @@ -0,0 +1,17 @@ +-module(exact_adt). + +-export([exact_adt_set_type/1, exact_adt_set_type2/1]). + +-export_type([exact_adt/0]). + +-record(exact_adt, {}). + +-opaque exact_adt() :: #exact_adt{}. + +-spec exact_adt_set_type(_) -> exact_adt(). + +exact_adt_set_type(G) -> G. + +-spec exact_adt_set_type2(exact_adt()) -> exact_adt(). + +exact_adt_set_type2(G) -> G. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl new file mode 100644 index 0000000000..5f7ab4f3aa --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/exact_api.erl @@ -0,0 +1,60 @@ +-module(exact_api). + +-export([new/0, exact_api_test/1, exact_api_new/1, + exact_adt_test/1, exact_adt_new/1]). + +-export_type([exact_api/0]). + +-record(digraph, {vtab = notable :: ets:tab(), + etab = notable :: ets:tab(), + ntab = notable :: ets:tab(), + cyclic = true :: boolean()}). + +-spec new() -> digraph(). + +new() -> + A = #digraph{}, + set_type(A), % does not have an opaque term as 1st argument + A. + +-spec set_type(digraph()) -> true. + +set_type(G) -> + digraph:delete(G). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%% The derived spec of exact_api_new() is +%%% -spec exact_api_new(exact_api:exact_api()) -> exact_api:exact_api(). +%%% This won't happen unless dialyzer_typesig uses +%%% t_is_exactly_equal() rather than t_is_equal(). +%%% [As of R17B the latter considers two types equal if nothing but +%%% their ?opaque tags differ.] + +-record(exact_api, {}). + +-opaque exact_api() :: #exact_api{}. + +exact_api_test(X) -> + #exact_api{} = exact_api_set_type(X). % OK + +exact_api_new(A) -> + A = #exact_api{}, + _ = exact_api_set_type(A), % OK (the opaque type is local) + A. + +-spec exact_api_set_type(exact_api()) -> exact_api(). + +exact_api_set_type(#exact_api{}=E) -> E. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-record(exact_adt, {}). + +exact_adt_test(X) -> + #exact_adt{} = exact_adt:exact_adt_set_type(X). % breaks the opaqueness + +exact_adt_new(A) -> + A = #exact_adt{}, + _ = exact_adt:exact_adt_set_type2(A), % does not have an opaque term as 1st argument + A. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl new file mode 100644 index 0000000000..2b157483bc --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/is_rec.erl @@ -0,0 +1,65 @@ +-module(is_rec). + +-export([ri1/0, ri11/0, ri13/0, ri14/0, ri2/0, ri3/0, ri4/0, ri5/0, + ri6/0, ri7/0, ri8/0]). + +-record(r, {f1 :: integer()}). + +ri1() -> + A = simple1_adt:d1(), + is_record(A, r). % opaque term 1 + +ri11() -> + A = simple1_adt:d1(), + I = '1-3'(), + is_record(A, r, I). % opaque term 1 + +ri13() -> + A = simple1_adt:d1(), + if is_record(A, r) -> true end. % breaks the opaqueness + +ri14() -> + A = simple1_adt:d1(), + if is_record({A, 1}, r) -> true end. % breaks the opaqueness + +-type '1-3-t'() :: 1..3. + +-spec '1-3'() -> '1-3-t'(). + +'1-3'() -> + random:uniform(3). + + +-spec 'Atom'() -> atom(). + +'Atom'() -> + a. + +ri2() -> + A = simple1_adt:d1(), + R = 'Atom'(), + is_record(A, R). % opaque term 1 + +ri3() -> + A = simple1_adt:d1(), + is_record(A, A, 1). % opaque term 2 + +ri4() -> + A = simple1_adt:d1(), + is_record(A, hipp:hopp(), 1). % opaque term 1 + +ri5() -> + A = simple1_adt:d1(), + is_record(A, A, hipp:hopp()). % opaque term 2 + +ri6() -> + A = simple1_adt:d1(), + if is_record(A, r) -> true end. % breaks opaqueness + +ri7() -> + A = simple1_adt:d1(), + if is_record({r, A}, r) -> true end. % A violates #r{} + +ri8() -> + A = simple1_adt:d1(), + is_record({A, 1}, r). % opaque term 1 diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl new file mode 100644 index 0000000000..ff80d6e99b --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_adt.erl @@ -0,0 +1,28 @@ +-module(rec_adt). + +-export([f/0, r1/0]). + +-export_type([r1/0]). + +-export_type([f/0, op_t/0, a/0]). + +-opaque a() :: a | b. + +-record(r1, + {f1 :: a()}). + +-opaque r1() :: #r1{}. + +-opaque f() :: fun((_) -> _). + +-opaque op_t() :: integer(). + +-spec f() -> f(). + +f() -> + fun(_) -> 3 end. + +-spec r1() -> r1(). + +r1() -> + #r1{f1 = a}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl new file mode 100644 index 0000000000..d9b1d59f0c --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/rec_api.erl @@ -0,0 +1,77 @@ +-module(rec_api). + +-export([t1/0, t2/0, adt_t1/0, adt_t1/1, adt_r1/0, + t/1, t_adt/0, r/0, r_adt/0]). + +-export_type([{a,0},{r1,0}]). + +-export_type([f/0, op_t/0, r/0, tup/0]). + +-opaque a() :: a | b. + +-record(r1, + {f1 :: a()}). + +-opaque r1() :: #r1{}. + +t1() -> + A = #r1{f1 = a}, + {r1, a} = A. + +t2() -> + A = {r1, 10}, % violates the type of #r1{} + {r1, 10} = A. % violates the type of #r1{} + +adt_t1() -> + R = rec_adt:r1(), + {r1, a} = R. % breaks the opaqueness + +-spec adt_t1(rec_adt:r1()) -> rec_adt:r1(). % invalid type spec + +adt_t1(R) -> + {r1, a} = R. + +-spec adt_r1() -> rec_adt:r1(). % invalid type spec + +adt_r1() -> + #r1{f1 = a}. + +-opaque f() :: fun((_) -> _). + +-opaque op_t() :: integer(). + +-spec t(f()) -> _. + +t(A) -> + T = term(), + %% 3(T), % cannot test this: dialyzer_dep deliberately crashes + A(T). + +-spec term() -> op_t(). + +term() -> + 3. + +t_adt() -> + A = rec_adt:f(), + T = term(), + A(T). + +-record(r, {f = fun(_) -> 3 end :: f(), o = 1 :: op_t()}). + +-opaque r() :: #r{}. + +-opaque tup() :: {'r', f(), op_t()}. + +-spec r() -> _. + +r() -> + {r, f(), 2}. % OK, f() is a local opaque type + +-spec f() -> f(). + +f() -> + fun(_) -> 3 end. + +r_adt() -> + {r, rec_adt:f(), 2}. % breaks the opaqueness diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl new file mode 100644 index 0000000000..21a277c1e9 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_adt.erl @@ -0,0 +1,138 @@ +-module(simple1_adt). + +-export([d1/0, d2/0, i/0, n1/0, n2/0, o1/0, o2/0, + c1/0, c2/0, bit1/0, a/0, i1/0, tuple/0, + b1/0, b2/0, ty_i1/0]). + +-export_type([o1/0, o2/0, d1/0, d2/0]). + +-export_type([i1/0, i2/0, di1/0, di2/0]). + +-export_type([ty_i1/0, c1/0, c2/0]). + +-export_type([b1/0, b2/0]). + +-export_type([bit1/0]). + +-export_type([tuple1/0, a/0, i/0]). + +%% Equal: + +-opaque o1() :: a | b | c. + +-opaque o2() :: a | b | c. + +%% Disjoint: + +-opaque d1() :: a | b | c. + +-opaque d2() :: d | e | f. + +%% One common element: + +-opaque c1() :: a | b | c. + +-opaque c2() :: c | e | f. + +%% Equal integer range: + +-opaque i1() :: 1 | 2. + +-opaque i2() :: 1 | 2. + +%% Disjoint integer range: + +-opaque di1() :: 1 | 2. + +-opaque di2() :: 3 | 4. + + +-type ty_i1() :: 1 | 2. + +%% Boolean types + +-opaque b1() :: boolean(). + +-opaque b2() :: boolean(). + +%% Binary types + +-opaque bit1() :: binary(). + +%% Tuple types + +-opaque tuple1() :: tuple(). + +%% Atom type + +-opaque a() :: atom(). + +-opaque i() :: integer(). + +-spec d1() -> d1(). + +d1() -> a. + +-spec d2() -> d2(). + +d2() -> d. + +-spec i() -> i(). + +i() -> + 1. + +-spec n1() -> o1(). + +n1() -> a. + +-spec n2() -> o2(). + +n2() -> a. + +-spec o1() -> o1(). + +o1() -> a. + +-spec o2() -> o2(). + +o2() -> a. + +-spec c1() -> c1(). + +c1() -> a. + +-spec c2() -> c2(). + +c2() -> e. + +-spec bit1() -> bit1(). + +bit1() -> + <<"hej">>. + +-spec a() -> a(). + +a() -> + e. + +-spec i1() -> i1(). + +i1() -> 1. + +-spec tuple() -> tuple1(). + +tuple() -> {1,2}. + +-spec b1() -> b1(). + +b1() -> true. + +-spec b2() -> b2(). + +b2() -> false. + +-spec ty_i1() -> ty_i1(). + +ty_i1() -> + 1. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl new file mode 100644 index 0000000000..5135eb8e59 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple1_api.erl @@ -0,0 +1,571 @@ +-module(simple1_api). + +-export([t1/1, adt_t1/1, t2/1, adt_t2/1, tup/0, t3/0, t4/0, t5/0, t6/0, t7/0, + t8/0, adt_t3/0, adt_t4/0, adt_t7/0, adt_t8/0, adt_t5/0, + c1/2, c2/2, c2/0, c3/0, c4/0, tt1/0, tt2/0, + cmp1/0, cmp2/0, cmp3/0, cmp4/0, + ty_cmp1/0, ty_cmp2/0, ty_cmp3/0, ty_cmp4/0, + f1/0, f2/0, adt_f1/0, adt_f2/0, f3/0, f4/0, adt_f3/0, adt_f4/0, + adt_f4_a/0, adt_f4_b/0, + bool_t1/0, bool_t2/0, bool_t3/0, bool_t4/0, bool_t5/1, bool_t6/1, + bool_t7/0, bool_adt_t1/0, bool_adt_t2/0, bool_adt_t5/1, + bool_adt_t6/1, bool_t8/0, bool_adt_t8/2, bool_t9/0, bool_adt_t9/2, + bit_t1/0, bit_adt_t1/0, bit_t3/1, bit_adt_t2/0, bit_adt_t3/1, + bit_t5/1, bit_t4/1, bit_adt_t4/1, bit_t5/0, bit_adt_t5/0, + call_f/1, call_f_adt/1, call_m_adt/1, call_m/1, call_f_i/1, + call_m_i/1, call_m_adt_i/1, call_f_adt_i/1, + eq1/0, eq2/0, c5/0, c6/2, c7/2, c8/0]). + +%%% Equal opaque types + +-export_type([o1/0, o2/0]). + +-export_type([d1/0, d2/0]). + +-opaque o1() :: a | b | c. + +-opaque o2() :: a | b | c. + +-export_type([i1/0, i2/0, di1/0, di2/0]). + +-export_type([b1/0, b2/0]). + +-export_type([bit1/0]). + +-export_type([a/0, i/0]). + +%% The derived spec is +%% -spec t1('a' | 'b') -> simple1_api:o1('a') | simple1_api:o2('a'). +%% but that is not tested... + +t1(a) -> + o1(); +t1(b) -> + o2(). + +-spec o1() -> o1(). + +o1() -> a. + +-spec o2() -> o2(). + +o2() -> a. + +%% The derived spec is +%% -spec adt_t1('a' | 'b') -> simple1_adt:o1('a') | simple1_adt:o2('a'). +%% but that is not tested... + +adt_t1(a) -> + simple1_adt:o1(); +adt_t1(b) -> + simple1_adt:o2(). + +%%% Disjunct opaque types + +-opaque d1() :: a | b | c. + +-opaque d2() :: d | e | f. + +%% -spec t2('a' | 'b') -> simple1_api:d1('a') | simple1_api:d2('d'). + +t2(a) -> + d1(); +t2(b) -> + d2(). + +-spec d1() -> d1(). + +d1() -> a. + +-spec d2() -> d2(). + +d2() -> d. + +%% -spec adt_t2('a' | 'b') -> simple1_adt:d1('a') | simple1_adt:d2('d'). + +adt_t2(a) -> + simple1_adt:d1(); +adt_t2(b) -> + simple1_adt:d2(). + +-spec tup() -> simple1_adt:tuple1(). % invalid type spec + +tup() -> + {a, b}. + +%%% Matching equal opaque types with different names + +t3() -> + A = n1(), + B = n2(), + A = A, % OK, of course + A = B. % OK since o1() and o2() are local opaque types + +t4() -> + A = n1(), + B = n2(), + true = A =:= A, % OK, of course + A =:= B. % OK since o1() and o2() are local opaque types + +t5() -> + A = d1(), + B = d2(), + A =:= B. % can never evaluate to true + +t6() -> + A = d1(), + B = d2(), + A = B. % can never succeed + +t7() -> + A = d1(), + B = d2(), + A =/= B. % OK (always true?) + +t8() -> + A = d1(), + B = d2(), + A /= B. % OK (always true?) + +-spec n1() -> o1(). + +n1() -> a. + +-spec n2() -> o2(). + +n2() -> a. + +adt_t3() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + true = A =:= A, % OK. + A =:= B. % opaque test, not OK + +adt_t4() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + A = A, % OK + A = B. % opaque term + +adt_t7() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + false = A =/= A, % OK + A =/= B. % opaque test, not OK + +adt_t8() -> + A = simple1_adt:n1(), + B = simple1_adt:n2(), + false = A /= A, % OK + A /= B. % opaque test, not OK + +adt_t5() -> + A = simple1_adt:c1(), + B = simple1_adt:c2(), + A =:= B. % opaque test, not OK + +%% Comparison in guard + +-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c1(A, B) when A =< B -> true. % succ type of A and B is any() (type spec is OK) + +-spec c2(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c2(A, B) -> + if A =< B -> true end. % succ type of A and B is any() (type spec is OK) + +c2() -> + A = simple1_adt:d1(), + B = simple1_adt:d2(), + if A =< B -> ok end. % opaque term + +c3() -> + B = simple1_adt:d2(), + if a =< B -> ok end. % opaque term + +c4() -> + A = simple1_adt:d1(), + if A =< d -> ok end. % opaque term + +tt1() -> + A = o1(), + is_integer(A). % OK + +tt2() -> + A = simple1_adt:d1(), + is_integer(A). % breaks the opaqueness + +%% Comparison with integers + +-opaque i1() :: 1 | 2. + +-opaque i2() :: 1 | 2. + +-opaque di1() :: 1 | 2. + +-opaque di2() :: 3 | 4. + +-spec i1() -> i1(). + +i1() -> 1. + +-type ty_i1() :: 1 | 2. + +-spec ty_i1() -> ty_i1(). + +ty_i1() -> 1. + +cmp1() -> + A = i1(), + if A > 3 -> ok end. % can never succeed + +cmp2() -> + A = simple1_adt:i1(), + if A > 3 -> ok end. % opaque term + +cmp3() -> + A = i1(), + if A < 3 -> ok end. + +cmp4() -> + A = simple1_adt:i1(), + if A < 3 -> ok end. % opaque term + +%% -type + +ty_cmp1() -> + A = ty_i1(), + if A > 3 -> ok end. % can never succeed + +ty_cmp2() -> + A = simple1_adt:ty_i1(), + if A > 3 -> ok end. % can never succeed + +ty_cmp3() -> + A = ty_i1(), + if A < 3 -> ok end. + +ty_cmp4() -> + A = simple1_adt:ty_i1(), + if A < 3 -> ok end. + +%% is_function + +f1() -> + T = n1(), + if is_function(T) -> ok end. % can never succeed + +f2() -> + T = n1(), + is_function(T). % ok + +adt_f1() -> + T = simple1_adt:n1(), + if is_function(T) -> ok end. % breaks the opaqueness + +adt_f2() -> + T = simple1_adt:n1(), + is_function(T). % breaks the opaqueness + +f3() -> + A = i1(), + T = n1(), + if is_function(T, A) -> ok end. % can never succeed + +f4() -> + A = i1(), + T = n1(), + is_function(T, A). % ok + +adt_f3() -> + A = simple1_adt:i1(), + T = simple1_adt:n1(), + if is_function(T, A) -> ok end. % breaks the opaqueness + +adt_f4() -> + A = simple1_adt:i1(), + T = simple1_adt:n1(), + is_function(T, A). % breaks the opaqueness + +adt_f4_a() -> + A = simple1_adt:i1(), + T = n1(), + is_function(T, A). % opaque term + + +adt_f4_b() -> + A = i1(), + T = simple1_adt:n1(), + is_function(T, A). % breaks the opaqueness + +%% A few Boolean examples + +bool_t1() -> + B = b2(), + if B -> ok end. % B =:= true can never succeed + +bool_t2() -> + A = b1(), + B = b2(), + if A and not B -> ok end. + +bool_t3() -> + A = b1(), + if not A -> ok end. % can never succeed + +bool_t4() -> + A = n1(), + if not ((A >= 1) and not (A < 1)) -> ok end. % can never succeed + +-spec bool_t5(i1()) -> integer(). + +bool_t5(A) -> + if [not (A > 1)] =:= + [false]-> 1 end. + +-spec bool_t6(b1()) -> integer(). + +bool_t6(A) -> + if [not A] =:= + [false]-> 1 end. + +-spec bool_t7() -> integer(). + +bool_t7() -> + A = i1(), + if [not A] =:= % cannot succeed + [false]-> 1 end. + +bool_adt_t1() -> + B = simple1_adt:b2(), + if B -> ok end. % opaque term + +bool_adt_t2() -> + A = simple1_adt:b1(), + B = simple1_adt:b2(), + if A and not B -> ok end. % opaque term + +-spec bool_adt_t5(simple1_adt:i1()) -> integer(). + +bool_adt_t5(A) -> + if [not (A > 1)] =:= % succ type of A is any() (type spec is OK) + [false]-> 1 end. + +-spec bool_adt_t6(simple1_adt:b1()) -> integer(). % invalid type spec + +bool_adt_t6(A) -> + if [not A] =:= % succ type of A is 'true' + [false]-> 1 end. + +-spec bool_t8() -> integer(). + +bool_t8() -> + A = i1(), + if [A and A] =:= % cannot succeed + [false]-> 1 end. + +-spec bool_adt_t8(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid + +bool_adt_t8(A, B) -> + if [A and B] =:= + [false]-> 1 end. + +-spec bool_t9() -> integer(). + +bool_t9() -> + A = i1(), + if [A or A] =:= % cannot succeed + [false]-> 1 end. + +-spec bool_adt_t9(simple1_adt:b1(), simple1_adt:b2()) -> integer(). % invalid + +bool_adt_t9(A, B) -> + if [A or B] =:= + [false]-> 1 end. + +-opaque b1() :: boolean(). + +-opaque b2() :: boolean(). + +-spec b1() -> b1(). + +b1() -> true. + +-spec b2() -> b2(). + +b2() -> false. + +%% Few (very few...) examples with bit syntax + +bit_t1() -> + A = i1(), + <<100:(A)>>. + +bit_adt_t1() -> + A = simple1_adt:i1(), + <<100:(A)>>. % breaks the opaqueness + +bit_t3(A) -> + B = i1(), + case none:none() of + <<A:B>> -> 1 + end. + +bit_adt_t2() -> + A = simple1_adt:i1(), + case <<"hej">> of + <<_:A>> -> ok % breaks the opaqueness (but the message is strange) + end. + + +bit_adt_t3(A) -> + B = simple1_adt:i1(), + case none:none() of + <<A: % breaks the opaqueness (the message is less than perfect) + B>> -> 1 + end. + +bit_t5(A) -> + B = o1(), + case none:none() of + <<A:B>> -> 1 % breaks the opaqueness + end. + +-spec bit_t4(<<_:1>>) -> integer(). + +bit_t4(A) -> + Sz = i1(), + case A of + <<_:Sz>> -> 1 + end. + +-spec bit_adt_t4(<<_:1>>) -> integer(). + +bit_adt_t4(A) -> + Sz = simple1_adt:i1(), + case A of + <<_:Sz>> -> 1 % breaks the opaqueness + end. + +bit_t5() -> + A = bit1(), + case A of + <<_/binary>> -> 1 + end. + +bit_adt_t5() -> + A = simple1_adt:bit1(), + case A of + <<_/binary>> -> 1 % breaks the opaqueness + end. + +-opaque bit1() :: binary(). + +-spec bit1() -> bit1(). + +bit1() -> + <<"hej">>. + +%% Calls with variable module or function + +call_f(A) -> + A = a(), + foo:A(A). + +call_f_adt(A) -> + A = simple1_adt:a(), + foo:A(A). % breaks the opaqueness + +call_m(A) -> + A = a(), + A:foo(A). + +call_m_adt(A) -> + A = simple1_adt:a(), + A:foo(A). % breaks the opaqueness + +-opaque a() :: atom(). + +-opaque i() :: integer(). + +-spec a() -> a(). + +a() -> + e. + +call_f_i(A) -> + A = i(), + foo:A(A). % A is not atom() but i() + +call_f_adt_i(A) -> + A = simple1_adt:i(), + foo:A(A). % A is not atom() but simple1_adt:i() + +call_m_i(A) -> + A = i(), + A:foo(A). % A is not atom() but i() + +call_m_adt_i(A) -> + A = simple1_adt:i(), + A:foo(A). % A is not atom() but simple1_adt:i() + +-spec eq1() -> integer(). + +eq1() -> + A = simple1_adt:d2(), + B = simple1_adt:d1(), + if + A == B -> % opaque term + 0; + A == A -> + 1; + A =:= A -> % compiler finds this one cannot match + 2; + true -> % compiler finds this one cannot match + 3 + end. + +eq2() -> + A = simple1_adt:d1(), + if + {A} >= {A} -> + 1; + A >= 3 -> % opaque term + 2; + A == 3 -> % opaque term + 3; + A =:= 3 -> % opaque term + 4; + A == A -> + 5; + A =:= A -> % compiler finds this one cannot match + 6 + end. + +c5() -> + A = simple1_adt:d1(), + A < 3. % opaque term + +c6(A, B) -> + A = simple1_adt:d1(), + B = simple1_adt:d1(), + A =< B. % same type - no warning + +c7(A, B) -> + A = simple1_adt:d1(), + B = simple1_adt:d2(), + A =< B. % opaque term + +c8() -> + D = digraph:new(), + E = ets:new(foo, []), + if {D, a} > {D, E} -> true; % OK + {1.0, 2} > {{D}, {E}} -> true; % OK + {D, 3} > {D, E} -> true % opaque term 2 + end. + +-spec i() -> i(). + +i() -> + 1. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl new file mode 100644 index 0000000000..c86f6fd0b5 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/simple/simple2_api.erl @@ -0,0 +1,125 @@ +-module(simple2_api). + +-export([c1/2, c2/0, c3/0, c4/1, c5/1, c6/0, c6_b/0, c7/0, c7_b/0, + c7_c/0, c8/0, c9/0, c10/0, c11/0, c12/0, c13/0, c14/0, c15/0, + c16/0, c17/0, c18/0, c19/0, c20/0, c21/0, c22/0, c23/0, + c24/0, c25/0, c26/0]). + +-spec c1(simple1_adt:d1(), simple1_adt:d2()) -> boolean(). + +c1(A, B) -> + {A} =< {B}. % succ type of A and B is any() + +c2() -> + A = simple1_adt:d1(), + erlang:make_tuple(1, A). % ok + +c3() -> + A = simple1_adt:d1(), + setelement(1, {A}, A). % ok + +c4(_) -> + A = simple1_adt:d1(), + halt(A). % ok (BIF fails...) + +c5(_) -> + A = simple1_adt:d1(), + [A] -- [A]. % ok + +c6() -> + A = simple1_adt:d1(), + A ! foo. % opaque term + +c6_b() -> + A = simple1_adt:d1(), + erlang:send(A, foo). % opaque term + +c7() -> + A = simple1_adt:d1(), + foo ! A. % ok + +c7_b() -> + A = simple1_adt:d1(), + erlang:send(foo, A). % ok + +c7_c() -> + A = simple1_adt:d1(), + erlang:send(foo, A, []). % ok + +c8() -> + A = simple1_adt:d1(), + A < 3. % opaque term + +c9() -> + A = simple1_adt:d1(), + lists:keysearch(A, 1, []). % ok + +c10() -> + A = simple1_adt:d1(), + lists:keysearch(1, A, []). % opaque term 2 + +c11() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [A]). % ok + +c12() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, A). % opaque term 3 + +c13() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [{A,2}]). % ok + +c14() -> + A = simple1_adt:tuple(), + lists:keysearch(key, 1, [{2,A}]). % ok + +c15() -> + A = simple1_adt:d1(), + lists:keysearch(key, 1, [A]). % ok + +c16() -> + A = simple1_adt:tuple(), + erlang:send(foo, A). % ok + +c17() -> + A = simple1_adt:tuple(), + lists:reverse([A]). % ok + +c18() -> + A = simple1_adt:tuple(), + lists:keyreplace(a, 1, [A], {1,2}). % ok + +c19() -> + A = simple1_adt:tuple(), + %% Problem. The spec says argument 4 is a tuple(). Fix that! + lists:keyreplace(a, 1, [{1,2}], A). % opaque term 4 + +c20() -> + A = simple1_adt:tuple(), + lists:flatten(A). % opaque term 1 + +c21() -> + A = simple1_adt:tuple(), + lists:flatten([[{A}]]). % ok + +c22() -> + A = simple1_adt:tuple(), + lists:flatten([[A]]). % ok + +c23() -> + A = simple1_adt:tuple(), + lists:flatten([A]). % ok + +c24() -> + A = simple1_adt:tuple(), + lists:flatten({A}). % will never return + +c25() -> + A = simple1_adt:d1(), + B = simple1_adt:tuple(), + if {A,3} > {A,B} -> true end. % opaque 2nd argument + +c26() -> + B = simple1_adt:tuple(), + tuple_to_list(B). % opaque term 1 diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl index 5ca3202bba..d88f238190 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/union/union_adt.erl @@ -1,10 +1,15 @@ -module(union_adt). -export([new/1, new_a/1, new_rec/1]). +%% Now (R17) that opaque types are no longer recognized by their shape +%% this test case is rather meaningless. + -record(rec, {x = 42 :: integer()}). -opaque u() :: 'aaa' | 'bbb' | #rec{}. +-spec new(_) -> u(). + new(a) -> aaa; new(b) -> bbb; new(X) when is_integer(X) -> @@ -13,7 +18,11 @@ new(X) when is_integer(X) -> %% the following two functions (and their uses in union_use.erl) test %% that the return type is the opaque one and not just a subtype of it +-spec new_a(_) -> u(). + new_a(a) -> aaa. +-spec new_rec(_) -> u(). + new_rec(X) when is_integer(X) -> #rec{x = X}. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl new file mode 100644 index 0000000000..c742990c6a --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_adt.erl @@ -0,0 +1,5 @@ +-module(zoltan_adt). + +-export_type([id/0]). + +-opaque id() :: string(). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl index b62b9de576..07c9f0a270 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/zoltan_kis3.erl @@ -2,13 +2,13 @@ -export([f/0, gen/0]). --opaque id() :: string(). +%-opaque id() :: string(). -spec f() -> char(). %% List pattern matching issue f() -> [H|_T] = gen(), H. --spec gen() -> id(). +-spec gen() -> zoltan_adt:id(). gen() -> "Dummy". diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index af32c5b901..95d2464e1d 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.6.1 +DIALYZER_VSN = 2.7 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 42c7e360c1..32a502e212 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -30,19 +30,17 @@ %-define(BITS, (hipe_rtl_arch:word_size() * 8) - ?TAG_IMMED1_SIZE). -define(BITS, 128). %This is only in bsl to convert answer to pos_inf/neg_inf. --define(TAG_IMMED1_SIZE, 4). +-export([type/3, type/4, type/5, arg_types/3, + is_known/3, opaque_args/5, infinity_add/2]). --export([type/3, type/4, arg_types/3, - is_known/3, structure_inspecting_args/3, infinity_add/2]). - --import(erl_types, [number_max/1, - number_min/1, +-import(erl_types, [number_max/2, + number_min/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_boolean/0, @@ -60,10 +58,11 @@ t_from_term/1, t_fun/0, t_fun/2, - t_fun_args/1, - t_fun_range/1, + t_fun_args/2, + t_fun_range/2, t_identifier/0, - t_inf/2, + t_has_opaque_subtype/2, + t_inf/3, t_integer/0, t_integer/1, t_non_neg_fixnum/0, @@ -71,30 +70,28 @@ t_pos_integer/0, t_integers/1, t_is_any/1, - t_is_atom/1, - t_is_binary/1, - t_is_bitstr/1, - t_is_boolean/1, - t_is_cons/1, - t_is_float/1, - t_is_float/1, - t_is_fun/1, - t_is_integer/1, - t_is_integer/1, - t_is_nil/1, + t_is_atom/2, + t_is_binary/2, + t_is_bitstr/2, + t_is_boolean/2, + t_is_cons/2, + t_is_float/2, + t_is_fun/2, + t_is_integer/2, + t_is_nil/1, t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, - t_is_number/1, - t_is_pid/1, - t_is_port/1, - t_is_maybe_improper_list/1, - t_is_reference/1, + t_is_number/2, + t_is_pid/2, + t_is_port/2, + t_is_maybe_improper_list/2, + t_is_reference/2, t_is_string/1, t_is_subtype/2, - t_is_tuple/1, + t_is_tuple/2, t_list/0, t_list/1, - t_list_elements/1, + t_list_elements/2, t_list_termination/1, t_mfa/0, t_module/0, @@ -104,7 +101,7 @@ t_nonempty_list/0, t_nonempty_list/1, t_number/0, - t_number_vals/1, + t_number_vals/2, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -115,9 +112,9 @@ t_sup/2, t_tuple/0, t_tuple/1, - t_tuple_args/1, - t_tuple_size/1, - t_tuple_subtypes/1 + t_tuple_args/2, + t_tuple_size/2, + t_tuple_subtypes/2 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -129,47 +126,61 @@ -spec type(atom(), atom(), arity()) -> erl_types:erl_type(). type(M, F, A) -> - type(M, F, A, any_list(A)). + type(M, F, A, any_list(A), []). %% Arguments should be checked for undefinedness, so we do not make %% unnecessary overapproximations. -spec type(atom(), atom(), arity(), [erl_types:erl_type()]) -> erl_types:erl_type(). +type(M, F, A, Xs) -> + type(M, F, A, Xs, 'universe'). + +-type opaques() :: 'universe' | [erl_types:erl_type()]. + +-type arg_types() :: [erl_types:erl_type()]. + +-spec type(atom(), atom(), arity(), arg_types(), opaques()) -> + erl_types:erl_type(). + %%-- erlang ------------------------------------------------------------------- -type(erlang, halt, 0, _) -> t_none(); -type(erlang, halt, 1, _) -> t_none(); -type(erlang, halt, 2, _) -> t_none(); -type(erlang, exit, 1, _) -> t_none(); -type(erlang, error, 1, _) -> t_none(); -type(erlang, error, 2, _) -> t_none(); -type(erlang, throw, 1, _) -> t_none(); -type(erlang, '==', 2, Xs = [X1, X2]) -> - case t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=:=', 2, Xs); +type(erlang, halt, 0, _, _) -> t_none(); +type(erlang, halt, 1, _, _) -> t_none(); +type(erlang, halt, 2, _, _) -> t_none(); +type(erlang, exit, 1, _, _) -> t_none(); +type(erlang, error, 1, _, _) -> t_none(); +type(erlang, error, 2, _, _) -> t_none(); +type(erlang, throw, 1, _, _) -> t_none(); +type(erlang, '==', 2, Xs = [X1, X2], Opaques) -> + case + t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + of + true -> type(erlang, '=:=', 2, Xs, Opaques); false -> - case t_is_integer(X1) andalso t_is_integer(X2) of - true -> type(erlang, '=:=', 2, Xs); - false -> strict(Xs, t_boolean()) + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of + true -> type(erlang, '=:=', 2, Xs, Opaques); + false -> strict2(Xs, t_boolean()) end end; -type(erlang, '/=', 2, Xs = [X1, X2]) -> - case t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=/=', 2, Xs); +type(erlang, '/=', 2, Xs = [X1, X2], Opaques) -> + case + t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + of + true -> type(erlang, '=/=', 2, Xs, Opaques); false -> - case t_is_integer(X1) andalso t_is_integer(X2) of - true -> type(erlang, '=/=', 2, Xs); - false -> strict(Xs, t_boolean()) + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of + true -> type(erlang, '=/=', 2, Xs, Opaques); + false -> strict2(Xs, t_boolean()) end end; -type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> +type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_none(t_inf(Lhs, Rhs)) of + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of true -> t_atom('false'); false -> - case t_is_atom(Lhs) andalso t_is_atom(Rhs) of + case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of true -> - case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of + case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[X], [X]} -> t_atom('true'); @@ -181,16 +192,20 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> end end; false -> - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case + t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + of false -> t_boolean(); true -> - case {t_number_vals(Lhs), t_number_vals(Rhs)} of + case + {t_number_vals(Lhs, Opaques), t_number_vals(Rhs, Opaques)} + of {[X], [X]} when is_integer(X) -> t_atom('true'); _ -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), @@ -205,15 +220,15 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> end end end, - strict(Xs, Ans); -type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_none(t_inf(Lhs, Rhs)) of + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of true -> t_atom('true'); false -> - case t_is_atom(Lhs) andalso t_is_atom(Rhs) of + case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of true -> - case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of + case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[Val], [Val]} -> t_atom('false'); @@ -221,13 +236,15 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> t_sup([t_from_term(X =/= Y) || X <- LhsVals, Y <- RhsVals]) end; false -> - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case + t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + of false -> t_boolean(); true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin) @@ -244,15 +261,15 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> end end end, - strict(Xs, Ans); -type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '>', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -260,17 +277,17 @@ type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F; true -> t_boolean() end; - false -> compare('>', Lhs, Rhs) + false -> compare('>', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '>=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -278,17 +295,17 @@ type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F; true -> t_boolean() end; - false -> compare('>=', Lhs, Rhs) + false -> compare('>=', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '<', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -296,17 +313,17 @@ type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F; true -> t_boolean() end; - false -> compare('<', Lhs, Rhs) + false -> compare('<', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '=<', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -314,232 +331,237 @@ type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F; true -> t_boolean() end; - false -> compare('=<', Lhs, Rhs) + false -> compare('=<', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '+', 1, Xs) -> - strict(arg_types(erlang, '+', 1), Xs, - fun ([X]) -> X end); -type(erlang, '-', 1, Xs) -> - strict(arg_types(erlang, '-', 1), Xs, + strict2(Xs, Ans); +type(erlang, '+', 1, Xs, Opaques) -> + strict(erlang, '+', 1, Xs, fun ([X]) -> X end, Opaques); +type(erlang, '-', 1, Xs, Opaques) -> + strict(erlang, '-', 1, Xs, fun ([X]) -> - case t_is_integer(X) of + case t_is_integer(X, Opaques) of true -> type(erlang, '-', 2, [t_integer(0), X]); false -> X end - end); -type(erlang, '!', 2, Xs) -> - strict(arg_types(erlang, '!', 2), Xs, fun ([_, X2]) -> X2 end); -type(erlang, '+', 2, Xs) -> - strict(arg_types(erlang, '+', 2), Xs, + end, Opaques); +type(erlang, '!', 2, Xs, Opaques) -> + strict(erlang, '!', 2, Xs, fun ([_, X2]) -> X2 end, Opaques); +type(erlang, '+', 2, Xs, Opaques) -> + strict(erlang, '+', 2, Xs, fun ([X1, X2]) -> - case arith('+', X1, X2) of + case arith('+', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '-', 2, Xs) -> - strict(arg_types(erlang, '-', 2), Xs, + end, Opaques); +type(erlang, '-', 2, Xs, Opaques) -> + strict(erlang, '-', 2, Xs, fun ([X1, X2]) -> - case arith('-', X1, X2) of + case arith('-', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '*', 2, Xs) -> - strict(arg_types(erlang, '*', 2), Xs, + end, Opaques); +type(erlang, '*', 2, Xs, Opaques) -> + strict(erlang, '*', 2, Xs, fun ([X1, X2]) -> - case arith('*', X1, X2) of + case arith('*', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '/', 2, Xs) -> - strict(arg_types(erlang, '/', 2), Xs, - fun (_) -> t_float() end); -type(erlang, 'div', 2, Xs) -> - strict(arg_types(erlang, 'div', 2), Xs, + end, Opaques); +type(erlang, '/', 2, Xs, Opaques) -> + strict(erlang, '/', 2, Xs, fun (_) -> t_float() end, Opaques); +type(erlang, 'div', 2, Xs, Opaques) -> + strict(erlang, 'div', 2, Xs, fun ([X1, X2]) -> - case arith('div', X1, X2) of + case arith('div', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); -type(erlang, 'rem', 2, Xs) -> - strict(arg_types(erlang, 'rem', 2), Xs, + end, Opaques); +type(erlang, 'rem', 2, Xs, Opaques) -> + strict(erlang, 'rem', 2, Xs, fun ([X1, X2]) -> - case arith('rem', X1, X2) of + case arith('rem', X1, X2, Opaques) of error -> t_non_neg_integer(); {ok, T} -> T end - end); -type(erlang, '++', 2, Xs) -> - strict(arg_types(erlang, '++', 2), Xs, + end, Opaques); +type(erlang, '++', 2, Xs, Opaques) -> + strict(erlang, '++', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1) of + case t_is_nil(X1, Opaques) of true -> X2; % even if X2 is not a list false -> - case t_is_nil(X2) of + case t_is_nil(X2, Opaques) of true -> X1; false -> - E1 = t_list_elements(X1), - case t_is_cons(X1) of + E1 = t_list_elements(X1, Opaques), + case t_is_cons(X1, Opaques) of true -> t_cons(E1, X2); false -> t_sup(X2, t_cons(E1, X2)) end end end - end); -type(erlang, '--', 2, Xs) -> + end, Opaques); +type(erlang, '--', 2, Xs, Opaques) -> %% We don't know which elements (if any) in X2 will be found and %% removed from X1, even if they would have the same type. Thus, we %% must assume that X1 can remain unchanged. However, if we succeed, %% we know that X1 must be a proper list, but the result could %% possibly be empty even if X1 is nonempty. - strict(arg_types(erlang, '--', 2), Xs, + strict(erlang, '--', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1) of + case t_is_nil(X1, Opaques) of true -> t_nil(); false -> - case t_is_nil(X2) of + case t_is_nil(X2, Opaques) of true -> X1; - false -> t_list(t_list_elements(X1)) + false -> t_list(t_list_elements(X1, Opaques)) end end - end); -type(erlang, 'and', 2, Xs) -> - strict(arg_types(erlang, 'and', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'or', 2, Xs) -> - strict(arg_types(erlang, 'or', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'xor', 2, Xs) -> - strict(arg_types(erlang, 'xor', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'not', 1, Xs) -> - strict(arg_types(erlang, 'not', 1), Xs, fun (_) -> t_boolean() end); -type(erlang, 'band', 2, Xs) -> - strict(arg_types(erlang, 'band', 2), Xs, + end, Opaques); +type(erlang, 'and', 2, Xs, Opaques) -> + strict(erlang, 'and', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'or', 2, Xs, Opaques) -> + strict(erlang, 'or', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'xor', 2, Xs, Opaques) -> + strict(erlang, 'xor', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'not', 1, Xs, Opaques) -> + strict(erlang, 'not', 1, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'band', 2, Xs, Opaques) -> + strict(erlang, 'band', 2, Xs, fun ([X1, X2]) -> - case arith('band', X1, X2) of + case arith('band', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the smallest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'band', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2), t_byte()) end); -type(erlang, 'bor', 2, Xs) -> - strict(arg_types(erlang, 'bor', 2), Xs, +%% strict(erlang, 'band', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2, Opaques), t_byte()) end, Opaques); +type(erlang, 'bor', 2, Xs, Opaques) -> + strict(erlang, 'bor', 2, Xs, fun ([X1, X2]) -> - case arith('bor', X1, X2) of + case arith('bor', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'bor', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); -type(erlang, 'bxor', 2, Xs) -> - strict(arg_types(erlang, 'bxor', 2), Xs, +%% strict(erlang, 'bor', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); +type(erlang, 'bxor', 2, Xs, Opaques) -> + strict(erlang, 'bxor', 2, Xs, fun ([X1, X2]) -> - case arith('bxor', X1, X2) of + case arith('bxor', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'bxor', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); -type(erlang, 'bsr', 2, Xs) -> - strict(arg_types(erlang, 'bsr', 2), Xs, +%% strict(erlang, 'bxor', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); +type(erlang, 'bsr', 2, Xs, Opaques) -> + strict(erlang, 'bsr', 2, Xs, fun ([X1, X2]) -> - case arith('bsr', X1, X2) of + case arith('bsr', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% If the first argument is unsigned (which is the case for %% characters and bytes), the result is never wider. We need to kill %% any value-sets in the result. -%% strict(arg_types(erlang, 'bsr', 2), Xs, -%% fun ([X, _]) -> t_sup(X, t_byte()) end); -type(erlang, 'bsl', 2, Xs) -> - strict(arg_types(erlang, 'bsl', 2), Xs, +%% strict(erlang, 'bsr', 2, Xs, +%% fun ([X, _]) -> t_sup(X, t_byte()) end, Opaques); +type(erlang, 'bsl', 2, Xs, Opaques) -> + strict(erlang, 'bsl', 2, Xs, fun ([X1, X2]) -> - case arith('bsl', X1, X2) of + case arith('bsl', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% Not worth doing anything special here. -%% strict(arg_types(erlang, 'bsl', 2), Xs, fun (_) -> t_integer() end); -type(erlang, 'bnot', 1, Xs) -> - strict(arg_types(erlang, 'bnot', 1), Xs, +%% strict(erlang, 'bsl', 2, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, 'bnot', 1, Xs, Opaques) -> + strict(erlang, 'bnot', 1, Xs, fun ([X1]) -> - case arith('bnot', X1) of + case arith('bnot', X1, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, abs, 1, Xs) -> - strict(arg_types(erlang, abs, 1), Xs, fun ([X]) -> X end); +type(erlang, abs, 1, Xs, Opaques) -> + strict(erlang, abs, 1, Xs, fun ([X]) -> X end, Opaques); %% This returns (-X)-1, so it often gives a negative result. -%% strict(arg_types(erlang, 'bnot', 1), Xs, fun (_) -> t_integer() end); -type(erlang, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias -type(erlang, apply, 2, Xs) -> +%% strict(erlang, 'bnot', 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias +type(erlang, apply, 2, Xs, Opaques) -> Fun = fun ([X, _Y]) -> - case t_is_fun(X) of + case t_is_fun(X, Opaques) of true -> - t_fun_range(X); + t_fun_range(X, Opaques); false -> t_any() end end, - strict(arg_types(erlang, apply, 2), Xs, Fun); -type(erlang, apply, 3, Xs) -> - strict(arg_types(erlang, apply, 3), Xs, fun (_) -> t_any() end); + strict(erlang, apply, 2, Xs, Fun, Opaques); +type(erlang, apply, 3, Xs, Opaques) -> + strict(erlang, apply, 3, Xs, fun (_) -> t_any() end, Opaques); %% Guard bif, needs to be here. -type(erlang, binary_part, 2, Xs) -> - strict(arg_types(erlang, binary_part, 2), Xs, fun (_) -> t_binary() end); +type(erlang, binary_part, 2, Xs, Opaques) -> + strict(erlang, binary_part, 2, Xs, fun (_) -> t_binary() end, Opaques); %% Guard bif, needs to be here. -type(erlang, binary_part, 3, Xs) -> - strict(arg_types(erlang, binary_part, 3), Xs, fun (_) -> t_binary() end); +type(erlang, binary_part, 3, Xs, Opaques) -> + strict(erlang, binary_part, 3, Xs, fun (_) -> t_binary() end, Opaques); %% Guard bif, needs to be here. -type(erlang, bit_size, 1, Xs) -> - strict(arg_types(erlang, bit_size, 1), Xs, - fun (_) -> t_non_neg_integer() end); +type(erlang, bit_size, 1, Xs, Opaques) -> + strict(erlang, bit_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, byte_size, 1, Xs) -> - strict(arg_types(erlang, byte_size, 1), Xs, - fun (_) -> t_non_neg_integer() end); -type(erlang, disconnect_node, 1, Xs) -> - strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end); +type(erlang, byte_size, 1, Xs, Opaques) -> + strict(erlang, byte_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); +type(erlang, disconnect_node, 1, Xs, Opaques) -> + strict(erlang, disconnect_node, 1, Xs, + fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end, Opaques); %% Guard bif, needs to be here. %% Also much more expressive than anything you could write in a spec... -type(erlang, element, 2, Xs) -> - strict(arg_types(erlang, element, 2), Xs, +type(erlang, element, 2, Xs, Opaques) -> + strict(erlang, element, 2, Xs, fun ([X1, X2]) -> - case t_tuple_subtypes(X2) of + case t_tuple_subtypes(X2, Opaques) of unknown -> t_any(); [_] -> - Sz = t_tuple_size(X2), - As = t_tuple_args(X2), - case t_number_vals(X1) of + Sz = t_tuple_size(X2, Opaques), + As = t_tuple_args(X2, Opaques), + case t_number_vals(X1, Opaques) of unknown -> t_sup(As); Ns when is_list(Ns) -> Fun = fun @@ -553,165 +575,161 @@ type(erlang, element, 2, Xs) -> Ts when is_list(Ts) -> t_sup([type(erlang, element, 2, [X1, Y]) || Y <- Ts]) end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, float, 1, Xs) -> - strict(arg_types(erlang, float, 1), Xs, fun (_) -> t_float() end); -type(erlang, fun_info, 1, Xs) -> - strict(arg_types(erlang, fun_info, 1), Xs, - fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end); -type(erlang, get_cookie, 0, _) -> t_atom(); % | t_atom('nocookie') +type(erlang, float, 1, Xs, Opaques) -> + strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques); +type(erlang, fun_info, 1, Xs, Opaques) -> + strict(erlang, fun_info, 1, Xs, + fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end, Opaques); +type(erlang, get_cookie, 0, _, _Opaques) -> t_atom(); % | t_atom('nocookie') %% Guard bif, needs to be here. -type(erlang, hd, 1, Xs) -> - strict(arg_types(erlang, hd, 1), Xs, fun ([X]) -> t_cons_hd(X) end); -type(erlang, integer_to_list, 2, Xs) -> - strict(arg_types(erlang, integer_to_list, 2), Xs, - fun (_) -> t_string() end); -type(erlang, info, 1, Xs) -> type(erlang, system_info, 1, Xs); % alias +type(erlang, hd, 1, Xs, Opaques) -> + strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques); +type(erlang, integer_to_list, 2, Xs, Opaques) -> + strict(erlang, integer_to_list, 2, Xs, + fun (_) -> t_string() end, Opaques); +type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias %% All type tests are guard BIF's and may be implemented in ways that %% cannot be expressed in a type spec, why they are kept in erl_bif_types. -type(erlang, is_atom, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_atom(Y) end, t_atom()) end, - strict(arg_types(erlang, is_atom, 1), Xs, Fun); -type(erlang, is_binary, 1, Xs) -> +type(erlang, is_atom, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_atom(Y, Opaques) end, + t_atom(), Opaques) + end, + strict(erlang, is_atom, 1, Xs, Fun, Opaques); +type(erlang, is_binary, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_binary(Y) end, t_binary()) + check_guard(X, fun (Y) -> t_is_binary(Y, Opaques) end, + t_binary(), Opaques) end, - strict(arg_types(erlang, is_binary, 1), Xs, Fun); -type(erlang, is_bitstring, 1, Xs) -> + strict(erlang, is_binary, 1, Xs, Fun, Opaques); +type(erlang, is_bitstring, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_bitstr(Y) end, t_bitstr()) + check_guard(X, fun (Y) -> t_is_bitstr(Y, Opaques) end, + t_bitstr(), Opaques) end, - strict(arg_types(erlang, is_bitstring, 1), Xs, Fun); -type(erlang, is_boolean, 1, Xs) -> + strict(erlang, is_bitstring, 1, Xs, Fun, Opaques); +type(erlang, is_boolean, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_boolean(Y) end, t_boolean()) + check_guard(X, fun (Y) -> t_is_boolean(Y, Opaques) end, + t_boolean(), Opaques) end, - strict(arg_types(erlang, is_boolean, 1), Xs, Fun); -type(erlang, is_float, 1, Xs) -> + strict(erlang, is_boolean, 1, Xs, Fun, Opaques); +type(erlang, is_float, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_float(Y) end, t_float()) + check_guard(X, fun (Y) -> t_is_float(Y, Opaques) end, + t_float(), Opaques) end, - strict(arg_types(erlang, is_float, 1), Xs, Fun); -type(erlang, is_function, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_fun(Y) end, t_fun()) end, - strict(arg_types(erlang, is_function, 1), Xs, Fun); -type(erlang, is_function, 2, Xs) -> + strict(erlang, is_float, 1, Xs, Fun, Opaques); +type(erlang, is_function, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_fun(Y, Opaques) end, + t_fun(), Opaques) + end, + strict(erlang, is_function, 1, Xs, Fun, Opaques); +type(erlang, is_function, 2, Xs, Opaques) -> Fun = fun ([FunType, ArityType]) -> - case t_number_vals(ArityType) of + case t_number_vals(ArityType, Opaques) of unknown -> t_boolean(); [Val] -> FunConstr = t_fun(any_list(Val), t_any()), Fun2 = fun (X) -> t_is_subtype(X, FunConstr) andalso (not t_is_none(X)) end, - check_guard_single(FunType, Fun2, FunConstr); + check_guard_single(FunType, Fun2, FunConstr, Opaques); IntList when is_list(IntList) -> t_boolean() %% true? end end, - strict(arg_types(erlang, is_function, 2), Xs, Fun); -type(erlang, is_integer, 1, Xs) -> + strict(erlang, is_function, 2, Xs, Fun, Opaques); +type(erlang, is_integer, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_integer(Y) end, t_integer()) + check_guard(X, fun (Y) -> t_is_integer(Y, Opaques) end, + t_integer(), Opaques) end, - strict(arg_types(erlang, is_integer, 1), Xs, Fun); -type(erlang, is_list, 1, Xs) -> + strict(erlang, is_integer, 1, Xs, Fun, Opaques); +type(erlang, is_list, 1, Xs, Opaques) -> Fun = fun (X) -> - Fun2 = fun (Y) -> t_is_maybe_improper_list(Y) end, - check_guard(X, Fun2, t_maybe_improper_list()) + Fun2 = fun (Y) -> t_is_maybe_improper_list(Y, Opaques) end, + check_guard(X, Fun2, t_maybe_improper_list(), Opaques) end, - strict(arg_types(erlang, is_list, 1), Xs, Fun); -type(erlang, is_number, 1, Xs) -> + strict(erlang, is_list, 1, Xs, Fun, Opaques); +type(erlang, is_number, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_number(Y) end, t_number()) + check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, + t_number(), Opaques) end, - strict(arg_types(erlang, is_number, 1), Xs, Fun); -type(erlang, is_pid, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_pid(Y) end, t_pid()) end, - strict(arg_types(erlang, is_pid, 1), Xs, Fun); -type(erlang, is_port, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_port(Y) end, t_port()) end, - strict(arg_types(erlang, is_port, 1), Xs, Fun); -type(erlang, is_record, 2, Xs) -> + strict(erlang, is_number, 1, Xs, Fun, Opaques); +type(erlang, is_pid, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_pid(Y, Opaques) end, + t_pid(), Opaques) + end, + strict(erlang, is_pid, 1, Xs, Fun, Opaques); +type(erlang, is_port, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_port(Y, Opaques) end, + t_port(), Opaques) + end, + strict(erlang, is_port, 1, Xs, Fun, Opaques); +type(erlang, is_record, 2, Xs, Opaques) -> Fun = fun ([X, Y]) -> - case t_is_tuple(X) of + case t_is_tuple(X, Opaques) of false -> - case t_is_none(t_inf(t_tuple(), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; true -> - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple) of + case t_tuple_args(Tuple, Opaques) of %% any -> t_boolean(); - [Tag|_] -> - case t_is_atom(Tag) of - false -> - TagAtom = t_inf(Tag, t_atom()), - case t_is_none(TagAtom) of - true -> t_atom('false'); - false -> t_boolean() - end; - true -> - case t_atom_vals(Tag) of - [RealTag] -> - case t_atom_vals(Y) of - [RealTag] -> t_atom('true'); - _ -> t_boolean() - end; - _ -> t_boolean() - end - end + [Tag|_] -> check_record_tag(Tag, Y, Opaques) end; List when length(List) >= 2 -> t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List]) end end end, - strict(arg_types(erlang, is_record, 2), Xs, Fun); -type(erlang, is_record, 3, Xs) -> + strict(erlang, is_record, 2, Xs, Fun, Opaques); +type(erlang, is_record, 3, Xs, Opaques) -> Fun = fun ([X, Y, Z]) -> - Arity = t_number_vals(Z), - case t_is_tuple(X) of + Arity = t_number_vals(Z, Opaques), + case t_is_tuple(X, Opaques) of false when length(Arity) =:= 1 -> [RealArity] = Arity, - case t_is_none(t_inf(t_tuple(RealArity), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(RealArity), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; false -> - case t_is_none(t_inf(t_tuple(), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; true when length(Arity) =:= 1 -> [RealArity] = Arity, - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple) of + case t_tuple_args(Tuple, Opaques) of %% any -> t_boolean(); Args when length(Args) =:= RealArity -> - Tag = hd(Args), - case t_is_atom(Tag) of - false -> - TagAtom = t_inf(Tag, t_atom()), - case t_is_none(TagAtom) of - true -> t_atom('false'); - false -> t_boolean() - end; - true -> - case t_atom_vals(Tag) of - [RealTag] -> - case t_atom_vals(Y) of - [RealTag] -> t_atom('true'); - _ -> t_boolean() - end; - _ -> t_boolean() - end - end; + check_record_tag(hd(Args), Y, Opaques); Args when length(Args) =/= RealArity -> t_atom('false') end; @@ -722,62 +740,66 @@ type(erlang, is_record, 3, Xs) -> t_boolean() end end, - strict(arg_types(erlang, is_record, 3), Xs, Fun); -type(erlang, is_reference, 1, Xs) -> + strict(erlang, is_record, 3, Xs, Fun, Opaques); +type(erlang, is_reference, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_reference(Y) end, t_reference()) + check_guard(X, fun (Y) -> t_is_reference(Y, Opaques) end, + t_reference(), Opaques) end, - strict(arg_types(erlang, is_reference, 1), Xs, Fun); -type(erlang, is_tuple, 1, Xs) -> + strict(erlang, is_reference, 1, Xs, Fun, Opaques); +type(erlang, is_tuple, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_tuple(Y) end, t_tuple()) + check_guard(X, fun (Y) -> t_is_tuple(Y, Opaques) end, + t_tuple(), Opaques) end, - strict(arg_types(erlang, is_tuple, 1), Xs, Fun); + strict(erlang, is_tuple, 1, Xs, Fun, Opaques); %% Guard bif, needs to be here. -type(erlang, length, 1, Xs) -> - strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end); -type(erlang, make_tuple, 2, Xs) -> - strict(arg_types(erlang, make_tuple, 2), Xs, +type(erlang, length, 1, Xs, Opaques) -> + strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); +type(erlang, make_tuple, 2, Xs, Opaques) -> + strict(erlang, make_tuple, 2, Xs, fun ([Int, _]) -> - case t_number_vals(Int) of + case t_number_vals(Int, Opaques) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end); -type(erlang, make_tuple, 3, Xs) -> - strict(arg_types(erlang, make_tuple, 3), Xs, + end, Opaques); +type(erlang, make_tuple, 3, Xs, Opaques) -> + strict(erlang, make_tuple, 3, Xs, fun ([Int, _, _]) -> - case t_number_vals(Int) of + case t_number_vals(Int, Opaques) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end); -type(erlang, memory, 0, _) -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()])); -type(erlang, nif_error, 1, _) -> - t_any(); % this BIF and the next one are stubs for NIFs and never return -type(erlang, nif_error, 2, Xs) -> - strict(arg_types(erlang, nif_error, 2), Xs, fun (_) -> t_any() end); + end, Opaques); +type(erlang, memory, 0, _, _Opaques) -> + t_list(t_tuple([t_atom(), t_non_neg_fixnum()])); +type(erlang, nif_error, 1, Xs, Opaques) -> + %% this BIF and the next one are stubs for NIFs and never return + strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques); +type(erlang, nif_error, 2, Xs, Opaques) -> + strict(erlang, nif_error, 2, Xs, fun (_) -> t_any() end, Opaques); %% Guard bif, needs to be here. -type(erlang, node, 0, _) -> t_node(); +type(erlang, node, 0, _, _Opaques) -> t_node(); %% Guard bif, needs to be here. -type(erlang, node, 1, Xs) -> - strict(arg_types(erlang, node, 1), Xs, fun (_) -> t_node() end); +type(erlang, node, 1, Xs, Opaques) -> + strict(erlang, node, 1, Xs, fun (_) -> t_node() end, Opaques); %% Guard bif, needs to be here. -type(erlang, round, 1, Xs) -> - strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end); +type(erlang, round, 1, Xs, Opaques) -> + strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, self, 0, _) -> t_pid(); -type(erlang, set_cookie, 2, Xs) -> - strict(arg_types(erlang, set_cookie, 2), Xs, fun (_) -> t_atom('true') end); -type(erlang, setelement, 3, Xs) -> - strict(arg_types(erlang, setelement, 3), Xs, +type(erlang, self, 0, _, _Opaques) -> t_pid(); +type(erlang, set_cookie, 2, Xs, Opaques) -> + strict(erlang, set_cookie, 2, Xs, fun (_) -> t_atom('true') end, Opaques); +type(erlang, setelement, 3, Xs, Opaques) -> + strict(erlang, setelement, 3, Xs, fun ([X1, X2, X3]) -> - case t_tuple_subtypes(X2) of + case t_tuple_subtypes(X2, Opaques) of unknown -> t_tuple(); [_] -> - Sz = t_tuple_size(X2), - As = t_tuple_args(X2), - case t_number_vals(X1) of + Sz = t_tuple_size(X2, Opaques), + As = t_tuple_args(X2, Opaques), + case t_number_vals(X1, Opaques) of unknown -> t_tuple([t_sup(X, X3) || X <- As]); [N] when is_integer(N), 1 =< N, N =< Sz -> @@ -799,29 +821,29 @@ type(erlang, setelement, 3, Xs) -> Ts when is_list(Ts) -> t_sup([type(erlang, setelement, 3, [X1, Y, X3]) || Y <- Ts]) end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, size, 1, Xs) -> - strict(arg_types(erlang, size, 1), Xs, fun (_) -> t_non_neg_integer() end); -type(erlang, spawn, 1, Xs) -> - strict(arg_types(erlang, spawn, 1), Xs, fun (_) -> t_pid() end); -type(erlang, spawn, 2, Xs) -> - strict(arg_types(erlang, spawn, 2), Xs, fun (_) -> t_pid() end); -type(erlang, spawn, 4, Xs) -> - strict(arg_types(erlang, spawn, 4), Xs, fun (_) -> t_pid() end); -type(erlang, spawn_link, 1, Xs) -> type(erlang, spawn, 1, Xs); % same -type(erlang, spawn_link, 2, Xs) -> type(erlang, spawn, 2, Xs); % same -type(erlang, spawn_link, 4, Xs) -> type(erlang, spawn, 4, Xs); % same -type(erlang, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias -type(erlang, suspend_process, 1, Xs) -> - strict(arg_types(erlang, suspend_process, 1), Xs, - fun (_) -> t_atom('true') end); -type(erlang, system_info, 1, Xs) -> - strict(arg_types(erlang, system_info, 1), Xs, +type(erlang, size, 1, Xs, Opaques) -> + strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); +type(erlang, spawn, 1, Xs, Opaques) -> + strict(erlang, spawn, 1, Xs, fun (_) -> t_pid() end, Opaques); +type(erlang, spawn, 2, Xs, Opaques) -> + strict(erlang, spawn, 2, Xs, fun (_) -> t_pid() end, Opaques); +type(erlang, spawn, 4, Xs, Opaques) -> + strict(erlang, spawn, 4, Xs, fun (_) -> t_pid() end, Opaques); +type(erlang, spawn_link, 1, Xs, _) -> type(erlang, spawn, 1, Xs); % same +type(erlang, spawn_link, 2, Xs, _) -> type(erlang, spawn, 2, Xs); % same +type(erlang, spawn_link, 4, Xs, _) -> type(erlang, spawn, 4, Xs); % same +type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias +type(erlang, suspend_process, 1, Xs, Opaques) -> + strict(erlang, suspend_process, 1, Xs, + fun (_) -> t_atom('true') end, Opaques); +type(erlang, system_info, 1, Xs, Opaques) -> + strict(erlang, system_info, 1, Xs, fun ([Type]) -> - case t_is_atom(Type) of + case t_is_atom(Type, Opaques) of true -> - case t_atom_vals(Type) of + case t_atom_vals(Type, Opaques) of ['allocated_areas'] -> t_list(t_sup([t_tuple([t_atom(),t_non_neg_integer()]), t_tuple([t_atom(), @@ -936,26 +958,28 @@ type(erlang, system_info, 1, Xs) -> false -> %% This currently handles only {allocator, Alloc} t_any() %% overapproximation as the return value might change end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, tl, 1, Xs) -> - strict(arg_types(erlang, tl, 1), Xs, fun ([X]) -> t_cons_tl(X) end); +type(erlang, tl, 1, Xs, Opaques) -> + strict(erlang, tl, 1, Xs, fun ([X]) -> t_cons_tl(X) end, Opaques); %% Guard bif, needs to be here. -type(erlang, trunc, 1, Xs) -> - strict(arg_types(erlang, trunc, 1), Xs, fun (_) -> t_integer() end); +type(erlang, trunc, 1, Xs, Opaques) -> + strict(erlang, trunc, 1, Xs, fun (_) -> t_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, tuple_size, 1, Xs) -> - strict(arg_types(erlang, tuple_size, 1), Xs, fun (_) -> t_non_neg_integer() end); -type(erlang, tuple_to_list, 1, Xs) -> - strict(arg_types(erlang, tuple_to_list, 1), Xs, +type(erlang, tuple_size, 1, Xs, Opaques) -> + strict(erlang, tuple_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); +type(erlang, tuple_to_list, 1, Xs, Opaques) -> + strict(erlang, tuple_to_list, 1, Xs, fun ([X]) -> - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_list(); SubTypes -> - Args = lists:flatten([t_tuple_args(ST) || ST <- SubTypes]), + Args = lists:append([t_tuple_args(ST, Opaques) || + ST <- SubTypes]), %% Can be nil if the tuple can be {} case lists:any(fun (T) -> - t_tuple_size(T) =:= 0 + t_tuple_size(T, Opaques) =:= 0 end, SubTypes) of true -> %% Be careful here. If we had only {} we need to @@ -965,279 +989,284 @@ type(erlang, tuple_to_list, 1, Xs) -> t_nonempty_list(t_sup(Args)) end end - end); -type(erlang, yield, 0, _) -> t_atom('true'); + end, Opaques); +type(erlang, yield, 0, _, _Opaques) -> t_atom('true'); %%-- ets ---------------------------------------------------------------------- -type(ets, rename, 2, Xs) -> - strict(arg_types(ets, rename, 2), Xs, fun ([_, Name]) -> Name end); +type(ets, rename, 2, Xs, Opaques) -> + strict(ets, rename, 2, Xs, fun ([_, Name]) -> Name end, Opaques); %%-- hipe_bifs ---------------------------------------------------------------- -type(hipe_bifs, add_ref, 2, Xs) -> - strict(arg_types(hipe_bifs, add_ref, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, alloc_data, 2, Xs) -> - strict(arg_types(hipe_bifs, alloc_data, 2), Xs, - fun (_) -> t_integer() end); % address -type(hipe_bifs, array, 2, Xs) -> - strict(arg_types(hipe_bifs, array, 2), Xs, fun (_) -> t_immarray() end); -type(hipe_bifs, array_length, 1, Xs) -> - strict(arg_types(hipe_bifs, array_length, 1), Xs, - fun (_) -> t_non_neg_fixnum() end); -type(hipe_bifs, array_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, array_sub, 2), Xs, fun (_) -> t_immediate() end); -type(hipe_bifs, array_update, 3, Xs) -> - strict(arg_types(hipe_bifs, array_update, 3), Xs, - fun (_) -> t_immarray() end); -type(hipe_bifs, atom_to_word, 1, Xs) -> - strict(arg_types(hipe_bifs, atom_to_word, 1), Xs, - fun (_) -> t_integer() end); -type(hipe_bifs, bif_address, 3, Xs) -> - strict(arg_types(hipe_bifs, bif_address, 3), Xs, - fun (_) -> t_sup(t_integer(), t_atom('false')) end); -type(hipe_bifs, bitarray, 2, Xs) -> - strict(arg_types(hipe_bifs, bitarray, 2), Xs, fun (_) -> t_bitarray() end); -type(hipe_bifs, bitarray_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, bitarray_sub, 2), Xs, fun (_) -> t_boolean() end); -type(hipe_bifs, bitarray_update, 3, Xs) -> - strict(arg_types(hipe_bifs, bitarray_update, 3), Xs, - fun (_) -> t_bitarray() end); -type(hipe_bifs, bytearray, 2, Xs) -> - strict(arg_types(hipe_bifs, bytearray, 2), Xs, fun (_) -> t_bytearray() end); -type(hipe_bifs, bytearray_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, bytearray_sub, 2), Xs, fun (_) -> t_byte() end); -type(hipe_bifs, bytearray_update, 3, Xs) -> - strict(arg_types(hipe_bifs, bytearray_update, 3), Xs, - fun (_) -> t_bytearray() end); -type(hipe_bifs, call_count_clear, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_clear, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_get, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_get, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_off, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_off, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_on, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_on, 1), Xs, - fun (_) -> t_sup(t_atom('true'), t_nil()) end); -type(hipe_bifs, check_crc, 1, Xs) -> - strict(arg_types(hipe_bifs, check_crc, 1), Xs, fun (_) -> t_boolean() end); -type(hipe_bifs, enter_code, 2, Xs) -> - strict(arg_types(hipe_bifs, enter_code, 2), Xs, +type(hipe_bifs, add_ref, 2, Xs, Opaques) -> + strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, alloc_data, 2, Xs, Opaques) -> + strict(hipe_bifs, alloc_data, 2, Xs, + fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, array, 2, Xs, Opaques) -> + strict(hipe_bifs, array, 2, Xs, fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, array_length, 1, Xs, Opaques) -> + strict(hipe_bifs, array_length, 1, Xs, + fun (_) -> t_non_neg_fixnum() end, Opaques); +type(hipe_bifs, array_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, array_sub, 2, Xs, fun (_) -> t_immediate() end, Opaques); +type(hipe_bifs, array_update, 3, Xs, Opaques) -> + strict(hipe_bifs, array_update, 3, Xs, + fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, atom_to_word, 1, Xs, Opaques) -> + strict(hipe_bifs, atom_to_word, 1, Xs, + fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, bif_address, 3, Xs, Opaques) -> + strict(hipe_bifs, bif_address, 3, Xs, + fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, bitarray, 2, Xs, Opaques) -> + strict(hipe_bifs, bitarray, 2, Xs, fun (_) -> t_bitarray() end, Opaques); +type(hipe_bifs, bitarray_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, bitarray_sub, 2, Xs, + fun (_) -> t_boolean() end, Opaques); +type(hipe_bifs, bitarray_update, 3, Xs, Opaques) -> + strict(hipe_bifs, bitarray_update, 3, Xs, + fun (_) -> t_bitarray() end, Opaques); +type(hipe_bifs, bytearray, 2, Xs, Opaques) -> + strict(hipe_bifs, bytearray, 2, Xs, fun (_) -> t_bytearray() end, Opaques); +type(hipe_bifs, bytearray_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, bytearray_sub, 2, Xs, fun (_) -> t_byte() end, Opaques); +type(hipe_bifs, bytearray_update, 3, Xs, Opaques) -> + strict(hipe_bifs, bytearray_update, 3, Xs, + fun (_) -> t_bytearray() end, Opaques); +type(hipe_bifs, call_count_clear, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_clear, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_get, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_get, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_off, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_off, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_on, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_on, 1, Xs, + fun (_) -> t_sup(t_atom('true'), t_nil()) end, Opaques); +type(hipe_bifs, check_crc, 1, Xs, Opaques) -> + strict(hipe_bifs, check_crc, 1, Xs, fun (_) -> t_boolean() end, Opaques); +type(hipe_bifs, enter_code, 2, Xs, Opaques) -> + strict(hipe_bifs, enter_code, 2, Xs, fun (_) -> t_tuple([t_integer(), %% XXX: The tuple below contains integers and %% is of size same as the length of the MFA list - t_sup(t_nil(), t_binary())]) end); -type(hipe_bifs, enter_sdesc, 1, Xs) -> - strict(arg_types(hipe_bifs, enter_sdesc, 1), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, find_na_or_make_stub, 2, Xs) -> - strict(arg_types(hipe_bifs, find_na_or_make_stub, 2), Xs, - fun (_) -> t_integer() end); % address -type(hipe_bifs, fun_to_address, 1, Xs) -> - strict(arg_types(hipe_bifs, fun_to_address, 1), Xs, - fun (_) -> t_integer() end); -%% type(hipe_bifs, get_emu_address, 1, Xs) -> -%% strict(arg_types(hipe_bifs, get_emu_address, 1), Xs, -%% fun (_) -> t_integer() end); % address -type(hipe_bifs, get_rts_param, 1, Xs) -> - strict(arg_types(hipe_bifs, get_rts_param, 1), Xs, - fun (_) -> t_sup(t_integer(), t_nil()) end); -type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs) -> - strict(arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, make_fe, 3, Xs) -> - strict(arg_types(hipe_bifs, make_fe, 3), Xs, fun (_) -> t_integer() end); -%% type(hipe_bifs, make_native_stub, 2, Xs) -> -%% strict(arg_types(hipe_bifs, make_native_stub, 2), Xs, -%% fun (_) -> t_integer() end); % address -type(hipe_bifs, mark_referred_from, 1, Xs) -> - strict(arg_types(hipe_bifs, mark_referred_from, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, merge_term, 1, Xs) -> - strict(arg_types(hipe_bifs, merge_term, 1), Xs, fun ([X]) -> X end); -type(hipe_bifs, nstack_used_size, 0, _) -> + t_sup(t_nil(), t_binary())]) end, Opaques); +type(hipe_bifs, enter_sdesc, 1, Xs, Opaques) -> + strict(hipe_bifs, enter_sdesc, 1, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, find_na_or_make_stub, 2, Xs, Opaques) -> + strict(hipe_bifs, find_na_or_make_stub, 2, Xs, + fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, fun_to_address, 1, Xs, Opaques) -> + strict(hipe_bifs, fun_to_address, 1, Xs, + fun (_) -> t_integer() end, Opaques); +%% type(hipe_bifs, get_emu_address, 1, Xs, Opaques) -> +%% strict(hipe_bifs, get_emu_address, 1, Xs, +%% fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, get_rts_param, 1, Xs, Opaques) -> + strict(hipe_bifs, get_rts_param, 1, Xs, + fun (_) -> t_sup(t_integer(), t_nil()) end, Opaques); +type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, Opaques) -> + strict(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, make_fe, 3, Xs, Opaques) -> + strict(hipe_bifs, make_fe, 3, Xs, fun (_) -> t_integer() end, Opaques); +%% type(hipe_bifs, make_native_stub, 2, Xs, Opaques) -> +%% strict(hipe_bifs, make_native_stub, 2, Xs, +%% fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, mark_referred_from, 1, Xs, Opaques) -> + strict(hipe_bifs, mark_referred_from, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, merge_term, 1, Xs, Opaques) -> + strict(hipe_bifs, merge_term, 1, Xs, fun ([X]) -> X end, Opaques); +type(hipe_bifs, nstack_used_size, 0, _, _Opaques) -> t_non_neg_fixnum(); -type(hipe_bifs, patch_call, 3, Xs) -> - strict(arg_types(hipe_bifs, patch_call, 3), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, patch_insn, 3, Xs) -> - strict(arg_types(hipe_bifs, patch_insn, 3), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, primop_address, 1, Xs) -> - strict(arg_types(hipe_bifs, primop_address, 1), Xs, - fun (_) -> t_sup(t_integer(), t_atom('false')) end); -type(hipe_bifs, redirect_referred_from, 1, Xs) -> - strict(arg_types(hipe_bifs, redirect_referred_from, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, ref, 1, Xs) -> - strict(arg_types(hipe_bifs, ref, 1), Xs, fun (_) -> t_immarray() end); -type(hipe_bifs, ref_get, 1, Xs) -> - strict(arg_types(hipe_bifs, ref_get, 1), Xs, fun (_) -> t_immediate() end); -type(hipe_bifs, ref_set, 2, Xs) -> - strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, remove_refs_from, 1, Xs) -> - strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs, - fun (_) -> t_atom('ok') end); -type(hipe_bifs, set_funinfo_native_address, 3, Xs) -> - strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, set_native_address, 3, Xs) -> - strict(arg_types(hipe_bifs, set_native_address, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, system_crc, 1, Xs) -> - strict(arg_types(hipe_bifs, system_crc, 1), Xs, fun (_) -> t_crc32() end); -type(hipe_bifs, term_to_word, 1, Xs) -> - strict(arg_types(hipe_bifs, term_to_word, 1), Xs, - fun (_) -> t_integer() end); -type(hipe_bifs, update_code_size, 3, Xs) -> - strict(arg_types(hipe_bifs, update_code_size, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, write_u8, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u8, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, write_u32, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u32, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, write_u64, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u64, 2), Xs, fun (_) -> t_nil() end); +type(hipe_bifs, patch_call, 3, Xs, Opaques) -> + strict(hipe_bifs, patch_call, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, patch_insn, 3, Xs, Opaques) -> + strict(hipe_bifs, patch_insn, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, primop_address, 1, Xs, Opaques) -> + strict(hipe_bifs, primop_address, 1, Xs, + fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, redirect_referred_from, 1, Xs, Opaques) -> + strict(hipe_bifs, redirect_referred_from, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, ref, 1, Xs, Opaques) -> + strict(hipe_bifs, ref, 1, Xs, fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, ref_get, 1, Xs, Opaques) -> + strict(hipe_bifs, ref_get, 1, Xs, fun (_) -> t_immediate() end, Opaques); +type(hipe_bifs, ref_set, 2, Xs, Opaques) -> + strict(hipe_bifs, ref_set, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, remove_refs_from, 1, Xs, Opaques) -> + strict(hipe_bifs, remove_refs_from, 1, Xs, + fun (_) -> t_atom('ok') end, Opaques); +type(hipe_bifs, set_funinfo_native_address, 3, Xs, Opaques) -> + strict(hipe_bifs, set_funinfo_native_address, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, set_native_address, 3, Xs, Opaques) -> + strict(hipe_bifs, set_native_address, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, system_crc, 1, Xs, Opaques) -> + strict(hipe_bifs, system_crc, 1, Xs, fun (_) -> t_crc32() end, Opaques); +type(hipe_bifs, term_to_word, 1, Xs, Opaques) -> + strict(hipe_bifs, term_to_word, 1, Xs, + fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, update_code_size, 3, Xs, Opaques) -> + strict(hipe_bifs, update_code_size, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u8, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u8, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u32, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u32, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u64, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u64, 2, Xs, fun (_) -> t_nil() end, Opaques); %%-- lists -------------------------------------------------------------------- -type(lists, all, 2, Xs) -> - strict(arg_types(lists, all, 2), Xs, +type(lists, all, 2, Xs, Opaques) -> + strict(lists, all, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_atom('true'); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of ok -> - case t_is_cons(L) of - true -> t_fun_range(F); + case t_is_cons(L, Opaques) of + true -> t_fun_range(F, Opaques); false -> %% The list can be empty. - t_sup(t_atom('true'), t_fun_range(F)) + t_sup(t_atom('true'), t_fun_range(F, Opaques)) end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); - false -> t_fun_range(F) + false -> t_fun_range(F, Opaques) end end end - end); -type(lists, any, 2, Xs) -> - strict(arg_types(lists, any, 2), Xs, + end, Opaques); +type(lists, any, 2, Xs, Opaques) -> + strict(lists, any, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_atom('false'); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of ok -> - case t_is_cons(L) of - true -> t_fun_range(F); + case t_is_cons(L, Opaques) of + true -> t_fun_range(F, Opaques); false -> %% The list can be empty - t_sup(t_atom('false'), t_fun_range(F)) + t_sup(t_atom('false'), t_fun_range(F, Opaques)) end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); - false -> t_fun_range(F) + false -> t_fun_range(F, Opaques) end end end - end); -type(lists, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias -type(lists, delete, 2, Xs) -> - strict(arg_types(lists, delete, 2), Xs, + end, Opaques); +type(lists, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias +type(lists, delete, 2, Xs, Opaques) -> + strict(lists, delete, 2, Xs, fun ([_, List]) -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_cons_tl(List); false -> List end - end); -type(lists, dropwhile, 2, Xs) -> - strict(arg_types(lists, dropwhile, 2), Xs, + end, Opaques); +type(lists, dropwhile, 2, Xs, Opaques) -> + strict(lists, dropwhile, 2, Xs, fun ([F, X]) -> - case t_is_nil(X) of + case t_is_nil(X, Opaques) of true -> t_nil(); false -> - X1 = t_list_elements(X), - case check_fun_application(F, [X1]) of + X1 = t_list_elements(X, Opaques), + case check_fun_application(F, [X1], Opaques) of ok -> - case t_atom_vals(t_fun_range(F)) of + case t_atom_vals(t_fun_range(F, Opaques), Opaques) of ['true'] -> - case t_is_none(t_inf(t_list(), X)) of + case t_is_none(t_inf(t_list(), X, Opaques)) of true -> t_none(); false -> t_nil() end; ['false'] -> - case t_is_none(t_inf(t_list(), X)) of + case t_is_none(t_inf(t_list(), X, Opaques)) of true -> t_none(); false -> X end; _ -> - t_inf(t_cons_tl(t_inf(X, t_cons())), - t_maybe_improper_list()) + t_inf(t_cons_tl(t_inf(X, t_cons(), Opaques)), + t_maybe_improper_list(), Opaques) end; error -> - case t_is_cons(X) of + case t_is_cons(X, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, filter, 2, Xs) -> - strict(arg_types(lists, filter, 2), Xs, + end, Opaques); +type(lists, filter, 2, Xs, Opaques) -> + strict(lists, filter, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_nil(); false -> - T = t_list_elements(L), - case check_fun_application(F, [T]) of + T = t_list_elements(L, Opaques), + case check_fun_application(F, [T], Opaques) of ok -> - case t_atom_vals(t_fun_range(F)) =:= ['false'] of + RangeVals = t_atom_vals(t_fun_range(F, Opaques), Opaques), + case RangeVals =:= ['false'] of true -> t_nil(); false -> - case t_atom_vals(t_fun_range(F)) =:= ['true'] of + case RangeVals =:= ['true'] of true -> L; false -> t_list(T) end end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, flatten, 1, Xs) -> - strict(arg_types(lists, flatten, 1), Xs, + end, Opaques); +type(lists, flatten, 1, Xs, Opaques) -> + strict(lists, flatten, 1, Xs, fun ([L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; % (nil has undefined elements) false -> %% Avoiding infinite recursion is tricky - X1 = t_list_elements(L), + X1 = t_list_elements(L, Opaques), case t_is_any(X1) of true -> t_list(); false -> - X2 = type(lists, flatten, 1, [t_inf(X1, t_list())]), + X2 = type(lists, flatten, 1, [t_inf(X1, t_list(), Opaques)]), t_sup(t_list(t_subtract(X1, t_list())), X2) end end - end); -type(lists, flatmap, 2, Xs) -> - strict(arg_types(lists, flatmap, 2), Xs, + end, Opaques); +type(lists, flatmap, 2, Xs, Opaques) -> + strict(lists, flatmap, 2, Xs, fun ([F, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> t_nil(); false -> - case check_fun_application(F, [t_list_elements(List)]) of + case + check_fun_application(F, [t_list_elements(List, Opaques)], + Opaques) + of ok -> - R = t_fun_range(F), + R = t_fun_range(F, Opaques), case t_is_nil(R) of true -> t_nil(); false -> - Elems = t_list_elements(R), - case t_is_cons(List) of + Elems = t_list_elements(R, Opaques), + case t_is_cons(List, Opaques) of true -> case t_is_subtype(t_nil(), R) of true -> t_list(Elems); @@ -1247,58 +1276,65 @@ type(lists, flatmap, 2, Xs) -> end end; error -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, foreach, 2, Xs) -> - strict(arg_types(lists, foreach, 2), Xs, + end, Opaques); +type(lists, foreach, 2, Xs, Opaques) -> + strict(lists, foreach, 2, Xs, fun ([F, List]) -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> - case check_fun_application(F, [t_list_elements(List)]) of + case + check_fun_application(F, [t_list_elements(List, Opaques)], + Opaques) + of ok -> t_atom('ok'); error -> t_none() end; false -> t_atom('ok') end - end); -type(lists, foldl, 3, Xs) -> - strict(arg_types(lists, foldl, 3), Xs, + end, Opaques); +type(lists, foldl, 3, Xs, Opaques) -> + strict(lists, foldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> Acc; false -> - case check_fun_application(F, [t_list_elements(List), Acc]) of + case + check_fun_application(F, + [t_list_elements(List, Opaques),Acc], + Opaques) + of ok -> - case t_is_cons(List) of - true -> t_fun_range(F); - false -> t_sup(t_fun_range(F), Acc) + case t_is_cons(List, Opaques) of + true -> t_fun_range(F, Opaques); + false -> t_sup(t_fun_range(F, Opaques), Acc) end; error -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_none(); false -> Acc end end end - end); -type(lists, foldr, 3, Xs) -> type(lists, foldl, 3, Xs); % same -type(lists, keydelete, 3, Xs) -> - strict(arg_types(lists, keydelete, 3), Xs, + end, Opaques); +type(lists, foldr, 3, Xs, _Opaques) -> type(lists, foldl, 3, Xs); % same +type(lists, keydelete, 3, Xs, Opaques) -> + strict(lists, keydelete, 3, Xs, fun ([_, _, L]) -> Term = t_list_termination(L), t_sup(Term, erl_types:lift_list_to_pos_empty(L)) - end); -type(lists, keyfind, 3, Xs) -> - strict(arg_types(lists, keyfind, 3), Xs, + end, Opaques); +type(lists, keyfind, 3, Xs, Opaques) -> + strict(lists, keyfind, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1308,58 +1344,61 @@ type(lists, keyfind, 3, Xs) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> Ret end end end end - end); -type(lists, keymap, 3, Xs) -> - strict(arg_types(lists, keymap, 3), Xs, + end, Opaques); +type(lists, keymap, 3, Xs, Opaques) -> + strict(lists, keymap, 3, Xs, fun ([F, _I, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; - false -> t_list(t_sup(t_fun_range(F), t_list_elements(L))) + false -> t_list(t_sup(t_fun_range(F, Opaques), + t_list_elements(L, Opaques))) end - end); -type(lists, keymember, 3, Xs) -> - strict(arg_types(lists, keymember, 3), Xs, + end, Opaques); +type(lists, keymember, 3, Xs, Opaques) -> + strict(lists, keymember, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> case t_is_any(X) of true -> t_boolean(); false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> t_boolean(); List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> t_boolean() end end end end - end); -type(lists, keymerge, 3, Xs) -> - strict(arg_types(lists, keymerge, 3), Xs, - fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end); -type(lists, keyreplace, 4, Xs) -> - strict(arg_types(lists, keyreplace, 4), Xs, - fun ([_K, _I, L, T]) -> t_list(t_sup(t_list_elements(L), T)) end); -type(lists, keysearch, 3, Xs) -> - strict(arg_types(lists, keysearch, 3), Xs, + end, Opaques); +type(lists, keymerge, 3, Xs, Opaques) -> + strict(lists, keymerge, 3, Xs, + fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end, Opaques); +type(lists, keyreplace, 4, Xs, Opaques) -> + strict(lists, keyreplace, 4, Xs, + fun ([_K, _I, L, T]) -> + t_list(t_sup(t_list_elements(L, Opaques), T)) + end, Opaques); +type(lists, keysearch, 3, Xs, Opaques) -> + strict(lists, keysearch, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1368,91 +1407,93 @@ type(lists, keysearch, 3, Xs) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> Ret end end end end - end); -type(lists, keysort, 2, Xs) -> - strict(arg_types(lists, keysort, 2), Xs, fun ([_, L]) -> L end); -type(lists, last, 1, Xs) -> - strict(arg_types(lists, last, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, map, 2, Xs) -> - strict(arg_types(lists, map, 2), Xs, + end, Opaques); +type(lists, keysort, 2, Xs, Opaques) -> + strict(lists, keysort, 2, Xs, fun ([_, L]) -> L end, Opaques); +type(lists, last, 1, Xs, Opaques) -> + strict(lists, last, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, map, 2, Xs, Opaques) -> + strict(lists, map, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; false -> - El = t_list_elements(L), - case t_is_cons(L) of + El = t_list_elements(L, Opaques), + case t_is_cons(L, Opaques) of true -> - case check_fun_application(F, [El]) of - ok -> t_nonempty_list(t_fun_range(F)); + case check_fun_application(F, [El], Opaques) of + ok -> t_nonempty_list(t_fun_range(F, Opaques)); error -> t_none() end; false -> - case check_fun_application(F, [El]) of - ok -> t_list(t_fun_range(F)); + case check_fun_application(F, [El], Opaques) of + ok -> t_list(t_fun_range(F, Opaques)); error -> t_nil() end end end - end); -type(lists, mapfoldl, 3, Xs) -> - strict(arg_types(lists, mapfoldl, 3), Xs, + end, Opaques); +type(lists, mapfoldl, 3, Xs, Opaques) -> + strict(lists, mapfoldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> t_tuple([List, Acc]); false -> - El = t_list_elements(List), - R = t_fun_range(F), - case t_is_cons(List) of + El = t_list_elements(List, Opaques), + R = t_fun_range(F, Opaques), + case t_is_cons(List, Opaques) of true -> - case check_fun_application(F, [El, Acc]) of + case check_fun_application(F, [El, Acc], Opaques) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple), + [T1, T2] = t_tuple_args(RangeTuple, Opaques), t_tuple([t_nonempty_list(T1), T2]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); error -> t_none() end; false -> - case check_fun_application(F, [El, Acc]) of + case check_fun_application(F, [El, Acc], Opaques) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple), + [T1, T2] = t_tuple_args(RangeTuple, Opaques), t_tuple([t_list(T1), t_sup(Acc, T2)]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); error -> t_tuple([t_nil(), Acc]) end end end - end); -type(lists, mapfoldr, 3, Xs) -> type(lists, mapfoldl, 3, Xs); % same -type(lists, max, 1, Xs) -> - strict(arg_types(lists, max, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, member, 2, Xs) -> - strict(arg_types(lists, member, 2), Xs, + end, Opaques); +type(lists, mapfoldr, 3, Xs, _Opaques) -> type(lists, mapfoldl, 3, Xs); % same +type(lists, max, 1, Xs, Opaques) -> + strict(lists, max, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, member, 2, Xs, Opaques) -> + strict(lists, member, 2, Xs, fun ([X, Y]) -> - Y1 = t_list_elements(Y), - case t_is_none(t_inf(Y1, X)) of + Y1 = t_list_elements(Y, Opaques), + case t_is_none(t_inf(Y1, X, Opaques)) of true -> t_atom('false'); false -> t_boolean() end - end); -%% type(lists, merge, 1, Xs) -> -type(lists, merge, 2, Xs) -> - strict(arg_types(lists, merge, 2), Xs, + end, Opaques); +%% type(lists, merge, 1, Xs, Opaques) -> +type(lists, merge, 2, Xs, Opaques) -> + strict(lists, merge, 2, Xs, fun ([L1, L2]) -> case t_is_none(L1) of true -> L2; @@ -1462,30 +1503,31 @@ type(lists, merge, 2, Xs) -> false -> t_sup(L1, L2) end end - end); -type(lists, min, 1, Xs) -> - strict(arg_types(lists, min, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, nth, 2, Xs) -> - strict(arg_types(lists, nth, 2), Xs, - fun ([_, Y]) -> t_list_elements(Y) end); -type(lists, nthtail, 2, Xs) -> - strict(arg_types(lists, nthtail, 2), Xs, - fun ([_, Y]) -> t_sup(Y, t_list()) end); -type(lists, partition, 2, Xs) -> - strict(arg_types(lists, partition, 2), Xs, + end, Opaques); +type(lists, min, 1, Xs, Opaques) -> + strict(lists, min, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, nth, 2, Xs, Opaques) -> + strict(lists, nth, 2, Xs, + fun ([_, Y]) -> t_list_elements(Y, Opaques) end, Opaques); +type(lists, nthtail, 2, Xs, Opaques) -> + strict(lists, nthtail, 2, Xs, + fun ([_, Y]) -> t_sup(Y, t_list()) end, Opaques); +type(lists, partition, 2, Xs, Opaques) -> + strict(lists, partition, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_tuple([L,L]); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); false -> t_tuple([t_nil(), t_nil()]) end; ok -> - case t_atom_vals(t_fun_range(F)) of + case t_atom_vals(t_fun_range(F, Opaques), Opaques) of ['true'] -> t_tuple([L, t_nil()]); ['false'] -> t_tuple([t_nil(), L]); [_, _] -> @@ -1494,123 +1536,131 @@ type(lists, partition, 2, Xs) -> end end end - end); -type(lists, reverse, 1, Xs) -> - strict(arg_types(lists, reverse, 1), Xs, fun ([X]) -> X end); -type(lists, reverse, 2, Xs) -> + end, Opaques); +type(lists, reverse, 1, Xs, Opaques) -> + strict(lists, reverse, 1, Xs, fun ([X]) -> X end, Opaques); +type(lists, reverse, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % reverse-onto is just like append -type(lists, sort, 1, Xs) -> - strict(arg_types(lists, sort, 1), Xs, fun ([X]) -> X end); -type(lists, sort, 2, Xs) -> - strict(arg_types(lists, sort, 2), Xs, +type(lists, sort, 1, Xs, Opaques) -> + strict(lists, sort, 1, Xs, fun ([X]) -> X end, Opaques); +type(lists, sort, 2, Xs, Opaques) -> + strict(lists, sort, 2, Xs, fun ([F, L]) -> - R = t_fun_range(F), - case t_is_boolean(R) of + R = t_fun_range(F, Opaques), + case t_is_boolean(R, Opaques) of true -> L; false -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_nil(); false -> t_none() end end - end); -type(lists, split, 2, Xs) -> - strict(arg_types(lists, split, 2), Xs, + end, Opaques); +type(lists, split, 2, Xs, Opaques) -> + strict(lists, split, 2, Xs, fun ([_, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_tuple([L, L]); false -> - T = t_list_elements(L), + T = t_list_elements(L, Opaques), t_tuple([t_list(T), t_list(T)]) end - end); -type(lists, splitwith, 2, Xs) -> + end, Opaques); +type(lists, splitwith, 2, Xs, _Opaques) -> T1 = type(lists, takewhile, 2, Xs), T2 = type(lists, dropwhile, 2, Xs), case t_is_none(T1) orelse t_is_none(T2) of true -> t_none(); false -> t_tuple([T1, T2]) end; -type(lists, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias -type(lists, takewhile, 2, Xs) -> - strict(arg_types(lists, takewhile, 2), Xs, +type(lists, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias +type(lists, takewhile, 2, Xs, Opaques) -> + strict(lists, takewhile, 2, Xs, fun([F, L]) -> - case t_is_none(t_inf(t_list(), L)) of + case t_is_none(t_inf(t_list(), L, Opaques)) of false -> type(lists, filter, 2, Xs); true -> %% This works for non-proper lists as well. - El = t_list_elements(L), + El = t_list_elements(L, Opaques), type(lists, filter, 2, [F, t_list(El)]) end - end); -type(lists, usort, 1, Xs) -> type(lists, sort, 1, Xs); % same -type(lists, usort, 2, Xs) -> type(lists, sort, 2, Xs); % same -type(lists, unzip, 1, Xs) -> - strict(arg_types(lists, unzip, 1), Xs, + end, Opaques); +type(lists, usort, 1, Xs, _Opaques) -> type(lists, sort, 1, Xs); % same +type(lists, usort, 2, Xs, _Opaques) -> type(lists, sort, 2, Xs); % same +type(lists, unzip, 1, Xs, Opaques) -> + strict(lists, unzip, 1, Xs, fun ([Ps]) -> - case t_is_nil(Ps) of + case t_is_nil(Ps, Opaques) of true -> t_tuple([t_nil(), t_nil()]); false -> % Ps is a proper list of pairs - TupleTypes = t_tuple_subtypes(t_list_elements(Ps)), + TupleTypes = t_tuple_subtypes(t_list_elements(Ps, Opaques), + Opaques), lists:foldl(fun(Tuple, Acc) -> - [A, B] = t_tuple_args(Tuple), + [A, B] = t_tuple_args(Tuple, Opaques), t_sup(t_tuple([t_list(A), t_list(B)]), Acc) end, t_none(), TupleTypes) end - end); -type(lists, unzip3, 1, Xs) -> - strict(arg_types(lists, unzip3, 1), Xs, + end, Opaques); +type(lists, unzip3, 1, Xs, Opaques) -> + strict(lists, unzip3, 1, Xs, fun ([Ts]) -> - case t_is_nil(Ts) of + case t_is_nil(Ts, Opaques) of true -> t_tuple([t_nil(), t_nil(), t_nil()]); false -> % Ps is a proper list of triples - TupleTypes = t_tuple_subtypes(t_list_elements(Ts)), + TupleTypes = t_tuple_subtypes(t_list_elements(Ts, Opaques), + Opaques), lists:foldl(fun(T, Acc) -> - [A, B, C] = t_tuple_args(T), + [A, B, C] = t_tuple_args(T, Opaques), t_sup(t_tuple([t_list(A), t_list(B), t_list(C)]), Acc) end, t_none(), TupleTypes) end - end); -type(lists, zip, 2, Xs) -> - strict(arg_types(lists, zip, 2), Xs, + end, Opaques); +type(lists, zip, 2, Xs, Opaques) -> + strict(lists, zip, 2, Xs, fun ([As, Bs]) -> - case (t_is_nil(As) orelse t_is_nil(Bs)) of + case (t_is_nil(As, Opaques) orelse t_is_nil(Bs, Opaques)) of true -> t_nil(); false -> - A = t_list_elements(As), - B = t_list_elements(Bs), + A = t_list_elements(As, Opaques), + B = t_list_elements(Bs, Opaques), t_list(t_tuple([A, B])) end - end); -type(lists, zip3, 3, Xs) -> - strict(arg_types(lists, zip3, 3), Xs, + end, Opaques); +type(lists, zip3, 3, Xs, Opaques) -> + strict(lists, zip3, 3, Xs, fun ([As, Bs, Cs]) -> - case (t_is_nil(As) orelse t_is_nil(Bs) orelse t_is_nil(Cs)) of + case + (t_is_nil(As, Opaques) + orelse t_is_nil(Bs, Opaques) + orelse t_is_nil(Cs, Opaques)) + of true -> t_nil(); false -> - A = t_list_elements(As), - B = t_list_elements(Bs), - C = t_list_elements(Cs), + A = t_list_elements(As, Opaques), + B = t_list_elements(Bs, Opaques), + C = t_list_elements(Cs, Opaques), t_list(t_tuple([A, B, C])) end - end); -type(lists, zipwith, 3, Xs) -> - strict(arg_types(lists, zipwith, 3), Xs, - fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end); -type(lists, zipwith3, 4, Xs) -> - strict(arg_types(lists, zipwith3, 4), Xs, - fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end); + end, Opaques); +type(lists, zipwith, 3, Xs, Opaques) -> + strict(lists, zipwith, 3, Xs, + fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F, Opaques)), + t_nil()) end, Opaques); +type(lists, zipwith3, 4, Xs, Opaques) -> + strict(lists, zipwith3, 4, Xs, + fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), + t_nil()) end, Opaques); %%-- string ------------------------------------------------------------------- -type(string, chars, 2, Xs) -> % NOTE: added to avoid loss of information - strict(arg_types(string, chars, 2), Xs, fun (_) -> t_string() end); -type(string, chars, 3, Xs) -> % NOTE: added to avoid loss of information - strict(arg_types(string, chars, 3), Xs, +type(string, chars, 2, Xs, Opaques) -> % NOTE: added to avoid loss of info + strict(string, chars, 2, Xs, fun (_) -> t_string() end, Opaques); +type(string, chars, 3, Xs, Opaques) -> % NOTE: added to avoid loss of info + strict(string, chars, 3, Xs, fun ([Char, N, Tail]) -> case t_is_nil(Tail) of true -> @@ -1623,10 +1673,10 @@ type(string, chars, 3, Xs) -> % NOTE: added to avoid loss of information t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail)) end end - end); + end, Opaques); %%----------------------------------------------------------------------------- -type(M, F, A, Xs) when is_atom(M), is_atom(F), +type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> strict(Xs, t_any()). % safe approximation for all functions. @@ -1635,13 +1685,20 @@ type(M, F, A, Xs) when is_atom(M), is_atom(F), %% Auxiliary functions %%----------------------------------------------------------------------------- -strict(Xs, Ts, F) -> - %% io:format("inf lists arg~n1:~p~n2:~p ~n", [Xs, Ts]), - Xs1 = inf_lists(Xs, Ts), +strict(M, F, A, Xs, Fun, Opaques) -> + Ts = arg_types(M, F, A), + %% io:format("inf lists arg~nXs: ~p~nTs: ~p ~n", [Xs, Ts]), + Xs1 = inf_lists(Xs, Ts, Opaques), %% io:format("inf lists return ~p ~n", [Xs1]), case any_is_none_or_unit(Xs1) of true -> t_none(); - false -> F(Xs1) + false -> Fun(Xs1) + end. + +strict2(Xs, X) -> + case any_is_none_or_unit(Xs) of + true -> t_none(); + false -> X end. strict(Xs, X) -> @@ -1650,9 +1707,9 @@ strict(Xs, X) -> false -> X end. -inf_lists([X | Xs], [T | Ts]) -> - [t_inf(X, T) | inf_lists(Xs, Ts)]; -inf_lists([], []) -> +inf_lists([X | Xs], [T | Ts], Opaques) -> + [t_inf(X, T, Opaques) | inf_lists(Xs, Ts, Opaques)]; +inf_lists([], [], _Opaques) -> []. any_list(N) -> any_list(N, t_any()). @@ -1670,20 +1727,43 @@ list_replace(1, E, [_X | Xs]) -> any_is_none_or_unit(Ts) -> lists:any(fun erl_types:t_is_none_or_unit/1, Ts). -check_guard([X], Test, Type) -> - check_guard_single(X, Test, Type). +check_guard([X], Test, Type, Opaques) -> + check_guard_single(X, Test, Type, Opaques). -check_guard_single(X, Test, Type) -> +check_guard_single(X, Test, Type, Opaques) -> case Test(X) of true -> t_atom('true'); false -> - case erl_types:t_is_opaque(X) of - true -> t_none(); - false -> - case t_is_none(t_inf(Type, X)) of - true -> t_atom('false'); - false -> t_boolean() - end + case t_is_none(t_inf(Type, X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; + false -> t_boolean() + end + end. + +check_record_tag(Tag, Y, Opaques) -> + case t_is_atom(Tag, Opaques) of + false -> + TagAtom = t_inf(Tag, t_atom(), Opaques), + case t_is_none(TagAtom) of + true -> + case t_has_opaque_subtype(Tag, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; + false -> t_boolean() + end; + true -> + case t_atom_vals(Tag, Opaques) of + [RealTag] -> + case t_atom_vals(Y, Opaques) of + [RealTag] -> t_atom('true'); + _ -> t_boolean() + end; + _ -> t_boolean() end end. @@ -1828,12 +1908,12 @@ negwidth(X, N) -> false -> negwidth(X, N+1) end. -arith('bnot', X1) -> - case t_is_integer(X1) of +arith('bnot', X1, Opaques) -> + case t_is_integer(X1, Opaques) of false -> error; true -> - Min1 = number_min(X1), - Max1 = number_max(X1), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), {ok, t_from_range(infinity_add(infinity_inv(Max1), -1), infinity_add(infinity_inv(Min1), -1))} end. @@ -1907,13 +1987,13 @@ arith_bor_range_set({Min, Max}, [Int|IntList]) -> IntList), {infinity_bor(Min, SafeAnd), infinity_bor(Max, SafeAnd)}. -arith_band(X1, X2) -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), +arith_band(X1, X2, Opaques) -> + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2); @@ -1923,13 +2003,13 @@ arith_band(X1, X2) -> arith_band_ranges(Min1, Max1, Min2, Max2) end. -arith_bor(X1, X2) -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), +arith_bor(X1, X2, Opaques) -> + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2); @@ -1967,19 +2047,19 @@ arith_bor_ranges(Min1, Max1, Min2, Max2) -> end, {Min, Max}. -arith(Op, X1, X2) -> +arith(Op, X1, X2, Opaques) -> %% io:format("arith ~p ~p ~p~n", [Op, X1, X2]), - case t_is_integer(X1) andalso t_is_integer(X2) of + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of false -> error; true -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), case (L1 =:= unknown) orelse (L2 =:= unknown) of true -> - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), {NewMin, NewMax} = case Op of '+' -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)}; @@ -1992,8 +2072,8 @@ arith(Op, X1, X2) -> 'bsr' -> NewMin2 = infinity_inv(Max2), NewMax2 = infinity_inv(Min2), arith_bsl(Min1, Max1, NewMin2, NewMax2); - 'band' -> arith_band(X1, X2); - 'bor' -> arith_bor(X1, X2); + 'band' -> arith_band(X1, X2, Opaques); + 'bor' -> arith_bor(X1, X2, Opaques); 'bxor' -> arith_bor_ranges(Min1, Max1, Min2, Max2) %% overaprox. end, %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]), @@ -2025,58 +2105,62 @@ arith(Op, X1, X2) -> %% Comparison of terms %%============================================================================= -compare(Op, Lhs, Rhs) -> - case t_is_none(t_inf(Lhs, Rhs)) of +compare(Op, Lhs, Rhs, Opaques) -> + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of false -> t_boolean(); true -> - case Op of - '<' -> always_smaller(Lhs, Rhs); - '>' -> always_smaller(Rhs, Lhs); - '=<' -> always_smaller(Lhs, Rhs); - '>=' -> always_smaller(Rhs, Lhs) + case opaque_args(erlang, Op, 2, [Lhs, Rhs], Opaques) =:= [] of + true -> + case Op of + '<' -> always_smaller(Lhs, Rhs, Opaques); + '>' -> always_smaller(Rhs, Lhs, Opaques); + '=<' -> always_smaller(Lhs, Rhs, Opaques); + '>=' -> always_smaller(Rhs, Lhs, Opaques) + end; + false -> t_none() end end. -always_smaller(Type1, Type2) -> - {Min1, Max1} = type_ranks(Type1), - {Min2, Max2} = type_ranks(Type2), +always_smaller(Type1, Type2, Opaques) -> + {Min1, Max1} = type_ranks(Type1, Opaques), + {Min2, Max2} = type_ranks(Type2, Opaques), if Max1 < Min2 -> t_atom('true'); Min1 > Max2 -> t_atom('false'); true -> t_boolean() end. -type_ranks(Type) -> - type_ranks(Type, 1, 0, 0, type_order()). +type_ranks(Type, Opaques) -> + type_ranks(Type, 1, 0, 0, type_order(), Opaques). -type_ranks(_Type, _I, Min, Max, []) -> {Min, Max}; -type_ranks(Type, I, Min, Max, [TypeClass|Rest]) -> +type_ranks(_Type, _I, Min, Max, [], _Opaques) -> {Min, Max}; +type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> {NewMin, NewMax} = - case t_is_none(t_inf(Type, TypeClass)) of + case t_is_none(t_inf(Type, TypeClass, Opaques)) of true -> {Min, Max}; false -> case Min of 0 -> {I, I}; _ -> {Min, I} end end, - type_ranks(Type, I+1, NewMin, NewMax, Rest). + type_ranks(Type, I+1, NewMin, NewMax, Rest, Opaques). type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), t_list(), t_binary()]. -key_comparisons_fail(X0, KeyPos, TupleList) -> - X = case t_is_number(t_inf(X0, t_number())) of +key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> + X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of false -> X0; true -> t_number() end, lists:all(fun(Tuple) -> Key = type(erlang, element, 2, [KeyPos, Tuple]), - t_is_none(t_inf(Key, X)) + t_is_none(t_inf(Key, X, Opaques)) end, TupleList). %%============================================================================= --spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'. +-spec arg_types(atom(), atom(), arity()) -> arg_types() | 'unknown'. %%------- erlang -------------------------------------------------------------- arg_types(erlang, '!', 2) -> @@ -2508,47 +2592,78 @@ arg_types(M, F, A) when is_atom(M), is_atom(F), unknown. % safe approximation for all functions. --spec is_known(atom(), atom(), arity()) -> boolean(). +-spec is_known(module(), atom(), arity()) -> boolean(). is_known(M, F, A) -> arg_types(M, F, A) =/= unknown. +-spec opaque_args(module(), atom(), arity(), + arg_types(), opaques()) -> [pos_integer()]. + +%% Use this function to find out which argument caused empty type. + +opaque_args(_M, _F, _A, _Xs, 'universe') -> []; +opaque_args(M, F, A, Xs, Opaques) -> + case kind_of_check(M, F, A) of + record -> + [X,Y|_] = Xs, + [1 || + case t_is_tuple(X, Opaques) of + true -> + case t_tuple_subtypes(X, Opaques) of + unknown -> false; + List when length(List) >= 1 -> opaque_recargs(List, Y, Opaques) + end; + false -> t_has_opaque_subtype(X, Opaques) + end]; + subtype -> + [N || + {N, X} <- lists:zip(lists:seq(1, length(Xs)), Xs), + t_has_opaque_subtype(X, Opaques)]; + find_unknown -> + [L, R] = Xs, + erl_types:t_find_unknown_opaque(L, R, Opaques); + no_check -> [] + end. --spec structure_inspecting_args(atom(), atom(), arity()) -> [1..255]. - -structure_inspecting_args(erlang, element, 2) -> [2]; -structure_inspecting_args(erlang, is_atom, 1) -> [1]; -structure_inspecting_args(erlang, is_boolean, 1) -> [1]; -structure_inspecting_args(erlang, is_binary, 1) -> [1]; -structure_inspecting_args(erlang, is_bitstring, 1) -> [1]; -structure_inspecting_args(erlang, is_float, 1) -> [1]; -structure_inspecting_args(erlang, is_function, 1) -> [1]; -structure_inspecting_args(erlang, is_integer, 1) -> [1]; -structure_inspecting_args(erlang, is_list, 1) -> [1]; -structure_inspecting_args(erlang, is_number, 1) -> [1]; -structure_inspecting_args(erlang, is_pid, 1) -> [1]; -structure_inspecting_args(erlang, is_port, 1) -> [1]; -structure_inspecting_args(erlang, is_reference, 1) -> [1]; -structure_inspecting_args(erlang, is_tuple, 1) -> [1]; -structure_inspecting_args(erlang, length, 1) -> [1]; -%%structure_inspecting_args(erlang, setelement, 3) -> [2]. -structure_inspecting_args(_, _, _) -> []. % XXX: assume no arg needs inspection - - -check_fun_application(Fun, Args) -> - case t_is_fun(Fun) of +kind_of_check(erlang, is_record, 3) -> + record; +kind_of_check(erlang, is_record, 2) -> + record; +kind_of_check(erlang, F, A) -> + case erl_internal:guard_bif(F, A) orelse erl_internal:bool_op(F, A) of + true -> subtype; + false -> + case erl_internal:comp_op(F, A) of + true -> find_unknown; + false -> no_check + end + end; +kind_of_check(_M, _F, _A) -> no_check. + +opaque_recargs(Tuples, Y, Opaques) -> + Fun = fun(Tuple) -> + case t_tuple_args(Tuple, Opaques) of + [Tag|_] -> t_is_none(check_record_tag(Tag, Y, Opaques)); + _ -> false + end + end, + lists:all(Fun, Tuples). + +check_fun_application(Fun, Args, Opaques) -> + case t_is_fun(Fun, Opaques) of true -> - case t_fun_args(Fun) of + case t_fun_args(Fun, Opaques) of unknown -> - case t_is_none_or_unit(t_fun_range(Fun)) of + case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end; FunDom when length(FunDom) =:= length(Args) -> - case any_is_none_or_unit(inf_lists(FunDom, Args)) of + case any_is_none_or_unit(inf_lists(FunDom, Args, Opaques)) of true -> error; false -> - case t_is_none_or_unit(t_fun_range(Fun)) of + case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d7d8a878c5..cfa72d85b7 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,15 +42,15 @@ max/2, module_builtin_opaques/1, min/2, - number_max/1, - number_min/1, + 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/1, t_atom_vals/2, t_binary/0, t_bitstr/0, t_bitstr/2, @@ -66,12 +66,14 @@ t_collect_vars/1, t_cons/0, t_cons/2, - t_cons_hd/1, - t_cons_tl/1, + t_cons_hd/1, t_cons_hd/2, + t_cons_tl/1, t_cons_tl/2, t_constant/0, - t_contains_opaque/1, + t_contains_opaque/1, t_contains_opaque/2, + t_decorate_with_opaque/3, t_elements/1, t_find_opaque_mismatch/2, + t_find_unknown_opaque/3, t_fixnum/0, t_map/2, t_non_neg_fixnum/0, @@ -87,18 +89,18 @@ t_fun/0, t_fun/1, t_fun/2, - t_fun_args/1, - t_fun_arity/1, - t_fun_range/1, - t_has_opaque_subtype/1, + 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/2, - t_inf/3, - t_inf_lists/2, - t_inf_lists/3, - t_inf_lists_masked/3, + 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, @@ -107,44 +109,44 @@ t_iodata/0, t_iolist/0, t_is_any/1, - t_is_atom/1, - t_is_atom/2, - t_is_binary/1, - t_is_bitstr/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/1, t_is_boolean/2, %% t_is_byte/1, %% t_is_char/1, - t_is_cons/1, + t_is_cons/1, t_is_cons/2, t_is_constant/1, t_is_equal/2, t_is_fixnum/1, - t_is_float/1, - t_is_fun/1, + t_is_float/1, t_is_float/2, + t_is_fun/1, t_is_fun/2, t_is_instance/2, - t_is_integer/1, + t_is_integer/1, t_is_integer/2, t_is_list/1, t_is_matchstate/1, - t_is_nil/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_opaque/1, - t_is_pid/1, - t_is_port/1, - t_is_maybe_improper_list/1, - t_is_reference/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_remote/1, t_is_string/1, t_is_subtype/2, - t_is_tuple/1, + 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/1, t_list_elements/2, t_list_termination/1, t_matchstate/0, t_matchstate/2, @@ -163,11 +165,8 @@ t_nonempty_string/0, t_number/0, t_number/1, - t_number_vals/1, + t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, - t_opaque_match_atom/2, - t_opaque_match_record/2, - t_opaque_matching_structure/2, t_opaque_structure/1, %% t_parameterized_module/0, t_pid/0, @@ -192,16 +191,14 @@ t_to_tlist/1, t_tuple/0, t_tuple/1, - t_tuple_args/1, - t_tuple_size/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_unify/3, t_unit/0, - t_unopaque/1, - t_unopaque/2, - t_unopaque_on_mismatch/3, + t_unopaque/1, t_unopaque/2, t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, @@ -209,6 +206,7 @@ record_field_diffs_to_string/2, subst_all_vars_to_any/1, lift_list_to_pos_empty/1, + is_opaque_type/2, is_erl_type/1, atom_to_string/1 ]). @@ -228,6 +226,14 @@ -export_type([erl_type/0]). +%%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(debug(__A), __A). +-else. +-define(debug(__A), ok). +-endif. + %%============================================================================= %% %% Definition of the type structure @@ -310,6 +316,9 @@ -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()}). -record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}). @@ -346,6 +355,8 @@ -define(integer_non_neg, ?int_range(0, pos_inf)). -define(integer_neg, ?int_range(neg_inf, -1)). +-type opaques() :: [erl_type()] | 'universe'. + %%----------------------------------------------------------------------------- %% Unions %% @@ -384,8 +395,11 @@ t_any() -> -spec t_is_any(erl_type()) -> boolean(). -t_is_any(?any) -> true; -t_is_any(_) -> false. +t_is_any(Type) -> + do_opaque(Type, 'universe', fun is_any/1). + +is_any(?any) -> true; +is_any(_) -> false. -spec t_none() -> erl_type(). @@ -407,16 +421,25 @@ 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()) -> boolean(). +-spec t_has_opaque_subtype(erl_type(), opaques()) -> boolean(). + +t_has_opaque_subtype(Type, Opaques) -> + do_opaque(Type, Opaques, fun has_opaque_subtype/1). -t_has_opaque_subtype(?union(Ts)) -> +has_opaque_subtype(?union(Ts)) -> lists:any(fun t_is_opaque/1, Ts); -t_has_opaque_subtype(T) -> +has_opaque_subtype(T) -> t_is_opaque(T). -spec t_opaque_structure(erl_type()) -> erl_type(). @@ -424,74 +447,62 @@ t_has_opaque_subtype(T) -> t_opaque_structure(?opaque(Elements)) -> t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]). --spec t_opaque_module(erl_type()) -> module(). +-spec t_opaque_modules(erl_type()) -> [module()]. -t_opaque_module(?opaque(Elements)) -> +t_opaque_modules(?opaque(Elements)) -> case ordsets:size(Elements) of 1 -> - [#opaque{mod = Module}] = ordsets:to_list(Elements), - Module; + [#opaque{mod = Mod}] = set_to_list(Elements), + [Mod]; _ -> throw({error, "Unexpected multiple opaque types"}) end. -%% This only makes sense if we know that Type matches Opaque --spec t_opaque_matching_structure(erl_type(), erl_type()) -> erl_type(). - -t_opaque_matching_structure(Type, Opaque) -> - OpaqueStruct = t_opaque_structure(Opaque), - case OpaqueStruct of - ?union(L1) -> - case Type of - ?union(_L2) -> OpaqueStruct; - _OtherType -> t_opaque_matching_structure_list(Type, L1) - end; - ?tuple_set(_Set1) = TupleSet -> - case Type of - ?tuple_set(_Set2) -> OpaqueStruct; - _ -> t_opaque_matching_structure_list(Type, t_tuple_subtypes(TupleSet)) - end; - _Other -> OpaqueStruct - end. - -t_opaque_matching_structure_list(Type, List) -> - NewList = [t_inf(Element, Type) || Element <- List], - Results = [NotNone || NotNone <- NewList, NotNone =/= ?none], - case Results of - [] -> ?none; - [First|_] -> First - end. - -spec t_contains_opaque(erl_type()) -> boolean(). -t_contains_opaque(?any) -> false; -t_contains_opaque(?none) -> false; -t_contains_opaque(?unit) -> false; -t_contains_opaque(?atom(_Set)) -> false; -t_contains_opaque(?bitstr(_Unit, _Base)) -> false; -t_contains_opaque(?float) -> false; -t_contains_opaque(?function(Domain, Range)) -> - t_contains_opaque(Domain) orelse t_contains_opaque(Range); -t_contains_opaque(?identifier(_Types)) -> false; -t_contains_opaque(?integer(_Types)) -> false; -t_contains_opaque(?int_range(_From, _To)) -> false; -t_contains_opaque(?int_set(_Set)) -> false; -t_contains_opaque(?list(Type, _, _)) -> t_contains_opaque(Type); -t_contains_opaque(?matchstate(_P, _Slots)) -> false; -t_contains_opaque(?nil) -> false; -t_contains_opaque(?number(_Set, _Tag)) -> false; -t_contains_opaque(?opaque(_)) -> true; -t_contains_opaque(?product(Types)) -> list_contains_opaque(Types); -t_contains_opaque(?tuple(?any, _, _)) -> false; -t_contains_opaque(?tuple(Types, _, _)) -> list_contains_opaque(Types); -t_contains_opaque(?tuple_set(_Set) = T) -> - list_contains_opaque(t_tuple_subtypes(T)); -t_contains_opaque(?union(List)) -> list_contains_opaque(List); -t_contains_opaque(?var(_Id)) -> false. - --spec list_contains_opaque([erl_type()]) -> boolean(). - -list_contains_opaque(List) -> - lists:any(fun t_contains_opaque/1, List). +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(?integer(_Types), _Opaques) -> false; +t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; +t_contains_opaque(?int_set(_Set), _Opaques) -> false; +t_contains_opaque(?list(Type, Tail, _), Opaques) -> + t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, 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. @@ -506,9 +517,12 @@ t_find_opaque_mismatch(T1, T2) -> t_find_opaque_mismatch(?any, _Type, _TopType) -> error; t_find_opaque_mismatch(?none, _Type, _TopType) -> error; -t_find_opaque_mismatch(?list(T1, _, _), ?list(T2, _, _), TopType) -> - t_find_opaque_mismatch(T1, T2, TopType); +t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType) -> + t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType); t_find_opaque_mismatch(_T1, ?opaque(_) = T2, TopType) -> {ok, TopType, T2}; +t_find_opaque_mismatch(?opaque(_) = T1, _T2, TopType) -> + %% The generated message is somewhat misleading: + {ok, TopType, T1}; t_find_opaque_mismatch(?product(T1), ?product(T2), TopType) -> t_find_opaque_mismatch_ordlists(T1, T2, TopType); t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), TopType) -> @@ -538,6 +552,166 @@ t_find_opaque_mismatch_list([H|T]) -> 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. +%% XXX. Returns one element even if both oparands contain opaque types. +%% XXX. Slow since t_inf() is called but the results are ignored. +t_find_unknown_opaque(_T1, _T2, 'universe') -> []; +t_find_unknown_opaque(T1, T2, Opaques) -> + try t_inf(T1, T2, {match, Opaques}) of + _ -> [] + catch throw:N when is_integer(N) -> [N] + 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 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 t_is_equal(t_unopaque(R), t_unopaque(T1)) of + true -> ok; + false -> + 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(?none=Type, _, _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(?opaque(_)=T, _, _Opaques) -> T; +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 = ?opaque(ordsets:from_list(List)), + case All of + true -> NewType; + false -> t_sup(NewType, Type) + end + end. + +decoration([#opaque{struct = S} = Opaque|OpaqueTypes], Type, Opaques, + NewOpaqueTypes, All) -> + IsOpaque = is_opaque_type2(Opaque, Opaques), + I = t_inf(Type, S), + case not IsOpaque orelse t_is_none(I = t_inf(Type, S)) of + true -> decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes, All); + false -> + NewOpaque = Opaque#opaque{struct = decorate(I, S, Opaques)}, + NewAll = All orelse t_is_equal(I, Type), + decoration(OpaqueTypes, Type, Opaques, [NewOpaque|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,_,_R] = U1, + [_,_,_,_,_,_,_,_,Opaque,_] = U2, + List = [A,B,F,I,L,N,T,M], + DecList = [Dec || + E <- List, + 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(dict()) -> [erl_type()]. t_opaque_from_records(RecDict) -> @@ -559,44 +733,6 @@ t_opaque_from_records(RecDict) -> end, OpaqueRecDict), [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)]. --spec t_opaque_match_atom(erl_type(), [erl_type()]) -> [erl_type()]. - -t_opaque_match_atom(?atom(_) = Atom, Opaques) -> - case t_atom_vals(Atom) of - unknown -> []; - _ -> [O || O <- Opaques, t_inf(Atom, O, opaque) =/= ?none, - t_opaque_atom_vals(t_opaque_structure(O)) =/= unknown] - end; -t_opaque_match_atom(_, _) -> []. - --spec t_opaque_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. - -t_opaque_atom_vals(OpaqueStruct) -> - case OpaqueStruct of - ?atom(_) -> t_atom_vals(OpaqueStruct); - ?union([Atom,_,_,_,_,_,_,_,_,_]) -> t_atom_vals(Atom); - _ -> unknown - end. - --spec t_opaque_match_record(erl_type(), [erl_type()]) -> [erl_type()]. - -t_opaque_match_record(?tuple([?atom(_) = Tag|_Fields], _, _) = Rec, Opaques) -> - [O || O <- Opaques, t_inf(Rec, O, opaque) =/= ?none, - lists:member(Tag, t_opaque_tuple_tags(t_opaque_structure(O)))]; -t_opaque_match_record(_, _) -> []. - --spec t_opaque_tuple_tags(erl_type()) -> [erl_type()]. - -t_opaque_tuple_tags(OpaqueStruct) -> - case OpaqueStruct of - ?tuple([?atom(_) = Tag|_Fields], _, _) -> [Tag]; - ?tuple_set(_) = TupleSet -> - Tuples = t_tuple_subtypes(TupleSet), - lists:flatten([t_opaque_tuple_tags(T) || T <- Tuples]); - ?union([_,_,_,_,_,_,Tuples,_,_,_]) -> t_opaque_tuple_tags(Tuples); - _ -> [] - end. - %% 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(). @@ -605,9 +741,10 @@ 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), Term, Size); + ?list(t_struct_from_opaque(Types, Opaques), + t_struct_from_opaque(Term, Opaques), Size); t_struct_from_opaque(?opaque(_) = T, Opaques) -> - case lists:member(T, Opaques) of + case is_opaque_type(T, Opaques) of true -> t_opaque_structure(T); false -> T end; @@ -627,24 +764,10 @@ t_struct_from_opaque(Type, _Opaques) -> Type. list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. --spec t_unopaque_on_mismatch(erl_type(), erl_type(), [erl_type()]) -> erl_type(). - -t_unopaque_on_mismatch(GenType, Type, Opaques) -> - case t_inf(GenType, Type) of - ?none -> - Unopaqued = t_unopaque(Type, Opaques), - %% XXX: Unions might be a problem, must investigate. - case t_inf(GenType, Unopaqued) of - ?none -> Type; - _ -> Unopaqued - end; - _ -> Type - end. - -spec module_builtin_opaques(module()) -> [erl_type()]. module_builtin_opaques(Module) -> - [O || O <- all_opaque_builtins(), t_opaque_module(O) =:= Module]. + [O || O <- all_opaque_builtins(), lists:member(Module, t_opaque_modules(O))]. %%----------------------------------------------------------------------------- %% Remote types: these types are used for preprocessing; @@ -657,8 +780,11 @@ t_remote(Mod, Name, Args) -> -spec t_is_remote(erl_type()) -> boolean(). -t_is_remote(?remote(_)) -> true; -t_is_remote(_) -> false. +t_is_remote(Type) -> + do_opaque(Type, 'universe', fun is_remote/1). + +is_remote(?remote(_)) -> true; +is_remote(_) -> false. -spec t_solve_remote(erl_type(), set(), dict()) -> erl_type(). @@ -827,40 +953,75 @@ t_atoms(List) when is_list(List) -> -spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. -t_atom_vals(?atom(?any)) -> unknown; -t_atom_vals(?atom(Set)) -> set_to_list(Set); -t_atom_vals(Other) -> +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), - t_atom_vals(Atm). + atom_vals(Atm). -spec t_is_atom(erl_type()) -> boolean(). -t_is_atom(?atom(_)) -> true; -t_is_atom(_) -> false. +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_atom(atom(), erl_type()) -> boolean(). +-spec t_is_any_atom(atom(), erl_type()) -> boolean(). -t_is_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false; -t_is_atom(Atom, ?atom(Set)) when is_atom(Atom) -> set_is_singleton(Atom, Set); -t_is_atom(Atom, _) when is_atom(Atom) -> false. +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])). --spec t_is_boolean(erl_type()) -> boolean(). - -t_is_boolean(?atom(?any)) -> false; -t_is_boolean(?atom(Set)) -> +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; -t_is_boolean(_) -> false. +is_boolean(_) -> false. %%----------------------------------------------------------------------------- %% Binaries @@ -873,9 +1034,17 @@ t_binary() -> -spec t_is_binary(erl_type()) -> boolean(). -t_is_binary(?bitstr(U, B)) -> +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); -t_is_binary(_) -> false. +is_binary(_) -> false. %%----------------------------------------------------------------------------- %% Bitstrings @@ -922,19 +1091,27 @@ t_bitstr_concat_1([], Acc) -> t_bitstr_concat(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), - bitstr_concat(T1p, T2p). + 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(T1p, T2p). + bitstr_match(t_unopaque(T1p), t_unopaque(T2p)). -spec t_is_bitstr(erl_type()) -> boolean(). -t_is_bitstr(?bitstr(_, _)) -> true; -t_is_bitstr(_) -> false. +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 @@ -1045,27 +1222,59 @@ t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 -> -spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()]. -t_fun_args(?function(?any, _)) -> +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; -t_fun_args(?function(?product(Domain), _)) when is_list(Domain) -> +fun_args(?function(?product(Domain), _)) when is_list(Domain) -> Domain. -spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer(). -t_fun_arity(?function(?any, _)) -> +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; -t_fun_arity(?function(?product(Domain), _)) -> +fun_arity(?function(?product(Domain), _)) -> length(Domain). -spec t_fun_range(erl_type()) -> erl_type(). -t_fun_range(?function(_, Range)) -> +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(?function(_, _)) -> true; -t_is_fun(_) -> false. +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. @@ -1092,9 +1301,17 @@ t_port() -> -spec t_is_port(erl_type()) -> boolean(). -t_is_port(?identifier(?any)) -> false; -t_is_port(?identifier(Set)) -> set_is_singleton(?port_qual, Set); -t_is_port(_) -> false. +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. %%------------------------------------ @@ -1105,9 +1322,17 @@ t_pid() -> -spec t_is_pid(erl_type()) -> boolean(). -t_is_pid(?identifier(?any)) -> false; -t_is_pid(?identifier(Set)) -> set_is_singleton(?pid_qual, Set); -t_is_pid(_) -> false. +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. %%------------------------------------ @@ -1118,9 +1343,17 @@ t_reference() -> -spec t_is_reference(erl_type()) -> boolean(). -t_is_reference(?identifier(?any)) -> false; -t_is_reference(?identifier(Set)) -> set_is_singleton(?reference_qual, Set); -t_is_reference(_) -> false. +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. @@ -1138,21 +1371,39 @@ t_number(X) when is_integer(X) -> -spec t_is_number(erl_type()) -> boolean(). -t_is_number(?number(_, _)) -> true; -t_is_number(_) -> false. +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(?int_set(?any)) -> unknown; -t_number_vals(?int_set(Set)) -> set_to_list(Set); -t_number_vals(?number(_, _)) -> unknown; -t_number_vals(Other) -> +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(?any)) -> unknown; +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 - t_number_vals(Inf). + number_vals(Inf). %%------------------------------------ @@ -1163,8 +1414,16 @@ t_float() -> -spec t_is_float(erl_type()) -> boolean(). -t_is_float(?float) -> true; -t_is_float(_) -> false. +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. %%------------------------------------ @@ -1185,8 +1444,16 @@ t_integers(List) when is_list(List) -> -spec t_is_integer(erl_type()) -> boolean(). -t_is_integer(?integer(_)) -> true; -t_is_integer(_) -> false. +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. %%------------------------------------ @@ -1250,7 +1517,7 @@ t_cons(Hd, ?nil) -> t_cons(Hd, ?list(Contents, Termination, _)) -> ?nonempty_list(t_sup(Contents, Hd), Termination); t_cons(Hd, Tail) -> - case t_inf(Tail, t_maybe_improper_list()) of + 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. @@ -1262,18 +1529,45 @@ t_cons(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(?nonempty_list(_, _)) -> true; -t_is_cons(_) -> false. +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(?nonempty_list(Contents, _Termination)) -> Contents. +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(?nonempty_list(_Contents, Termination) = T) -> +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(). @@ -1283,8 +1577,16 @@ t_nil() -> -spec t_is_nil(erl_type()) -> boolean(). -t_is_nil(?nil) -> true; -t_is_nil(_) -> false. +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(). @@ -1300,8 +1602,16 @@ t_list(Contents) -> -spec t_list_elements(erl_type()) -> erl_type(). -t_list_elements(?list(Contents, _, _)) -> Contents; -t_list_elements(?nil) -> ?none. +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()) -> erl_type(). @@ -1356,9 +1666,17 @@ t_maybe_improper_list(Content, Termination) -> -spec t_is_maybe_improper_list(erl_type()) -> boolean(). -t_is_maybe_improper_list(?list(_, _, _)) -> true; -t_is_maybe_improper_list(?nil) -> true; -t_is_maybe_improper_list(_) -> false. +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(). @@ -1405,32 +1723,77 @@ t_tuple(List) -> -spec get_tuple_tags([erl_type()]) -> [erl_type(),...]. -get_tuple_tags([?atom(?any)|_]) -> [?any]; -get_tuple_tags([?atom(Set)|_]) -> +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; -get_tuple_tags(_) -> [?any]. +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(?tuple(Args, _, _)) when is_list(Args) -> Args. +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(?tuple(_, Size, _)) when is_integer(Size) -> Size. +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(?tuple(?any, ?any, ?any)) -> unknown; -t_tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size]; -t_tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List]. +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)) -> @@ -1438,9 +1801,17 @@ t_tuple_subtypes(?tuple_set(List)) -> -spec t_is_tuple(erl_type()) -> boolean(). -t_is_tuple(?tuple(_, _, _)) -> true; -t_is_tuple(?tuple_set(_)) -> true; -t_is_tuple(_) -> false. +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 @@ -1451,6 +1822,7 @@ t_is_tuple(_) -> false. t_bitstrlist() -> t_iolist(1, t_bitstr()). +%% XXX. To be removed. -spec t_constant() -> erl_type(). t_constant() -> @@ -1555,7 +1927,8 @@ t_timeout() -> t_array() -> t_opaque(array, array, [], t_tuple([t_atom('array'), - t_non_neg_integer(), t_non_neg_integer(), + t_sup([t_atom('undefined'), t_non_neg_integer()]), + t_sup([t_atom('undefined'), t_non_neg_integer()]), t_any(), t_any()])). -spec t_dict() -> erl_type(). @@ -1566,7 +1939,8 @@ t_dict() -> t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer(), t_non_neg_integer(), - t_tuple(), t_tuple()])). + t_sup([t_atom('undefined'), t_tuple()]), + t_sup([t_atom('undefined'), t_tuple()])])). -spec t_digraph() -> erl_type(). @@ -1601,7 +1975,9 @@ t_set() -> t_opaque(sets, set, [], t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(), t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), t_tuple(), t_tuple()])). + t_non_neg_integer(), + t_sup([t_atom('undefined'), t_tuple()]), + t_sup([t_atom('undefined'), t_tuple()])])). -spec t_tid() -> erl_type(). @@ -1673,8 +2049,11 @@ 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(?opaque(_)=T) -> +%% %% "Polymorphic opaque types not supported yet" +%% t_has_var(t_opaque_structure(T)); %% t_has_var(?union(_) = U) -> -%% exit(lists:flatten(io_lib:format("Union happens in t_has_var/1 ~p\n",[U]))); +%% exit(flat_format("Union happens in t_has_var/1 ~p\n",[U])); t_has_var(_) -> false. -spec t_has_var_list([erl_type()]) -> boolean(). @@ -1705,6 +2084,9 @@ t_collect_vars(?tuple(Types, _, _), Acc) -> t_collect_vars(?tuple_set(_) = TS, Acc) -> lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, t_tuple_subtypes(TS)); +%% t_collect_vars(?opaque(_)=T, Acc) -> +%% %% "Polymorphic opaque types not supported yet" +%% t_collect_vars(t_opaque_structure(T), Acc); t_collect_vars(_, Acc) -> Acc. @@ -1827,15 +2209,31 @@ t_is_bitwidth(_) -> false. -spec number_min(erl_type()) -> rng_elem(). -number_min(?int_range(From, _)) -> From; -number_min(?int_set(Set)) -> set_min(Set); -number_min(?number(?any, _Tag)) -> neg_inf. +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(?int_range(_, To)) -> To; -number_max(?int_set(Set)) -> set_max(Set); -number_max(?number(?any, _Tag)) -> pos_inf. +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(). %% @@ -1917,7 +2315,7 @@ t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) -> t_sup(?identifier(Set1), ?identifier(Set2)) -> ?identifier(set_union(Set1, Set2)); t_sup(?opaque(Set1), ?opaque(Set2)) -> - ?opaque(set_union_no_limit(Set1, 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; @@ -2005,6 +2403,27 @@ t_sup(T1, T2) -> ?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}, T} || + #opaque{mod = Mod, name = Name}=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]) -> @@ -2132,19 +2551,26 @@ t_elements(?number(_, _) = T) -> ?int_set(Set) -> [t_integer(I) || I <- Set] end; -t_elements(?opaque(_) = T) -> [T]; +t_elements(?opaque(_) = T) -> + do_elements(T); t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of unknown -> []; Elems -> Elems end; -t_elements(?union(List)) -> - lists:append([t_elements(T) || T <- List]); +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 %% @@ -2162,74 +2588,77 @@ t_inf([]) -> ?none. -spec t_inf(erl_type(), erl_type()) -> erl_type(). t_inf(T1, T2) -> - t_inf(T1, T2, structured). - --type t_inf_mode() :: 'opaque' | 'structured'. --spec t_inf(erl_type(), erl_type(), t_inf_mode()) -> erl_type(). - -t_inf(?var(_), ?var(_), _Mode) -> ?any; -t_inf(?var(_), T, _Mode) -> subst_all_vars_to_any(T); -t_inf(T, ?var(_), _Mode) -> subst_all_vars_to_any(T); -t_inf(?any, T, _Mode) -> subst_all_vars_to_any(T); -t_inf(T, ?any, _Mode) -> subst_all_vars_to_any(T); -t_inf(?none, _, _Mode) -> ?none; -t_inf(_, ?none, _Mode) -> ?none; -t_inf(?unit, _, _Mode) -> ?unit; % ?unit cases should appear below ?none -t_inf(_, ?unit, _Mode) -> ?unit; -t_inf(T, T, _Mode) -> subst_all_vars_to_any(T); + t_inf(T1, T2, 'universe'). + +%% 'match' should be used from t_find_unknown_opaque() only +-type t_inf_opaques() :: 'universe' + | [erl_type()] | {'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), _Mode) -> +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), _Mode) -> +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), _Mode) -> +t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Opaques) -> t_bitstr(U1, B1); -t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) when U2 > U1 -> +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), _Mode) -> +t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) -> inf_bitstr(U1, B1, U2, B2); -t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Mode) -> - case t_inf(Domain1, Domain2, Mode) of +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, Mode)) + Domain -> ?function(Domain, t_inf(Range1, Range2, Opaques)) end; -t_inf(?identifier(Set1), ?identifier(Set2), _Mode) -> +t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; -t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Mode) -> +t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) -> ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2)); -t_inf(?nil, ?nil, _Mode) -> ?nil; -t_inf(?nil, ?nonempty_list(_, _), _Mode) -> +t_inf(?nil, ?nil, _Opaques) -> ?nil; +t_inf(?nil, ?nonempty_list(_, _), _Opaques) -> ?none; -t_inf(?nonempty_list(_, _), ?nil, _Mode) -> +t_inf(?nonempty_list(_, _), ?nil, _Opaques) -> ?none; -t_inf(?nil, ?list(_Contents, Termination, _), Mode) -> - t_inf(?nil, Termination, Mode); -t_inf(?list(_Contents, Termination, _), ?nil, Mode) -> - t_inf(?nil, Termination, Mode); +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), Mode) -> - case t_inf(Termination1, Termination2, Mode) of + ?list(Contents2, Termination2, Size2), Opaques) -> + case t_inf(Termination1, Termination2, Opaques) of ?none -> ?none; Termination -> - case t_inf(Contents1, Contents2, Mode) of - ?none -> + 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 -> + Contents -> Size = case {Size1, Size2} of {?unknown_qual, ?unknown_qual} -> ?unknown_qual; @@ -2240,7 +2669,7 @@ t_inf(?list(Contents1, Termination1, Size1), ?list(Contents, Termination, Size) end end; -t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> +t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> case {T1, T2} of {T, T} -> T; {_, ?number(?any, ?unknown_qual)} -> T1; @@ -2249,16 +2678,16 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> {?integer(_), ?float} -> ?none; {?integer(?any), ?integer(_)} -> T2; {?integer(_), ?integer(?any)} -> T1; - {?int_set(Set1), ?int_set(Set2)} -> + {?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)} -> + {?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 = + Ans2 = case set_filter(fun(X) -> in_range(X, Range) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) @@ -2271,193 +2700,253 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> NewSet -> ?int_set(NewSet) end end; -t_inf(?product(Types1), ?product(Types2), Mode) -> +t_inf(?product(Types1), ?product(Types2), Opaques) -> L1 = length(Types1), L2 = length(Types2), - if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Mode)); + if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Opaques)); true -> ?none end; -t_inf(?product(_), _, _Mode) -> +t_inf(?product(_), _, _Opaques) -> ?none; -t_inf(_, ?product(_), _Mode) -> +t_inf(_, ?product(_), _Opaques) -> ?none; -t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Mode) -> +t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Mode) -> +t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Mode) -> +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), _Mode) -> +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), Mode) -> - case t_inf_lists_strict(Elements1, Elements2, Mode) of +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), Mode) -> - inf_tuple_sets(List1, List2, Mode); -t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Mode) -> - inf_tuple_sets(List, [{Arity, [T]}], Mode); -t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Mode) -> - inf_tuple_sets(List, [{Arity, [T]}], Mode); +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, Mode) -> +t_inf(?union(U1), T, Opaques) -> ?union(U2) = force_union(T), - inf_union(U1, U2, Mode); -t_inf(T, ?union(U2), Mode) -> + inf_union(U1, U2, Opaques); +t_inf(T, ?union(U2), Opaques) -> ?union(U1) = force_union(T), - inf_union(U1, U2, Mode); + 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(?opaque(Set1) = T1, ?opaque(Set2) = T2, Mode) -> - case set_intersection(Set1, Set2) of - ?none -> - case Mode =:= opaque of - true -> - Struct1 = t_opaque_structure(T1), - case t_inf(Struct1, T2) of - ?none -> - Struct2 = t_opaque_structure(T2), - case t_inf(Struct2, T1) of - ?none -> ?none; - _ -> T2 - end; - _ -> T1 - end; - false -> ?none - end; - NewSet -> ?opaque(NewSet) - end; -t_inf(?opaque(_) = T1, T2, opaque) -> - case t_inf(t_opaque_structure(T1), T2, structured) of - ?none -> ?none; - _Type -> T1 - end; -t_inf(T1, ?opaque(_) = T2, opaque) -> - case t_inf(T1, t_opaque_structure(T2), structured) of - ?none -> ?none; - _Type -> T2 - end; 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); +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) -> + #opaque{mod = Mod1, name = Name1} = T1, + #opaque{mod = Mod2, name = Name2} = T2, + case {Mod1, Name1} =:= {Mod2, Name2} of + true -> [comb(Mod1, Name1, S, T1)]; + false -> [comb(Mod1, Name1, S, T1), comb(Mod2, Name2, S, T2)] + end. + +comb(Mod, Name, S, T) -> + case is_same_name(Mod, Name, S) of + true -> S; + false -> T#opaque{struct = S} + end. + +is_same_name(Mod, Name, ?opaque([#opaque{mod = Mod, name = Name}])) -> true; +is_same_name(_Mod, _Name, _Opaque) -> false. + +%% Combining two lists this way can be very time consuming... +inf_opaque(Set1, Set2, Opaques) -> + List1 = inf_look_up(Set1, 1, Opaques), + List2 = inf_look_up(Set2, 2, Opaques), + List0 = [combine(Inf, T1, T2) || + {Is1, ModName1, T1} <- List1, + {Is2, ModName2, T2} <- List2, + not t_is_none(Inf = inf_opaque_types(Is1, ModName1, T1, + Is2, ModName2, T2, + Opaques))], + List = lists:sort(lists:append(List0)), + sup_opaque(List). + +%% Optimization: do just one lookup. +inf_look_up(Set, Pos, Opaques) -> + [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Pos, Opaques), + {M, N}, T} || + #opaque{mod = M, name = N} = T <- set_to_list(Set)]. + +inf_is_opaque_type2(T, Pos, {match, Opaques}) -> + is_opaque_type2(T, Opaques) orelse throw(Pos); +inf_is_opaque_type2(T, _Pos, Opaques) -> + is_opaque_type2(T, Opaques). + +inf_opaque_types(IsOpaque1, ModName1, T1, IsOpaque2, ModName2, T2, Opaques) -> + #opaque{struct = S1}=T1, + #opaque{struct = S2}=T2, + case Opaques =:= 'universe' orelse ModName1 =:= ModName2 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} -> t_none() + end + end. + -spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_inf_lists(L1, L2) -> - t_inf_lists(L1, L2, structured). + t_inf_lists(L1, L2, 'universe'). --spec t_inf_lists([erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()]. +-spec t_inf_lists([erl_type()], [erl_type()], t_inf_opaques()) -> [erl_type()]. -t_inf_lists(L1, L2, Mode) -> - t_inf_lists(L1, L2, [], Mode). +t_inf_lists(L1, L2, Opaques) -> + t_inf_lists(L1, L2, [], Opaques). --spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()]. +-spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> [erl_type()]. -t_inf_lists([T1|Left1], [T2|Left2], Acc, Mode) -> - t_inf_lists(Left1, Left2, [t_inf(T1, T2, Mode)|Acc], Mode); -t_inf_lists([], [], Acc, _Mode) -> +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()], t_inf_mode()) -> 'bottom' | [erl_type()]. +-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. -t_inf_lists_strict(L1, L2, Mode) -> - t_inf_lists_strict(L1, L2, [], Mode). +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()], t_inf_mode()) -> 'bottom' | [erl_type()]. +-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, Mode) -> - case t_inf(T1, T2, Mode) of +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], Mode) + T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Opaques) end; -t_inf_lists_strict([], [], Acc, _Mode) -> +t_inf_lists_strict([], [], Acc, _Opaques) -> lists:reverse(Acc). --spec t_inf_lists_masked([erl_type()], [erl_type()], [t_inf_mode()]) -> [erl_type()]. - -t_inf_lists_masked(List1, List2, Mask) -> - List = lists:zip3(List1, List2, Mask), - [t_inf(T1, T2, Mode) || {T1, T2, Mode} <- List]. - -inf_tuple_sets(L1, L2, Mode) -> - case inf_tuple_sets(L1, L2, [], Mode) of +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, Mode) -> - case inf_tuples_in_sets(Tuples1, Tuples2, Mode) of - [] -> inf_tuple_sets(Ts1, Ts2, Acc, Mode); +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], Mode); - NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Mode) + 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, Mode) -> - if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Mode); - Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Mode) +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, _Mode) -> lists:reverse(Acc); -inf_tuple_sets(_, [], Acc, _Mode) -> lists:reverse(Acc). - -inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Mode) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Mode) +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)], Mode) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Mode) +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, Mode) -> - inf_tuples_in_sets(L1, L2, [], Mode). +inf_tuples_in_sets(L1, L2, Opaques) -> + inf_tuples_in_sets2(L1, L2, [], Opaques). -inf_tuples_in_sets([?tuple(Elements1, Arity, Tag)|Ts1], - [?tuple(Elements2, Arity, Tag)|Ts2], Acc, Mode) -> - case t_inf_lists_strict(Elements1, Elements2, Mode) of - bottom -> inf_tuples_in_sets(Ts1, Ts2, Acc, Mode); +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_sets(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc], Mode) + 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_sets([?tuple(_, _, Tag1)|Ts1] = L1, - [?tuple(_, _, Tag2)|Ts2] = L2, Acc, Mode) -> - if Tag1 < Tag2 -> inf_tuples_in_sets(Ts1, L2, Acc, Mode); - Tag1 > Tag2 -> inf_tuples_in_sets(L1, Ts2, Acc, Mode) +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,_,_R] = Union2, + List = [A,B,F,I,L,N,T,M], + inf_union_collect(List, Opaque, InfFun, [], []) + end, + O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), + O2 = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), + Union = inf_union(U1, U2, 0, [], Opaques), + t_sup([O1, O2, Union]). + +inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> + case t_sup(InfList) of + ?none when ThrowList =/= [] -> throw(hd(lists:flatten(ThrowList))); + Sup -> Sup end; -inf_tuples_in_sets([], _, Acc, _Mode) -> lists:reverse(Acc); -inf_tuples_in_sets(_, [], Acc, _Mode) -> lists:reverse(Acc). - -inf_union(U1, U2, opaque) -> -%%--------------------------------------------------------------------- -%% Under Testing -%%---------------------------------------------------------------------- -%% OpaqueFun = -%% fun(Union1, Union2) -> -%% [_,_,_,_,_,_,_,_,Opaque,_] = Union1, -%% [A,B,F,I,L,N,T,M,_,_R] = Union2, -%% List = [A,B,F,I,L,N,T,M], -%% case [T || T <- List, t_inf(T, Opaque, opaque) =/= ?none] of -%% [] -> ?none; -%% _ -> Opaque -%% end -%% end, -%% O1 = OpaqueFun(U1, U2), -%% O2 = OpaqueFun(U2, U1), -%% Union = inf_union(U1, U2, 0, [], opaque), -%% t_sup([O1, O2, Union]); - inf_union(U1, U2, 0, [], opaque); -inf_union(U1, U2, OtherMode) -> - inf_union(U1, U2, 0, [], OtherMode). - -inf_union([?none|Left1], [?none|Left2], N, Acc, Mode) -> - inf_union(Left1, Left2, N, [?none|Acc], Mode); -inf_union([T1|Left1], [T2|Left2], N, Acc, Mode) -> - case t_inf(T1, T2, Mode) of - ?none -> inf_union(Left1, Left2, N, [?none|Acc], Mode); - T -> inf_union(Left1, Left2, N+1, [T|Acc], Mode) +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:N when is_integer(N) -> + inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList]) + end. + +inf_union([?none|Left1], [?none|Left2], N, Acc, Opaques) -> + inf_union(Left1, Left2, N, [?none|Acc], Opaques); +inf_union([T1|Left1], [T2|Left2], N, Acc, Opaques) -> + case t_inf(T1, T2, Opaques) of + ?none -> inf_union(Left1, Left2, N, [?none|Acc], Opaques); + T -> inf_union(Left1, Left2, N+1, [T|Acc], Opaques) end; -inf_union([], [], N, Acc, _Mode) -> +inf_union([], [], N, Acc, _Opaques) -> if N =:= 0 -> ?none; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], @@ -2536,6 +3025,11 @@ t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> t_tuple([t_subst_dict(E, Dict) || E <- Elements]); t_subst_dict(?tuple_set(_) = TS, Dict) -> t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); +%% t_subst_dict(?opaque(Es), Dict) -> +%% %% "Polymorphic opaque types not supported yet" +%% List = [Opaque#opaque{struct = t_subst_dict(S, Dict)} || +%% Opaque = #opaque{struct = S} <- set_to_list(Es)], +%% ?opaque(ordsets:from_list(List)); t_subst_dict(T, _Dict) -> T. @@ -2578,6 +3072,11 @@ t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, VarMap) -> t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); +%% t_subst_aux(?opaque(Es), VarMap) -> +%% %% "Polymorphic opaque types not supported yet" +%% List = [Opaque#opaque{struct = t_subst_aux(S, VarMap)} || +%% Opaque = #opaque{struct = S} <- set_to_list(Es)], +%% ?opaque(ordsets:from_list(List)); t_subst_aux(T, _VarMap) -> T. @@ -2590,112 +3089,147 @@ t_subst_aux(T, _VarMap) -> -spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> - t_unify(T1, T2, []). - --spec t_unify(erl_type(), erl_type(), [erl_type()]) -> t_unify_ret(). - -t_unify(T1, T2, Opaques) -> - {T, VarMap} = t_unify(T1, T2, [], Opaques), + {T, VarMap} = t_unify(T1, T2, []), {t_subst_kv(T, VarMap), lists:keysort(1, VarMap)}. -t_unify(?var(Id) = T, ?var(Id), VarMap, _Opaques) -> +t_unify(?var(Id) = T, ?var(Id), VarMap) -> {T, VarMap}; -t_unify(?var(Id1) = T, ?var(Id2), VarMap, Opaques) -> +t_unify(?var(Id1) = T, ?var(Id2), VarMap) -> case lists:keyfind(Id1, 1, VarMap) of false -> case lists:keyfind(Id2, 1, VarMap) of false -> {T, [{Id2, T} | VarMap]}; - {Id2, Type} -> t_unify(T, Type, VarMap, Opaques) + {Id2, Type} -> t_unify(T, Type, VarMap) end; {Id1, Type1} -> case lists:keyfind(Id2, 1, VarMap) of false -> {Type1, [{Id2, T} | VarMap]}; - {Id2, Type2} -> t_unify(Type1, Type2, VarMap, Opaques) + {Id2, Type2} -> t_unify(Type1, Type2, VarMap) end end; -t_unify(?var(Id), Type, VarMap, Opaques) -> +t_unify(?var(Id), Type, VarMap) -> case lists:keyfind(Id, 1, VarMap) of false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) + {Id, VarType} -> t_unify(VarType, Type, VarMap) end; -t_unify(Type, ?var(Id), VarMap, Opaques) -> +t_unify(Type, ?var(Id), VarMap) -> case lists:keyfind(Id, 1, VarMap) of false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) + {Id, VarType} -> t_unify(VarType, Type, VarMap) end; -t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap, Opaques) -> - {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap, Opaques), - {Range, VarMap2} = t_unify(Range1, Range2, VarMap1, Opaques), +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, Opaques) -> - {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap, Opaques), - {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1, Opaques), + ?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, Opaques) -> - {Types, VarMap1} = unify_lists(Types1, Types2, VarMap, Opaques), +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, _Opaques) -> +t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap) -> {T, VarMap}; t_unify(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _), VarMap, Opaques) when Arity =/= ?any -> - {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap, Opaques), + ?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, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T1, T2, VarMap, Opaques); + ?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, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T2, T1, VarMap, Opaques); -t_unify(?tuple_set(List1), ?tuple_set(List2), VarMap, Opaques) -> - {Tuples, NewVarMap} = - unify_lists(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2]), VarMap, Opaques), - {t_sup(Tuples), NewVarMap}; -t_unify(?opaque(Elements) = T, ?opaque(Elements), VarMap, _Opaques) -> - {T, VarMap}; -t_unify(?opaque(_) = T1, ?opaque(_) = T2, _VarMap, _Opaques) -> - throw({mismatch, T1, T2}); -t_unify(Type, ?opaque(_) = OpType, VarMap, Opaques) -> - t_unify_with_opaque(Type, OpType, VarMap, Opaques); -t_unify(?opaque(_) = OpType, Type, VarMap, Opaques) -> - t_unify_with_opaque(Type, OpType, VarMap, Opaques); -t_unify(T, T, VarMap, _Opaques) -> + ?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(?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(T1, T2, _, _) -> +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}). -t_unify_with_opaque(Type, OpType, VarMap, Opaques) -> - case lists:member(OpType, Opaques) of +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,R] = List, + if O =:= ?none -> no; true -> - Struct = t_opaque_structure(OpType), - try t_unify(Type, Struct, VarMap, Opaques) of - {_T, VarMap1} -> {OpType, VarMap1} - catch - throw:{mismatch, _T1, _T2} -> - case t_inf(OpType, Type, opaque) of - ?none -> throw({mismatch, Type, OpType}); - _ -> {OpType, VarMap} - end - end; - false -> - throw({mismatch, Type, OpType}) + S = t_opaque_structure(O), + {yes, t_sup([A,B,F,I,L,N,T,M,S,R])} end. -unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _), VarMap, Opaques) -> +-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}, Opaques) -> + F1 = fun(?opaque(Es)) -> + F2 = fun(#opaque{mod = Mod, name = Name}) -> + Mod1 =:= Mod andalso Name1 =:= Name + end, + lists:any(F2, Es) + end, + lists:any(F1, Opaques). + +%% 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(sup_tuple_elements(List), Elements2, VarMap, Opaques), + {NewElements, VarMap1} = + unify_lists(Elements2, sup_tuple_elements(List), VarMap), {t_tuple(NewElements), VarMap1}. -unify_lists(L1, L2, VarMap, Opaques) -> - unify_lists(L1, L2, VarMap, [], Opaques). +unify_lists(L1, L2, VarMap) -> + unify_lists(L1, L2, VarMap, []). -unify_lists([T1|Left1], [T2|Left2], VarMap, Acc, Opaques) -> - {NewT, NewVarMap} = t_unify(T1, T2, VarMap, Opaques), - unify_lists(Left1, Left2, NewVarMap, [NewT|Acc], Opaques); -unify_lists([], [], VarMap, Acc, _Opaques) -> +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) -> @@ -2837,11 +3371,12 @@ t_subtract(?identifier(Set1), ?identifier(Set2)) -> ?none -> ?none; Set -> ?identifier(Set) end; -t_subtract(?opaque(Set1), ?opaque(Set2)) -> - case set_subtract(Set1, Set2) of - ?none -> ?none; - Set -> ?opaque(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 @@ -2976,6 +3511,17 @@ t_subtract(T1, T2) -> ?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) -> @@ -2991,7 +3537,18 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - subtract_union(U1, U2, 0, []). + [A1,B1,F1,I1,L1,N1,T1,M1,O1,R1] = U1, + [A2,B2,F2,I2,L2,N2,T2,M2,O2,R2] = U2, + List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,R1], + List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,R2], + 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(). @@ -3052,10 +3609,24 @@ t_is_equal(_, _) -> false. t_is_subtype(T1, T2) -> Inf = t_inf(T1, T2), - t_is_equal(T1, Inf). + 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)). @@ -3067,12 +3638,12 @@ t_unopaque(T) -> -spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> - case Opaques =:= universe orelse lists:member(T, Opaques) of + case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); false -> T % XXX: needs revision for parametric opaque data types end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> - ?list(t_unopaque(ElemT, Opaques), Termination, Sz); + ?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], @@ -3081,14 +3652,19 @@ 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,R]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), - UO = case O of - ?none -> []; - ?opaque(Os) -> [t_unopaque(S, Opaques) || #opaque{struct = S} <- Os] - end, - t_sup([?union([A,B,F,I,UL,N,UT,M,?none,R])|UO]); + UF = t_unopaque(F, 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,M,OF,R])|UO]); t_unopaque(T, _) -> T. @@ -3134,6 +3710,12 @@ 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(T, _K) -> T. %%============================================================================ @@ -3167,7 +3749,7 @@ t_abstract_records(?union(Types), RecDict) -> t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) -> T; t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) -> - [TagAtom] = t_atom_vals(Tag), + [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity - 1, RecDict) of error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]]) @@ -3176,6 +3758,8 @@ 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. @@ -3198,6 +3782,14 @@ t_map(Fun, ?tuple(Elements, _Arity, _Tag)) -> Fun(t_tuple([t_map(Fun, E) || E <- Elements])); t_map(Fun, ?tuple_set(_) = Tuples) -> Fun(t_sup([t_map(Fun, T) || T <- t_tuple_subtypes(Tuples)])); +t_map(Fun, ?opaque(Set)) -> + L = [Opaque#opaque{struct = NewS} || + #opaque{struct = S} = Opaque <- set_to_list(Set), + not t_is_none(NewS = t_map(Fun, S))], + Fun(case L of + [] -> ?none; + _ -> ?opaque(ordsets:from_list(L)) + end); t_map(Fun, T) -> Fun(T). @@ -3239,11 +3831,11 @@ t_to_string(?bitstr(8, 0), _RecDict) -> t_to_string(?bitstr(1, 0), _RecDict) -> "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> - lists:flatten(io_lib:format("<<_:~w>>", [B])); + flat_format("<<_:~w>>", [B]); t_to_string(?bitstr(U, 0), _RecDict) -> - lists:flatten(io_lib:format("<<_:_*~w>>", [U])); + flat_format("<<_:_*~w>>", [U]); t_to_string(?bitstr(U, B), _RecDict) -> - lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])); + flat_format("<<_:~w,_:_*~w>>", [B, U]); t_to_string(?function(?any, ?any), _RecDict) -> "fun()"; t_to_string(?function(?any, Range), RecDict) -> @@ -3255,18 +3847,16 @@ t_to_string(?identifier(Set), _RecDict) -> case Set of ?any -> "identifier()"; _ -> - string:join([io_lib:format("~w()", [T]) || T <- set_to_list(Set)], " | ") + string:join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ") end; -t_to_string(?opaque(Set), _RecDict) -> - string:join([case is_opaque_builtin(Mod, Name) of - true -> io_lib:format("~w()", [Name]); - false -> io_lib:format("~w:~w()", [Mod, Name]) - end - || #opaque{mod = Mod, name = Name} <- set_to_list(Set)], +t_to_string(?opaque(Set), RecDict) -> + string:join([opaque_type(Mod, Name, S, RecDict) || + #opaque{mod = Mod, name = Name, struct = S} + <- set_to_list(Set)], " | "); t_to_string(?matchstate(Pres, Slots), RecDict) -> - io_lib:format("ms(~s,~s)", [t_to_string(Pres, RecDict), - t_to_string(Slots,RecDict)]); + flat_format("ms(~s,~s)", [t_to_string(Pres, RecDict), + t_to_string(Slots,RecDict)]); t_to_string(?nil, _RecDict) -> "[]"; t_to_string(?nonempty_list(Contents, Termination), RecDict) -> @@ -3282,7 +3872,9 @@ t_to_string(?nonempty_list(Contents, Termination), RecDict) -> case Contents =:= ?any of true -> ok; false -> - erlang:error({illegal_list, ?nonempty_list(Contents, Termination)}) + %% XXX. See comment below. + %% erlang:error({illegal_list, ?nonempty_list(Contents, Termination)}) + ok end, "nonempty_maybe_improper_list()"; _ -> @@ -3305,11 +3897,14 @@ t_to_string(?list(Contents, Termination, ?unknown_qual), RecDict) -> 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 -> - L = ?list(Contents, Termination, ?unknown_qual), - erlang:error({illegal_list, L}) + ok + %% L = ?list(Contents, Termination, ?unknown_qual), + %% erlang:error({illegal_list, L}) end, "maybe_improper_list()"; _ -> @@ -3330,7 +3925,7 @@ 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) -> - lists:flatten(io_lib:format("~w..~w", [From, To])); + 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()"; @@ -3338,10 +3933,10 @@ t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; t_to_string(?remote(Set), RecDict) -> string:join([case Args =:= [] of - true -> io_lib:format("~w:~w()", [Mod, Name]); + true -> flat_format("~w:~w()", [Mod, Name]); false -> ArgString = comma_sequence(Args, RecDict), - io_lib:format("~w:~w(~s)", [Mod, Name, ArgString]) + flat_format("~w:~w(~s)", [Mod, Name, ArgString]) end || #remote{mod = Mod, name = Name, args = Args} <- set_to_list(Set)], @@ -3350,7 +3945,7 @@ 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] = t_atom_vals(Tag), + [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity-1, RecDict) of error -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; {ok, FieldNames} -> @@ -3361,9 +3956,9 @@ t_to_string(?tuple_set(_) = 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) -> - io_lib:format("~s", [atom_to_list(Id)]); + flat_format("~s", [atom_to_list(Id)]); t_to_string(?var(Id), _RecDict) when is_integer(Id) -> - io_lib:format("var(~w)", [Id]). + flat_format("var(~w)", [Id]). record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), @@ -3371,7 +3966,7 @@ record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> record_fields_to_string([F|Fs], [{FName, _DefType}|FDefs], RecDict, Acc) -> NewAcc = - case t_is_any(F) orelse t_is_atom('undefined', F) of + case t_is_equal(F, t_any()) orelse t_is_any_atom('undefined', F) of true -> Acc; false -> StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict), @@ -3389,13 +3984,14 @@ record_fields_to_string([], [], _RecDict, Acc) -> -spec record_field_diffs_to_string(erl_type(), dict()) -> string(). record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) -> - [TagAtom] = t_atom_vals(Tag), + [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, []), string:join(FieldDiffs, " and "). field_diffs([F|Fs], [{FName, DefType}|FDefs], RecDict, Acc) -> + %% Don't care about opaqueness for now. NewAcc = case not t_is_none(t_inf(F, DefType)) of true -> Acc; @@ -3418,6 +4014,24 @@ union_sequence(Types, RecDict) -> List = [t_to_string(T, RecDict) || T <- Types], string:join(List, " | "). +-ifdef(DEBUG). +opaque_type(Mod, Name, S, RecDict) -> + opaque_name(Mod, Name, t_to_string(S, RecDict)). +-else. +opaque_type(Mod, Name, _S, _RecDict) -> + opaque_name(Mod, Name, ""). +-endif. + +opaque_name(Mod, Name, Extra) -> + S = mod_name(Mod, Name), + flat_format("~s(~s)", [S, Extra]). + +mod_name(Mod, Name) -> + case is_opaque_builtin(Mod, Name) of + true -> flat_format("~w", [Name]); + false -> flat_format("~w:~w", [Mod, Name]) + end. + %%============================================================================= %% %% Build a type from parse forms. @@ -3437,246 +4051,197 @@ t_from_form(Form, RecDict) -> -spec t_from_form(parse_form(), dict(), dict()) -> erl_type(). t_from_form(Form, RecDict, VarDict) -> - {T, _R} = t_from_form(Form, [], false, RecDict, VarDict), + {T, _R} = t_from_form(Form, [], RecDict, VarDict), T. -type type_names() :: [{'type' | 'opaque' | 'record', atom()}]. --spec t_from_form(parse_form(), type_names(), boolean(), dict(), dict()) -> +-spec t_from_form(parse_form(), type_names(), dict(), dict()) -> {erl_type(), type_names()}. -t_from_form({var, _L, '_'}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> +t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({var, _L, Name}, _TypeNames, _InOpaque, _RecDict, VarDict) -> +t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) -> case dict:find(Name, VarDict) of error -> {t_var(Name), []}; {ok, Val} -> {Val, []} end; -t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); -t_from_form({paren_type, _L, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); +t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) -> + t_from_form(Type, TypeNames, RecDict, VarDict); +t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) -> + t_from_form(Type, TypeNames, RecDict, VarDict); t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), + TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), {t_remote(Module, Type, L), R}; -t_from_form({atom, _L, Atom}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> +t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) -> {t_atom(Atom), []}; -t_from_form({integer, _L, Int}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> +t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) -> {t_integer(Int), []}; -t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _RecDict, _VarDict) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), []}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _InOpaque, +t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _RecDict, _VarDict) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), []}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({type, _L, any, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({type, _L, arity, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> {t_arity(), []}; -t_from_form({type, _L, array, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, array, []}, _TypeNames, _RecDict, _VarDict) -> {t_array(), []}; -t_from_form({type, _L, atom, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> {t_atom(), []}; -t_from_form({type, _L, binary, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> {t_binary(), []}; t_from_form({type, _L, binary, [Base, Unit]} = Type, - _TypeNames, _InOpaque, _RecDict, _VarDict) -> + _TypeNames, _RecDict, _VarDict) -> 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), []}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, bitstring, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) -> {t_bitstr(), []}; -t_from_form({type, _L, bool, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) -> {t_boolean(), []}; % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) -> {t_boolean(), []}; -t_from_form({type, _L, byte, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> {t_byte(), []}; -t_from_form({type, _L, char, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> {t_char(), []}; -t_from_form({type, _L, dict, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, dict, []}, _TypeNames, _RecDict, _VarDict) -> {t_dict(), []}; -t_from_form({type, _L, digraph, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, digraph, []}, _TypeNames, _RecDict, _VarDict) -> {t_digraph(), []}; -t_from_form({type, _L, float, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> {t_float(), []}; -t_from_form({type, _L, function, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> {t_fun(), []}; -t_from_form({type, _L, 'fun', []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) -> {t_fun(), []}; t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, - InOpaque, RecDict, VarDict) -> - {T, R} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), + RecDict, VarDict) -> + {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(T), R}; t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {L, R1} = list_from_form(Domain, TypeNames, InOpaque, RecDict, VarDict), - {T, R2} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), + TypeNames, RecDict, VarDict) -> + {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), + {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, gb_set, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, gb_set, []}, _TypeNames, _RecDict, _VarDict) -> {t_gb_set(), []}; -t_from_form({type, _L, gb_tree, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, gb_tree, []}, _TypeNames, _RecDict, _VarDict) -> {t_gb_tree(), []}; -t_from_form({type, _L, identifier, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> {t_identifier(), []}; -t_from_form({type, _L, integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> {t_integer(), []}; -t_from_form({type, _L, iodata, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) -> {t_iodata(), []}; -t_from_form({type, _L, iolist, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) -> {t_iolist(), []}; -t_from_form({type, _L, list, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> {t_list(), []}; -t_from_form({type, _L, list, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), +t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> + {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, mfa, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; -t_from_form({type, _L, module, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> {t_module(), []}; -t_from_form({type, _L, nil, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) -> {t_nil(), []}; -t_from_form({type, _L, neg_integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> {t_neg_integer(), []}; -t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _InOpaque, _RecDict, +t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict, _VarDict) -> {t_non_neg_integer(), []}; -t_from_form({type, _L, no_return, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) -> {t_unit(), []}; -t_from_form({type, _L, node, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) -> {t_node(), []}; -t_from_form({type, _L, none, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) -> {t_none(), []}; -t_from_form({type, _L, nonempty_list, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) -> {t_nonempty_list(), []}; -t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), +t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) -> + {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_nonempty_list(T), R}; t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, - InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), + RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), {t_cons(T1, T2), R1 ++ R2}; t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, - _InOpaque, _RecDict, _VarDict) -> + _RecDict, _VarDict) -> {t_cons(?any, ?any), []}; t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), + TypeNames, RecDict, VarDict) -> + {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict), {t_cons(T1, T2), R1 ++ R2}; -t_from_form({type, _L, nonempty_string, []}, _TypeNames, _InOpaque, _RecDict, +t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict, _VarDict) -> {t_nonempty_string(), []}; -t_from_form({type, _L, number, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) -> {t_number(), []}; -t_from_form({type, _L, pid, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) -> {t_pid(), []}; -t_from_form({type, _L, port, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) -> {t_port(), []}; -t_from_form({type, _L, pos_integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) -> {t_pos_integer(), []}; -t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _InOpaque, +t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _RecDict, _VarDict) -> {t_maybe_improper_list(), []}; t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Content, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Termination, TypeNames, InOpaque, RecDict, VarDict), + TypeNames, RecDict, VarDict) -> + {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict), + {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict), {t_maybe_improper_list(T1, T2), R1 ++ R2}; -t_from_form({type, _L, product, Elements}, TypeNames, InOpaque, RecDict, - VarDict) -> - {L, R} = list_from_form(Elements, TypeNames, InOpaque, RecDict, VarDict), +t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), {t_product(L), R}; -t_from_form({type, _L, queue, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, queue, []}, _TypeNames, _RecDict, _VarDict) -> {t_queue(), []}; t_from_form({type, _L, range, [From, To]} = Type, - _TypeNames, _InOpaque, _RecDict, _VarDict) -> + _TypeNames, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> {t_from_range(FromVal, ToVal), []}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, record, [Name|Fields]}, TypeNames, InOpaque, RecDict, - VarDict) -> - record_from_form(Name, Fields, TypeNames, InOpaque, RecDict, VarDict); -t_from_form({type, _L, reference, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> + record_from_form(Name, Fields, TypeNames, RecDict, VarDict); +t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> {t_reference(), []}; -t_from_form({type, _L, set, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, set, []}, _TypeNames, _RecDict, _VarDict) -> {t_set(), []}; -t_from_form({type, _L, string, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> {t_string(), []}; -t_from_form({type, _L, term, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({type, _L, tid, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, tid, []}, _TypeNames, _RecDict, _VarDict) -> {t_tid(), []}; -t_from_form({type, _L, timeout, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> {t_timeout(), []}; -t_from_form({type, _L, tuple, any}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> {t_tuple(), []}; -t_from_form({type, _L, tuple, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), +t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), {t_tuple(L), R}; -t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), +t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> + {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), {t_sup(L), R}; -t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> +t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> ArgsLen = length(Args), case lookup_type(Name, ArgsLen, RecDict) of {type, {_Module, Type, ArgNames}} -> @@ -3685,13 +4250,12 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> List = lists:zipwith( fun(ArgName, ArgType) -> {Ttemp, _R} = t_from_form(ArgType, TypeNames, - InOpaque, RecDict, - VarDict), + RecDict, VarDict), {ArgName, Ttemp} end, ArgNames, Args), TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{type, Name}|TypeNames], InOpaque, + {T, R} = t_from_form(Type, [{type, Name}|TypeNames], RecDict, TmpVarDict), case lists:member({type, Name}, R) of true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; @@ -3706,13 +4270,12 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> List = lists:zipwith( fun(ArgName, ArgType) -> {Ttemp, _R} = t_from_form(ArgType, TypeNames, - InOpaque, RecDict, - VarDict), + RecDict, VarDict), {ArgName, Ttemp} end, ArgNames, Args), TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], true, + {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], RecDict, TmpVarDict), case lists:member({opaque, Name}, R) of true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; @@ -3720,27 +4283,21 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> end; false -> {t_any(), [{opaque, Name}]} end, - Tret = - case InOpaque of - true -> Rep; - false -> - t_from_form({opaque, -1, Name, {Module, Args, Rep}}, - RecDict, VarDict) - end, + Tret = t_from_form({opaque, -1, Name, {Module, Args, Rep}}, + RecDict, VarDict), {Tret, Rret}; error -> Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), throw({error, Msg}) end; -t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, +t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, _VarDict) -> case Args of [] -> {t_opaque(Mod, Name, Args, Rep), []}; _ -> throw({error, "Polymorphic opaque types not supported yet"}) end. -record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict, - VarDict) -> +record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) -> case can_unfold_more({record, Name}, TypeNames) of true -> case lookup_record(Name, RecDict) of @@ -3751,11 +4308,11 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict, {DeclFields1, R1} = case lists:all(fun(Elem) -> Elem end, AreTyped) of true -> {DeclFields, []}; - false -> fields_from_form(DeclFields, TypeNames1, InOpaque, + false -> fields_from_form(DeclFields, TypeNames1, RecDict, dict:new()) end, {GetModRec, R2} = get_mod_record(ModFields, DeclFields1, - TypeNames1, InOpaque, + TypeNames1, RecDict, VarDict), case GetModRec of {error, FieldName} -> @@ -3772,13 +4329,11 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict, false -> {t_any(), []} end. -get_mod_record([], DeclFields, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) -> {{ok, DeclFields}, []}; -get_mod_record(ModFields, DeclFields, TypeNames, InOpaque, RecDict, - VarDict) -> +get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) -> DeclFieldsDict = orddict:from_list(DeclFields), - {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, InOpaque, + {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, RecDict, VarDict), case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of {error, _FieldName} = Error -> {Error, R}; @@ -3788,17 +4343,16 @@ get_mod_record(ModFields, DeclFields, TypeNames, InOpaque, RecDict, R} end. -build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict) -> - build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict, []). +build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) -> + build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []). build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], - TypeNames, InOpaque, RecDict, VarDict, Acc) -> - {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), + TypeNames, RecDict, VarDict, Acc) -> + {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), NewAcc = [{Name, T}|Acc], - {D, R2} = build_field_dict(Left, TypeNames, InOpaque, RecDict, VarDict, - NewAcc), + {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc), {D, R1 ++ R2}; -build_field_dict([], _TypeNames, _InOpaque, _RecDict, _VarDict, Acc) -> +build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) -> {orddict:from_list(Acc), []}. get_mod_record([{FieldName, DeclType}|Left1], @@ -3817,19 +4371,19 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. -fields_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> +fields_from_form([], _TypeNames, _RecDict, _VarDict) -> {[], []}; -fields_from_form([{Name, Type}|Tail], TypeNames, InOpaque, RecDict, +fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, VarDict) -> - {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), - {F, R2} = fields_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), + {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict), + {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict), {[{Name, T}|F], R1 ++ R2}. -list_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> +list_from_form([], _TypeNames, _RecDict, _VarDict) -> {[], []}; -list_from_form([H|Tail], TypeNames, InOpaque, RecDict, VarDict) -> - {T, R1} = t_from_form(H, TypeNames, InOpaque, RecDict, VarDict), - {L, R2} = list_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), +list_from_form([H|Tail], TypeNames, RecDict, VarDict) -> + {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict), + {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict), {[T|L], R1 ++ R2}. -spec t_form_to_string(parse_form()) -> string(). @@ -3852,10 +4406,10 @@ t_form_to_string({op, _L, _Op, _Arg1, _Arg2} = Op) -> 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]}) -> - io_lib:format("(~s)", [t_form_to_string(Type)]); + flat_format("(~s)", [t_form_to_string(Type)]); t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) -> ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")", - io_lib:format("~w:~w", [Mod, Name]) ++ ArgString; + flat_format("~w:~w", [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) -> @@ -3866,9 +4420,9 @@ t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> {0, 0} -> "<<>>"; {8, 0} -> "binary()"; {1, 0} -> "bitstring()"; - {0, B} -> lists:flatten(io_lib:format("<<_:~w>>", [B])); - {U, 0} -> lists:flatten(io_lib:format("<<_:_*~w>>", [U])); - {U, B} -> lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])) + {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; @@ -3894,16 +4448,16 @@ t_form_to_string({type, _L, product, 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}} -> - io_lib:format("~w..~w", [FromVal, ToVal]); - _ -> io_lib:format("Badly formed type ~w",[Type]) + flat_format("~w..~w", [FromVal, ToVal]); + _ -> flat_format("Badly formed type ~w",[Type]) end; t_form_to_string({type, _L, record, [{atom, _, Name}]}) -> - io_lib:format("#~w{}", [Name]); + flat_format("#~w{}", [Name]); t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) -> FieldString = string:join(t_form_to_string_list(Fields), ","), - io_lib:format("#~w{~s}", [Name, FieldString]); + flat_format("#~w{~s}", [Name, FieldString]); t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) -> - io_lib:format("~w::~s", [Name, t_form_to_string(Type)]); + flat_format("~w::~s", [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()"; @@ -3916,8 +4470,8 @@ t_form_to_string({type, _L, Name, []} = T) -> catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; t_form_to_string({type, _L, Name, List}) -> - io_lib:format("~w(~s)", - [Name, string:join(t_form_to_string_list(List), ",")]). + flat_format("~w(~s)", + [Name, string:join(t_form_to_string_list(List), ",")]). t_form_to_string_list(List) -> t_form_to_string_list(List, []). @@ -3930,7 +4484,7 @@ t_form_to_string_list([], Acc) -> -spec atom_to_string(atom()) -> string(). atom_to_string(Atom) -> - lists:flatten(io_lib:format("~w", [Atom])). + flat_format("~w", [Atom]). %%============================================================================= %% @@ -4002,6 +4556,29 @@ 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,R] = 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,R]), Opaques, Pred); + false -> Pred(Type) + end + end; +do_opaque(Type, _Opaques, Pred) -> + Pred(Type). + %% ----------------------------------- %% Set %% @@ -4068,7 +4645,7 @@ set_size(Set) -> set_to_string(Set) -> L = [case is_atom(X) of true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs ' - false -> io_lib:format("~w", [X]) + false -> flat_format("~w", [X]) end || X <- set_to_list(Set)], string:join(L, " | "). @@ -4077,6 +4654,9 @@ set_min([H|_]) -> H. set_max(Set) -> hd(lists:reverse(Set)). +flat_format(F, S) -> + lists:flatten(io_lib:format(F, S)). + %%============================================================================= %% %% Utilities for the binary type @@ -4131,6 +4711,11 @@ handle_base(Unit, Pos) when Pos >= 0 -> 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). + %%============================================================================= %% Consistency-testing function(s) below %%============================================================================= |