diff options
| author | Hans Bolinder <[email protected]> | 2013-03-21 15:49:01 +0100 |
|---|---|---|
| committer | Hans Bolinder <[email protected]> | 2014-01-21 09:28:19 +0100 |
| commit | 7db0bb7ae867ea5de893914a89c51dc0369b5790 (patch) | |
| tree | 842d2c4f9ae3dc008484e8a29c5fa90f0fc03737 | |
| parent | 9b92301dcae72faecdab9f5fe009a53f6d47b8a1 (diff) | |
| download | otp-7db0bb7ae867ea5de893914a89c51dc0369b5790.tar.gz otp-7db0bb7ae867ea5de893914a89c51dc0369b5790.tar.bz2 otp-7db0bb7ae867ea5de893914a89c51dc0369b5790.zip | |
[dialyzer] Re-work the handling of opaque types
It is now OK to inspect and modify the internals of opaque types within
the scope of the module.
The contracts are used for decorating types with opaqueness when it is
harmless to do so. The opaqueness is propagated by the typesig module
and also by the dataflow module.
A lot of details have been fixed or updated. In particular the modules
erl_types and erl_bif_types have been modified extensively.
The version in vsn.mk has been updated to 2.7. The reason is a
modification of #opaque{} in erl_types.
Dialyzer seems to be about five percent slower than it used to be.
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 %%============================================================================= |