diff --git a/bootstrap/lib/compiler/ebin/beam_core_to_ssa.beam b/bootstrap/lib/compiler/ebin/beam_core_to_ssa.beam index 73722b3f8ac5..20ff28e73c82 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_core_to_ssa.beam and b/bootstrap/lib/compiler/ebin/beam_core_to_ssa.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam index 7eabf02fe100..c9669f8140bb 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_disasm.beam and b/bootstrap/lib/compiler/ebin/beam_disasm.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_doc.beam b/bootstrap/lib/compiler/ebin/beam_doc.beam index 0cbcfbdae456..2d2b06bde210 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_doc.beam and b/bootstrap/lib/compiler/ebin/beam_doc.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa.beam b/bootstrap/lib/compiler/ebin/beam_ssa.beam index 89031c6da130..52adcc342932 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa.beam and b/bootstrap/lib/compiler/ebin/beam_ssa.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_alias.beam b/bootstrap/lib/compiler/ebin/beam_ssa_alias.beam index 254ae9d62fe6..b783dd1ced46 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_alias.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_alias.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_bc_size.beam b/bootstrap/lib/compiler/ebin/beam_ssa_bc_size.beam index 472d92d9b57d..fed57ed0fd1a 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_bc_size.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_bc_size.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam index cd27274ace6b..26c2934151eb 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam index a428abf1591e..df7f5a3589e8 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam index a6143229e98a..f1843a7a06b0 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam index f74a9aa743de..46f1e74c67d9 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam differ diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam index 3f174e0503e7..d8226f3fa1e3 100644 Binary files a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam and b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam differ diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 134ea1fda509..ddf47dbb8e25 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2023. All Rights Reserved. +%% Copyright Ericsson AB 1997-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "8.3.2"}, + {vsn, "8.5.2"}, {modules, [ beam_a, beam_asm, @@ -31,6 +31,7 @@ beam_dict, beam_digraph, beam_disasm, + beam_doc, beam_flatten, beam_jump, beam_listing, @@ -43,11 +44,11 @@ beam_ssa_check, beam_ssa_codegen, beam_ssa_dead, + beam_ssa_destructive_update, beam_ssa_lint, beam_ssa_opt, beam_ssa_pp, beam_ssa_pre_codegen, - beam_ssa_private_append, beam_ssa_recv, beam_ssa_share, beam_ssa_ss, @@ -76,6 +77,7 @@ sys_core_fold_lists, sys_core_inline, sys_core_prepare, + sys_coverage, sys_messages, sys_pre_attributes, v3_core @@ -83,5 +85,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-5.0","kernel-8.4","erts-13.0", + {runtime_dependencies, ["stdlib-6.0","kernel-8.4","erts-13.0", "crypto-5.1"]}]}. diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam index 9c6d6888fc30..91484696b2d2 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_core.beam and b/bootstrap/lib/compiler/ebin/v3_core.beam differ diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam index 0e7ba4c53a8e..1639d9a3328a 100644 Binary files a/bootstrap/lib/kernel/ebin/code.beam and b/bootstrap/lib/kernel/ebin/code.beam differ diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam index 3154d8155136..6433f76fda97 100644 Binary files a/bootstrap/lib/kernel/ebin/group.beam and b/bootstrap/lib/kernel/ebin/group.beam differ diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 75824623afec..855d2a8943ba 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2023. All Rights Reserved. +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "9.0.2"}, + {vsn, "10.1.1"}, {modules, [application, application_controller, application_master, @@ -72,6 +72,7 @@ logger_filters, logger_formatter, logger_h_common, + logger_handler, logger_handler_watcher, logger_olp, logger_proxy, @@ -88,6 +89,7 @@ user_drv, user_sup, prim_tty, + prim_tty_sighandler, disk_log, disk_log_1, disk_log_server, @@ -121,6 +123,7 @@ seq_trace, socket, standard_error, + trace, wrap_log_reader]}, {registered, [application_controller, erl_reply, @@ -158,10 +161,11 @@ {net_tickintensity, 4}, {net_ticktime, 60}, {prevent_overlapping_partitions, true}, - {shell_docs_ansi,auto} + {shell_docs_ansi,auto}, + {shell_history_drop,[]} ]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-14.0", "stdlib-5.0", + {runtime_dependencies, ["erts-15.1", "stdlib-6.0", "sasl-3.0", "crypto-5.0"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/prim_tty.beam b/bootstrap/lib/kernel/ebin/prim_tty.beam index be2f0b1a51dd..ac18fc1ef6a7 100644 Binary files a/bootstrap/lib/kernel/ebin/prim_tty.beam and b/bootstrap/lib/kernel/ebin/prim_tty.beam differ diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam index e33e3942a439..5fe6cfccd86a 100644 Binary files a/bootstrap/lib/kernel/ebin/user_drv.beam and b/bootstrap/lib/kernel/ebin/user_drv.beam differ diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam index f0fad6254627..eaab7b5364c8 100644 Binary files a/bootstrap/lib/stdlib/ebin/beam_lib.beam and b/bootstrap/lib/stdlib/ebin/beam_lib.beam differ diff --git a/bootstrap/lib/stdlib/ebin/edlin_context.beam b/bootstrap/lib/stdlib/ebin/edlin_context.beam index 78a6f1e86e29..6d5ac67149a2 100644 Binary files a/bootstrap/lib/stdlib/ebin/edlin_context.beam and b/bootstrap/lib/stdlib/ebin/edlin_context.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam index 1b00f39da62d..af7a96b596a0 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_anno.beam and b/bootstrap/lib/stdlib/ebin/erl_anno.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index 098b353153d9..0dff2813a5df 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index 9d8b98ef58ae..2b168877fd4c 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam index 319761ffdc77..cfde60d1eb2b 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_scan.beam and b/bootstrap/lib/stdlib/ebin/erl_scan.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 5f2820249773..c066d199bc6d 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam index 10820f8969bc..2edc0d0db5c5 100644 Binary files a/bootstrap/lib/stdlib/ebin/rand.beam and b/bootstrap/lib/stdlib/ebin/rand.beam differ diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index c947f9b04782..697f8e82814e 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2023. All Rights Reserved. +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0.2"}, + {vsn, "6.1.2"}, {modules, [argparse, array, base64, @@ -37,6 +37,7 @@ digraph, digraph_utils, edlin, + edlin_key, edlin_context, edlin_expand, edlin_type_suggestion, @@ -77,6 +78,7 @@ io_lib_format, io_lib_fread, io_lib_pretty, + json, lists, log_mf_h, maps, @@ -99,6 +101,7 @@ shell, shell_default, shell_docs, + shell_docs_markdown, slave, sofs, string, @@ -115,6 +118,6 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-9.0","erts-13.1","crypto-4.5", + {runtime_dependencies, ["sasl-3.0","kernel-10.0","erts-15.0","crypto-4.5", "compiler-5.0"]} ]}. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam index c2d15cf98c19..40c1374af0ea 100644 Binary files a/bootstrap/lib/stdlib/ebin/supervisor.beam and b/bootstrap/lib/stdlib/ebin/supervisor.beam differ diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index 4ab1a08175c1..c1755a5ea19a 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -1362,6 +1362,7 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) -> target=KeyOrName}} end. +-dialyzer({no_opaque_union, [handle_msg/2]}). -doc false. handle_msg(sftp_connect, State) -> #state{ssh_ref=SSHRef, target=Target} = State, diff --git a/lib/compiler/src/beam_core_to_ssa.erl b/lib/compiler/src/beam_core_to_ssa.erl index d6beeb7bb440..5b613a3a6cb0 100644 --- a/lib/compiler/src/beam_core_to_ssa.erl +++ b/lib/compiler/src/beam_core_to_ssa.erl @@ -1566,7 +1566,7 @@ partition_intersection([U|_]=Us, [_,_|_]=Cs0, St0) -> case find_key_intersection(Ps) of none -> {Us,Cs0,St0}; - Ks -> + {ok, Ks} -> Cs1 = map(fun(#iclause{pats=[Arg|Args]}=C) -> {Arg1,Arg2} = partition_keys(Arg, Ks), C#iclause{pats=[Arg1,Arg2|Args]} @@ -1601,7 +1601,7 @@ find_key_intersection(Ps) -> %% the keys could only make the code worse. none; false -> - Intersection + {ok, Intersection} end end. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index dd63a7e058f3..7859ffe689ba 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -41,8 +41,8 @@ %%----------------------------------------------------------------------- -type index() :: non_neg_integer(). --type literals() :: 'none' | gb_trees:tree(index(), term()). --type types() :: 'none' | gb_trees:tree(index(), term()). +-type literals() :: gb_trees:tree(index(), term()). +-type types() :: gb_trees:tree(index(), term()). -type symbolic_tag() :: 'a' | 'f' | 'h' | 'i' | 'u' | 'x' | 'y' | 'z'. -type disasm_tag() :: symbolic_tag() | 'fr' | 'atom' | 'float' | 'literal'. -type disasm_term() :: 'nil' | {disasm_tag(), _}. @@ -254,7 +254,7 @@ disasm_lambdas(<<>>, _, _) -> []. -spec beam_disasm_types('none' | binary()) -> types(). beam_disasm_types(none) -> - none; + gb_trees:empty(); beam_disasm_types(<>) -> case beam_types:convert_ext(Version, Table0) of none -> @@ -265,7 +265,7 @@ beam_disasm_types(<>) -> Res end; beam_disasm_types(<<_/binary>>) -> - none. + gb_trees:empty(). disasm_types(Types0, Index) -> case beam_types:decode_ext(Types0) of diff --git a/lib/compiler/src/beam_doc.erl b/lib/compiler/src/beam_doc.erl index 4f2aecf7753e..dea1250ddf8f 100644 --- a/lib/compiler/src/beam_doc.erl +++ b/lib/compiler/src/beam_doc.erl @@ -61,7 +61,7 @@ deprecated = #{} :: map(), docformat = ?DEFAULT_FORMAT :: binary(), - moduledoc = {?DEFAULT_MODULE_DOC_LOC, none} :: {integer() | erl_anno:anno(), none | map() | hidden}, + moduledoc = {erl_anno:new(?DEFAULT_MODULE_DOC_LOC), none} :: {erl_anno:anno(), none | map() | hidden}, moduledoc_meta = none :: none | #{ _ := _ }, behaviours = [] :: list(module()), @@ -110,7 +110,7 @@ %% populates all function / types, callbacks. it is updated on an ongoing basis %% since a doc attribute `doc ...` is not known in a first pass to be attached %% to a function / type / callback. - docs = #{} :: #{{Attribute :: function | type | opaque | callback, + docs = #{} :: #{{Attribute :: function | type | opaque | nominal | callback, FunName :: atom(), Arity :: non_neg_integer()} => @@ -145,7 +145,7 @@ %% -doc #{author => "X"}. %% -doc foo() -> ok. %% - %% thus, after reading a terminal AST node (spec, type, fun declaration, opaque, callback), + %% thus, after reading a terminal AST node (spec, type, fun declaration, opaque, nominal, callback), %% the intermediate state saved in the fields below needs to be %% saved in the `docs` field. @@ -459,7 +459,7 @@ track_documentation(_, State) -> upsert_documentation_from_terminal_item({function, Anno, F, Arity, _}, State) -> upsert_documentation(function, F, Arity, Anno, State); upsert_documentation_from_terminal_item({attribute, Anno, TypeOrOpaque, {TypeName, _TypeDef, TypeArgs}},State) - when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque -> + when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque; TypeOrOpaque =:= nominal -> Arity = length(fun_to_varargs(TypeArgs)), upsert_documentation(type, TypeName, Arity, Anno, State); upsert_documentation_from_terminal_item({attribute, Anno, callback, {{CB, Arity}, _Form}}, State) -> @@ -470,6 +470,7 @@ upsert_documentation_from_terminal_item(_, State) -> upsert_documentation(Tag, Name, Arity, Anno, State) when Tag =:= function; Tag =:= type; Tag =:= opaque; + Tag =:= nominal; Tag =:= callback -> Docs = State#docs.docs, State1 = case maps:get({Tag, Name, Arity}, Docs, none) of @@ -579,7 +580,7 @@ extract_hidden_types0({attribute, _Anno, doc, _}, State) -> extract_hidden_types0({attribute, _Anno, TypeOrOpaque, {Name, _Type, Args}}, #docs{hidden_status = hidden, hidden_types = HiddenTypes}=State) - when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque -> + when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque; TypeOrOpaque =:= nominal -> State#docs{hidden_status = none, hidden_types = sets:add_element({Name, length(Args)}, HiddenTypes)}; extract_hidden_types0(_, State) -> @@ -593,7 +594,7 @@ extract_hidden_types0(_, State) -> %% #{{TypeName, length(Args)} => Anno}. %% extract_type_defs0({attribute, Anno, TypeOrOpaque, {TypeName, _TypeDef, TypeArgs}}, #docs{type_defs = TypeDefs}=State) - when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque -> + when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque; TypeOrOpaque =:= nominal -> Args = fun_to_varargs(TypeArgs), Type = {TypeName, length(Args)}, State#docs{type_defs = TypeDefs#{Type => Anno}}; @@ -660,7 +661,7 @@ update_docstatus(State, V) -> update_ast(function, #docs{ast_fns=AST}=State, Fn) -> State#docs{ast_fns = [Fn | AST]}; -update_ast(Type,#docs{ast_types=AST}=State, Fn) when Type =:= type; Type =:= opaque-> +update_ast(Type,#docs{ast_types=AST}=State, Fn) when Type =:= type; Type =:= opaque; Type =:= nominal-> State#docs{ast_types = [Fn | AST]}; update_ast(callback, #docs{ast_callbacks = AST}=State, Fn) -> State#docs{ast_callbacks = [Fn | AST]}. @@ -873,7 +874,7 @@ extract_documentation0({function, _Anno, F, A, _Body}=AST, State) -> State1 = remove_exported_type_info({function, F, A}, State), extract_documentation_from_funs(AST, State1); extract_documentation0({attribute, _Anno, TypeOrOpaque, _}=AST,State) - when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque -> + when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque; TypeOrOpaque =:= nominal -> extract_documentation_from_type(AST, State); extract_documentation0({attribute, _Anno, callback, {{CB, A}, _Form}}=AST, State) -> State1 = remove_exported_type_info({callback, CB, A}, State), @@ -956,7 +957,7 @@ extract_user_types(_Else, Acc) -> extract_documentation_from_type({attribute, Anno, TypeOrOpaque, {TypeName, _TypeDef, TypeArgs}=Types}, #docs{docs = Docs, exported_types=ExpTypes}=State) - when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque -> + when TypeOrOpaque =:= type; TypeOrOpaque =:= opaque; TypeOrOpaque =:= nominal -> Args = fun_to_varargs(TypeArgs), Key = {type, TypeName, length(TypeArgs)}, @@ -979,9 +980,9 @@ add_last_read_user_type(_Anno, {_TypeName, TypeDef, TypeArgs}, State) -> Types = extract_user_types([TypeArgs, TypeDef], State), set_last_read_user_types(State, Types). -%% NOTE: Terminal elements for the documentation, such as `-type`, `-opaque`, `-callback`, -%% and functions always need to reset the state when they finish, so that new -%% new AST items start with a clean slate. +%% NOTE: Terminal elements for the documentation, such as `-type`, `-opaque`, +%% `-nominal`, `-callback`, and functions always need to reset the state when +%% they finish, so that new AST items start with a clean slate. extract_documentation_from_funs({function, Anno, F, A, [{clause, _, ClauseArgs, _, _}]}, #docs{exported_functions = ExpFuns}=State) -> case (sets:is_element({F, A}, ExpFuns) orelse State#docs.export_all) of diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index 0dd0a9f37d5c..4720b8b6938c 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -240,7 +240,7 @@ shortcut_3(L, From, Bs0, UnsetVars0, St) -> %% because it refers to a variable defined %% in this block. shortcut_unsafe_br(Br, L, Bs, UnsetVars0, St); - UnsetVars -> + {safe, UnsetVars} -> %% Continue checking whether this br is %% suitable. shortcut_test_br(Br, L, Bs, UnsetVars, St) @@ -381,16 +381,16 @@ update_unset_vars(L, Is, Br, UnsetVars, #st{skippable=Skippable}) -> %% to the UnsetVars set would not change %% the outcome of the tests in %% is_br_safe/2. - UnsetVars + {safe, UnsetVars} end; #b_br{} -> - UnsetVars + {safe, UnsetVars} end; false -> %% Some variables defined in this block are used by %% successors. We must update the set of unset variables. SetInThisBlock = [V || #b_set{dst=V} <:- Is], - list_set_union(SetInThisBlock, UnsetVars) + {safe, list_set_union(SetInThisBlock, UnsetVars)} end. shortcut_two_way(#b_br{succ=Succ,fail=Fail}, From, Bs0, UnsetVars0, St0) -> diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index f27d7796e4a0..54bfd786c416 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -787,9 +787,10 @@ message_to_string({call, [M, F, Args, ArgNs, FailReason, message_to_string({call_to_missing, [M, F, A]}, _I, _E) -> io_lib:format("Call to missing or unexported function ~w:~tw/~w\n", [M, F, A]); -message_to_string({exact_eq, [Type1, Op, Type2]}, I, _E) -> - io_lib:format("The test ~ts ~s ~ts can never evaluate to 'true'\n", - [t(Type1, I), Op, t(Type2, I)]); +message_to_string({exact_compare, [Type1, Op, Type2]}, I, _E) -> + io_lib:format("The test ~ts ~s ~ts can never evaluate to '~w'\n", + [t(Type1, I), Op, t(Type2, I), + (Op =:= '=:=' orelse Op =:= '==')]); message_to_string({fun_app_args, [ArgNs, Args, Type]}, I, _E) -> PositionString = form_position_string(ArgNs), io_lib:format("Fun application with arguments ~ts will fail" @@ -887,7 +888,8 @@ message_to_string({invalid_contract, [M, F, A, InvalidContractDetails, Contract, " The success typing is ~ts\n" " But the spec is ~ts\n" "~ts", - [M, F, A, con(M, F, Sig, I), con(M, F, Contract, I), format_invalid_contract_details(InvalidContractDetails)]); + [M, F, A, con(M, F, Sig, I), con(M, F, Contract, I), + format_invalid_contract_details(InvalidContractDetails)]); message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]}, I, _E) -> io_lib:format("The specification for ~w:~tw/~w" @@ -910,18 +912,25 @@ message_to_string({spec_missing_fun, [M, F, A]}, _I, _E) -> io_lib:format("Contract for function that does not exist: ~w:~tw/~w\n", [M, F, A]); %%----- Warnings for opaque type violations ------------------- -message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}, I, _E) -> +message_to_string({call_with_opaque, + [M, F, Args, Conflicts, ExpectedTypes]}, I, _E) -> + Positions = [N || {N, _T, _TStr} <- Conflicts], io_lib:format("The call ~w:~tw~ts contains ~ts when ~ts\n", - [M, F, a(Args, I), form_positions(ArgNs), - form_expected(ExpArgs, I)]); -message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}, I, _E) -> + [M, F, a(Args, I), form_positions(Positions), + form_expected(ExpectedTypes, I)]); +message_to_string({call_without_opaque, + [M, F, Args, Conflicts, _ExpectedTypes]}, I, _E) -> io_lib:format("The call ~w:~tw~ts does not have ~ts\n", - [M, F, a(Args, I), - form_expected_without_opaque(ExpectedTriples, I)]); -message_to_string({opaque_eq, [Type, _Op, OpaqueType]}, I, _E) -> - io_lib:format("Attempt to test for equality between a term of type ~ts" - " and a term of opaque type ~ts\n", - [t(Type, I), t(OpaqueType, I)]); + [M, F, a(Args, I), + form_expected_without_opaque(Conflicts, I)]); +message_to_string({opaque_compare, [Type, Op, OpaqueType]}, I, _E) -> + Kind = if + Op =:= '=:='; Op =:= '==' -> "equality"; + Op =:= '=/='; Op =:= '/=' -> "inequality" + end, + io_lib:format("Attempt to test for ~ts between a term of type ~ts" + " and a term of opaque type ~ts\n", + [Kind, t(Type, I), t(OpaqueType, I)]); message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}, I, _E) -> io_lib:format("Guard test ~ts ~s ~ts contains ~s\n", [a(Arg1, I), Infix, a(Arg2, I), form_positions(ArgNs)]); @@ -930,15 +939,21 @@ message_to_string({opaque_guard, [Guard, Args]}, I, _E) -> [Guard, a(Args, I)]); message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}, I, _E) -> Term = if OpaqueType =:= OpaqueTerm -> "the term"; - true -> t(OpaqueTerm, I) - end, - io_lib:format("The attempt to match a term of type ~ts against the ~ts" - " breaks the opacity of ~ts\n", - [t(OpaqueType, I), ps(Pat, I), Term]); -message_to_string({opaque_neq, [Type, _Op, OpaqueType]}, I, _E) -> - io_lib:format("Attempt to test for inequality between a term of type ~ts" - " and a term of opaque type ~ts\n", - [t(Type, I), t(OpaqueType, I)]); + true -> "a term of type " ++ t(OpaqueTerm, I) + end, + io_lib:format("The attempt to match ~ts against the " + "~ts breaks the opacity of the term\n", + [Term, ps(Pat, I)]); +message_to_string({opaque_union, [IsOpaque, Type]}, I, _E) -> + TypeString = t(Type, I), + case IsOpaque of + true -> + io_lib:format("Body yields the opaque type ~ts whose opacity is " + "broken by the other clauses.\n", [TypeString]); + false -> + io_lib:format("Body yields the type ~ts which violates the " + "opacity of the other clauses.\n", [TypeString]) + end; message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}, I, _E) -> io_lib:format("The type test ~ts~ts breaks the opacity of the term ~ts~ts\n", [Fun, a(Args, I), Arg, t(ArgType, I)]); @@ -1004,7 +1019,6 @@ format_invalid_contract_details({InvalidArgIdxs, IsRangeInvalid}) -> false -> "" end, case {ArgDesc, RangeDesc} of - {"", ""} -> ""; {"", [_|_]} -> io_lib:format(" The ~ts\n", [RangeDesc]); {[_|_], ""} -> io_lib:format(" ~ts\n", [ArgDesc]); {[_|_], [_|_]} -> io_lib:format(" ~ts, and the ~ts\n", [ArgDesc, RangeDesc]) @@ -1045,24 +1059,25 @@ form_positions(ArgNs) -> case ArgNs of [_] -> "an opaque term as "; [_,_|_] -> "opaque terms as " - end ++ form_position_string(ArgNs) ++ - case ArgNs of - [_] -> " argument"; - [_,_|_] -> " arguments" - end. + end + ++ form_position_string(ArgNs) + ++ case ArgNs of + [_] -> " argument"; + [_,_|_] -> " arguments" + end. %% We know which positions N are to blame; %% the list of triples will never be empty. form_expected_without_opaque([{N, T, TStr}], I) -> case erl_types:t_is_opaque(T) of - true -> + true -> io_lib:format("an opaque term of type ~ts as ", [t(TStr, I)]); false -> io_lib:format("a term of type ~ts (with opaque subterms) as ", [t(TStr, I)]) end ++ form_position_string([N]) ++ " argument"; -form_expected_without_opaque(ExpectedTriples, _I) -> %% TODO: can do much better here - {ArgNs, _Ts, _TStrs} = lists:unzip3(ExpectedTriples), +form_expected_without_opaque(Conflicts, _I) -> %% TODO: can do much better here + ArgNs = [N || {N, _T, _TStr} <- Conflicts], "opaque terms as " ++ form_position_string(ArgNs) ++ " arguments". form_expected(ExpectedArgs, I) -> diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index f59d66a73079..2a9eea0fd63d 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -51,6 +51,7 @@ -define(WARN_NON_PROPER_LIST, warn_non_proper_list). -define(WARN_NOT_CALLED, warn_not_called). -define(WARN_OPAQUE, warn_opaque). +-define(WARN_OPAQUE_UNION, warn_opaque_union). -define(WARN_OVERLAPPING_CONTRACT, warn_overlapping_contract). -define(WARN_RETURN_NO_RETURN, warn_return_no_exit). -define(WARN_RETURN_ONLY_EXIT, warn_return_only_exit). diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 2ae277fec32b..74b7d5876768 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -15,8 +15,8 @@ -module(dialyzer_contracts). -moduledoc false. --export([check_contract/2, - check_contracts/4, +-export([check_contract/3, + check_contracts/3, contracts_without_fun/3, contract_to_string/1, get_invalid_contract_warnings/3, @@ -230,18 +230,17 @@ rcv_ext_types(Self, ExtTypes) -> -type fun_types() :: orddict:orddict(label(), erl_types:erl_type()). -spec check_contracts(orddict:orddict(mfa(), #contract{}), - dialyzer_callgraph:callgraph(), fun_types(), - erl_types:opaques()) -> plt_contracts(). + dialyzer_callgraph:callgraph(), fun_types()) -> + plt_contracts(). -check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) -> +check_contracts(Contracts, Callgraph, FunTypes) -> 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, Contract} -> - {M, Opaques} = lists:keyfind(M, 1, ModOpaques), - case check_contract(Contract, Type, Opaques) of + case check_contract(Contract, Type, M) of ok -> case erl_bif_types:is_known(M, F, A) of true -> @@ -271,7 +270,7 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) -> | {'error', 'invalid_contract' | {'invalid_contract', {InvalidArgIdxs :: [pos_integer()], IsReturnTypeInvalid :: boolean()}} - | {'opaque_mismatch', erl_types:erl_type()} + | {opaque_mismatch, erl_types:erl_type()} | {'overlapping_contract', [module() | atom() | byte()]} | string()} | {'range_warnings', @@ -280,37 +279,30 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) -> erl_types:erl_type()}}]}. %% Checks all components of a contract --spec check_contract(#contract{}, erl_types:erl_type()) -> check_contract_return(). +-spec check_contract(#contract{}, erl_types:erl_type(), module()) -> check_contract_return(). -check_contract(Contract, SuccType) -> - check_contract(Contract, SuccType, 'universe'). - --spec check_contract(#contract{}, erl_types:erl_type(), erl_types:opaques()) -> - check_contract_return(). - -check_contract(#contract{contracts = Contracts}, SuccType, Opaques) -> +check_contract(#contract{contracts = Contracts}, SuccType, Module) -> try Contracts1 = [{Contract, insert_constraints(Constraints)} - || {Contract, Constraints} <- Contracts], + || {Contract, Constraints} <- Contracts], Contracts2 = [erl_types:t_subst(Contract, Map) - || {Contract, Map} <- Contracts1], + || {Contract, Map} <- Contracts1], GenDomains = [erl_types:t_fun_args(C) || C <- Contracts2], case check_domains(GenDomains) of error -> - {error, {overlapping_contract, []}}; + {error, {overlapping_contract, []}}; ok -> - InfList = [{Contract, erl_types:t_inf(Contract, SuccType, Opaques)} - || Contract <- Contracts2], - case check_contract_inf_list(InfList, SuccType, Opaques) of - {error, _} = Invalid -> Invalid; + case check_contract_list(Contracts2, SuccType, Module) of + {error, _}=Res -> + Res; ok -> - case check_extraneous(Contracts2, SuccType, Opaques) of + case check_extraneous(Contracts2, SuccType) of {error, {invalid_contract, _}} = Err -> Err; {error, {extra_range, _, _}} = Err -> - MissingError = check_missing(Contracts2, SuccType, Opaques), + MissingError = check_missing(Contracts2, SuccType), {range_warnings, [Err | MissingError]}; ok -> - case check_missing(Contracts2, SuccType, Opaques) of + case check_missing(Contracts2, SuccType) of [] -> ok; ErrorL -> {range_warnings, ErrorL} end @@ -321,24 +313,28 @@ check_contract(#contract{contracts = Contracts}, SuccType, Opaques) -> throw:{error, _} = Error -> Error end. -locate_invalid_elems(InfList) -> - case InfList of - [{Contract, Inf}] -> - ArgComparisons = lists:zip(erl_types:t_fun_args(Contract), - erl_types:t_fun_args(Inf)), - ProblematicArgs = - [erl_types:t_is_none(Succ) andalso (not erl_types:t_is_none(Cont)) - || {Cont,Succ} <- ArgComparisons], - ProblematicRange = - erl_types:t_is_none(erl_types:t_fun_range(Inf)) - andalso (not erl_types:t_is_none(erl_types:t_fun_range(Contract))), - ProblematicArgIdxs = [Idx || - {Idx, IsProblematic} <- - lists:enumerate(ProblematicArgs), IsProblematic], - {error, {invalid_contract, {ProblematicArgIdxs, ProblematicRange}}}; - _ -> - {error, invalid_contract} - end. +locate_invalid_elems([Contract], SuccType) -> + CArgs = erl_types:t_fun_args(Contract), + SArgs = erl_types:t_fun_args(SuccType), + CRange = erl_types:t_fun_range(Contract), + SRange = erl_types:t_fun_range(SuccType), + + ProblematicArgs = + [erl_types:t_is_none(erl_types:t_inf(Cont, Succ)) andalso + (not erl_types:t_is_none(Cont)) + || {Cont, Succ} <- lists:zip(CArgs, SArgs)], + + ProblematicRange = + erl_types:t_is_impossible(erl_types:t_inf(CRange, SRange)) + =/= erl_types:t_is_impossible(CRange), + + ProblematicArgIdxs = [Idx || {Idx, IsProblematic} <- + lists:enumerate(ProblematicArgs), + IsProblematic], + + {invalid_contract, {ProblematicArgIdxs, ProblematicRange}}; +locate_invalid_elems(_Contracts, _SuccType) -> + invalid_contract. check_domains([_]) -> ok; check_domains([Dom|Doms]) -> @@ -350,61 +346,56 @@ check_domains([Dom|Doms]) -> false -> error end. - %% 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(List, SuccType, Opaques) -> - case check_contract_inf_list(List, SuccType, Opaques, []) of - ok -> ok; - {error, []} -> - locate_invalid_elems(List); - {error, [{SigRange, ContrRange}|_]} -> - case erl_types:t_find_opaque_mismatch(SigRange, ContrRange, Opaques) of - error -> - locate_invalid_elems(List); - {ok, _T1, T2} -> {error, {opaque_mismatch, T2}} - end +check_contract_list(List, SuccType, Module) -> + case check_contract_list_1(List, SuccType, Module, false) of + invalid_contract -> {error, locate_invalid_elems(List, SuccType)}; + {opaque_mismatch, _}=Details -> {error, Details}; + ok -> ok end. -check_contract_inf_list([{Contract, FunType}|Left], SuccType, Opaques, OM) -> - FunArgs = erl_types:t_fun_args(FunType), - case lists:any(fun erl_types:t_is_impossible/1, FunArgs) of - true -> check_contract_inf_list(Left, SuccType, Opaques, OM); - false -> - STRange = erl_types:t_fun_range(SuccType), - case erl_types:t_is_impossible(STRange) of - true -> ok; - false -> - Range = erl_types:t_fun_range(FunType), - case erl_types:t_is_none(erl_types:t_inf(STRange, Range)) of - true -> - CR = erl_types:t_fun_range(Contract), - NewOM = [{STRange, CR}|OM], - check_contract_inf_list(Left, SuccType, Opaques, NewOM); - false -> ok - end - end +check_contract_list_1([Contract | Left], SuccType, Module, Valid0) -> + CRange = erl_types:t_fun_range(Contract), + SRange = erl_types:t_fun_range(SuccType), + case erl_types:t_opacity_conflict(SRange, CRange, Module) of + none -> + Valid = case Valid0 of + false -> + Inf = erl_types:t_inf(Contract, SuccType), + (not erl_types:t_is_impossible(Inf)) andalso + (not erl_types:any_none(erl_types:t_fun_args(Inf))) andalso + (erl_types:t_is_impossible(CRange) =:= + erl_types:t_is_impossible(erl_types:t_fun_range(Inf))); + true -> + true + end, + check_contract_list_1(Left, SuccType, Module, Valid); + _ -> + {opaque_mismatch, CRange} end; -check_contract_inf_list([], _SuccType, _Opaques, OM) -> - {error, OM}. +check_contract_list_1([], _SuccType, _Module, false) -> + invalid_contract; +check_contract_list_1([], _SuccType, _Module, true) -> + ok. -check_extraneous([], _SuccType, _Opaques) -> +check_extraneous([], _SuccType) -> ok; -check_extraneous([C|Cs], SuccType, Opaques) -> - case check_extraneous_1(C, SuccType, Opaques) of +check_extraneous([C|Cs], SuccType) -> + case check_extraneous_1(C, SuccType) of {error, _} = Error -> Error; - ok -> check_extraneous(Cs, SuccType, Opaques) + ok -> check_extraneous(Cs, SuccType) end. -check_extraneous_1(Contract, SuccType, Opaques) -> +check_extraneous_1(Contract, SuccType) -> CRng = erl_types:t_fun_range(Contract), - CRngs = erl_types:t_elements(CRng, Opaques), + CRngs = erl_types:t_elements(CRng), STRng = erl_types:t_fun_range(SuccType), ?debug("\nCR = ~ts\nSR = ~ts\n", [erl_types:t_to_string(CRng), erl_types:t_to_string(STRng)]), case [CR || CR <- CRngs, - erl_types:t_is_none(erl_types:t_inf(CR, STRng, Opaques))] of + erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of [] -> case bad_extraneous_list(CRng, STRng) orelse bad_extraneous_map(CRng, STRng) of true -> {error, {invalid_contract, {[],true}}}; @@ -444,13 +435,13 @@ map_part(Type) -> is_empty_map(Type) -> erl_types:t_is_equal(Type, erl_types:t_from_term(#{})). -check_missing(Contracts, SuccType, Opaques) -> +check_missing(Contracts, SuccType) -> CRanges = [erl_types:t_fun_range(C) || C <- Contracts], AllCRange = erl_types:t_sup(CRanges), STRng = erl_types:t_fun_range(SuccType), - STRngs = erl_types:t_elements(STRng, Opaques), + STRngs = erl_types:t_elements(STRng), case [STR || STR <- STRngs, - erl_types:t_is_none(erl_types:t_inf(STR, AllCRange, Opaques))] of + erl_types:t_is_none(erl_types:t_inf(STR, AllCRange))] of [] -> []; STRs -> [{error, {missing_range, erl_types:t_sup(STRs), AllCRange}}] end. @@ -559,9 +550,7 @@ insert_constraints([], Map) -> Map. store_tmp_contract(Module, MFA, FileLocation, {TypeSpec, Xtra}, SpecMap, RecordsDict) -> - %% io:format("contract from form: ~tp\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, Module, MFA, RecordsDict, FileLocation), - %% io:format("contract: ~tp\n", [TmpContract]), maps:put(MFA, {FileLocation, TmpContract, Xtra}, SpecMap). contract_from_form(Forms, Module, MFA, RecDict, FileLocation) -> @@ -585,7 +574,7 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, MFA, throw({error, NewMsg}) end, NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), - {{NewTypeNoVars, []}, NewCache} + {{NewTypeNoVars, []}, NewCache} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, []} | FormAcc], @@ -818,38 +807,34 @@ get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, Acc) -> false -> Contracts2 = maps:to_list(Contracts1), Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), - Opaques = erl_types:t_opaque_from_records(Records), - get_invalid_contract_warnings_funs(Contracts2, Plt, Records, - Opaques, Acc) + get_invalid_contract_warnings_funs(Contracts2, Plt, Records, Acc) end, get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, NewAcc); get_invalid_contract_warnings_modules([], _CodeServer, _Plt, Acc) -> Acc. get_invalid_contract_warnings_funs([{MFA, {FileLocation, Contract, _Xtra}}|Left], - Plt, RecDict, Opaques, Acc) -> + Plt, RecDict, 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, Opaques, Acc); + get_invalid_contract_warnings_funs(Left, Plt, RecDict, Acc); {value, {Ret, Args}} -> Sig = erl_types:t_fun(Args, Ret), {M, _F, _A} = MFA, - %% io:format("MFA ~tp~n", [MFA]), {File, Location} = FileLocation, WarningInfo = {File, Location, MFA}, NewAcc = - case check_contract(Contract, Sig, Opaques) of - {error, invalid_contract} -> - [invalid_contract_warning(MFA, WarningInfo, none, Contract, Sig, RecDict)|Acc]; - {error, {invalid_contract, {_ProblematicArgIdxs, _IsRangeProblematic} = ProblemDetails}} -> - [invalid_contract_warning(MFA, WarningInfo, ProblemDetails, Contract, Sig, RecDict)|Acc]; - {error, {opaque_mismatch, T2}} -> - W = contract_opaque_warning(MFA, WarningInfo, T2, Sig, RecDict), - [W|Acc]; - {error, {overlapping_contract, []}} -> - [overlapping_contract_warning(MFA, WarningInfo)|Acc]; - {range_warnings, Errors} -> + case check_contract(Contract, Sig, M) of + {error, invalid_contract} -> + [invalid_contract_warning(MFA, WarningInfo, none, Contract, Sig, RecDict)|Acc]; + {error, {invalid_contract, {_ProblematicArgIdxs, _IsRangeProblematic} = ProblemDetails}} -> + [invalid_contract_warning(MFA, WarningInfo, ProblemDetails, Contract, Sig, RecDict)|Acc]; + {error, {overlapping_contract, []}} -> + [overlapping_contract_warning(MFA, WarningInfo)|Acc]; + {error, {opaque_mismatch, Offender}} -> + [contract_opaque_warning(MFA, WarningInfo, Offender, Sig, RecDict)|Acc]; + {range_warnings, Errors} -> Fun = fun({error, {extra_range, ExtraRanges, STRange}}, Acc0) -> Warn = @@ -857,7 +842,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLocation, Contract, _Xtra}}|Left] MFA, File, RecDict) of {ok, NoRemoteType} -> CRet = erl_types:t_fun_range(NoRemoteType), - is_subtype(ExtraRanges, CRet, Opaques); + is_subtype(ExtraRanges, CRet); unsupported -> true end, @@ -879,32 +864,37 @@ get_invalid_contract_warnings_funs([{MFA, {FileLocation, Contract, _Xtra}}|Left] {M, F, A} = MFA, CSig0 = get_contract_signature(Contract), CSig = erl_types:subst_all_vars_to_any(CSig0), - case erl_bif_types:is_known(M, F, A) of + + %% erlang:raise/3 has an inconsistent contract by design, which + %% becomes invalid when testing its defined contract against the + %% one in erl_bif_types. Hence, we explicitly ignore it. + case (MFA =/= {erlang, raise, 3} andalso + erl_bif_types:is_known(M, F, A)) of true -> %% This is strictly for contracts of functions also in %% erl_bif_types 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, Opaques) of + case check_contract(Contract, BifSig, M) of {error, _} -> [invalid_contract_warning(MFA, WarningInfo, none, Contract, BifSig, RecDict) |Acc]; {range_warnings, _} -> picky_contract_check(CSig, BifSig, MFA, WarningInfo, - Contract, RecDict, Opaques, Acc); + Contract, RecDict, Acc); ok -> picky_contract_check(CSig, BifSig, MFA, WarningInfo, - Contract, RecDict, Opaques, Acc) + Contract, RecDict, Acc) end; false -> picky_contract_check(CSig, Sig, MFA, WarningInfo, Contract, - RecDict, Opaques, Acc) + RecDict, Acc) end end, - get_invalid_contract_warnings_funs(Left, Plt, RecDict, Opaques, NewAcc) + get_invalid_contract_warnings_funs(Left, Plt, RecDict, NewAcc) end; -get_invalid_contract_warnings_funs([], _Plt, _RecDict, _Opaques, Acc) -> +get_invalid_contract_warnings_funs([], _Plt, _RecDict, Acc) -> Acc. invalid_contract_warning({M, F, A}, WarningInfo, ProblemDetails, Contract, SuccType, RecDict) -> @@ -934,7 +924,7 @@ missing_range_warning({M, F, A}, WarningInfo, ExtraRanges, CRange) -> {missing_range, [M, F, A, ERangesStr, CRangeStr]}}. picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, - Opaques, Acc) -> + Acc) -> CSig = erl_types:t_abstract_records(CSig0, RecDict), Sig = erl_types:t_abstract_records(Sig0, RecDict), case erl_types:t_is_equal(CSig, Sig) of @@ -945,7 +935,7 @@ picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, true -> Acc; false -> case extra_contract_warning(MFA, WarningInfo, Contract, - CSig0, Sig0, RecDict, Opaques) of + CSig0, Sig0, RecDict) of no_warning -> Acc; {warning, Warning} -> [Warning|Acc] end @@ -953,10 +943,10 @@ picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, end. extra_contract_warning(MFA, WarningInfo, Contract, CSig, Sig, - RecDict, Opaques) -> + RecDict) -> {File, _, _} = WarningInfo, {IsRemoteTypesRelated, SubtypeRelation} = - is_remote_types_related(Contract, CSig, Sig, MFA, File, RecDict, Opaques), + is_remote_types_related(Contract, CSig, Sig, MFA, File, RecDict), case IsRemoteTypesRelated of true -> no_warning; @@ -979,17 +969,17 @@ extra_contract_warning(MFA, WarningInfo, Contract, CSig, Sig, {warning, {Tag, WarningInfo, Msg}} end. -is_remote_types_related(Contract, CSig, Sig, MFA, File, RecDict, Opaques) -> - case is_subtype(CSig, Sig, Opaques) of +is_remote_types_related(Contract, CSig, Sig, MFA, File, RecDict) -> + case is_subtype(CSig, Sig) of true -> {false, contract_is_subtype}; false -> - case is_subtype(Sig, CSig, Opaques) of + case is_subtype(Sig, CSig) of true -> case t_from_forms_without_remote(Contract#contract.forms, MFA, File, RecDict) of {ok, NoRemoteTypeSig} -> - case blame_remote(CSig, NoRemoteTypeSig, Sig, Opaques) of + case blame_remote(CSig, NoRemoteTypeSig, Sig) of true -> {true, neither}; false -> @@ -1014,36 +1004,36 @@ t_from_forms_without_remote(_Forms, _MFA, _File, _RecDict) -> %% Lots of forms unsupported. -blame_remote(ContractSig, NoRemoteContractSig, Sig, Opaques) -> +blame_remote(ContractSig, NoRemoteContractSig, Sig) -> CArgs = erl_types:t_fun_args(ContractSig), CRange = erl_types:t_fun_range(ContractSig), NRArgs = erl_types:t_fun_args(NoRemoteContractSig), NRRange = erl_types:t_fun_range(NoRemoteContractSig), SArgs = erl_types:t_fun_args(Sig), SRange = erl_types:t_fun_range(Sig), - blame_remote_list([CRange|CArgs], [NRRange|NRArgs], [SRange|SArgs], Opaques). + blame_remote_list([CRange|CArgs], [NRRange|NRArgs], [SRange|SArgs]). -blame_remote_list([], [], [], _Opaques) -> +blame_remote_list([], [], []) -> true; -blame_remote_list([CArg|CArgs], [NRArg|NRArgs], [SArg|SArgs], Opaques) -> +blame_remote_list([CArg|CArgs], [NRArg|NRArgs], [SArg|SArgs]) -> case erl_types:t_is_equal(CArg, NRArg) of true -> case not erl_types:t_is_equal(CArg, SArg) of true -> false; - false -> blame_remote_list(CArgs, NRArgs, SArgs, Opaques) + false -> blame_remote_list(CArgs, NRArgs, SArgs) end; false -> - case is_subtype(SArg, NRArg, Opaques) - andalso not is_subtype(NRArg, SArg, Opaques) of + case is_subtype(SArg, NRArg) + andalso not is_subtype(NRArg, SArg) of true -> false; - false -> blame_remote_list(CArgs, NRArgs, SArgs, Opaques) + false -> blame_remote_list(CArgs, NRArgs, SArgs) end end. %% As erl_types:t_is_subtype/2 but without looking into opaque types that %% aren't known to us. -is_subtype(T1, T2, Opaques) -> - Inf = erl_types:t_inf(T1, T2, Opaques), +is_subtype(T1, T2) -> + Inf = erl_types:t_inf(T1, T2), erl_types:t_is_equal(T1, Inf). -spec constraint_form_to_remote_modules(Constraint :: term()) -> [module()]. diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 37a049566ff5..b95751e3450c 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -157,6 +157,7 @@ wait_for_success_typings(Labels, {_Collector, _Regulator, JobLabelsToPid}) -> %%-------------------------------------------------------------------- %% Local functions. +-dialyzer({no_opaque_union, [spawn_jobs/4]}). spawn_jobs(Mode, Jobs, InitData, Timing) -> Collector = self(), Regulator = spawn_regulator(), @@ -215,6 +216,7 @@ job_fun(JobLabelsToPid, Mode, InitData, Coordinator) -> ok end. +-dialyzer({no_opaque_union, [collect_result/1]}). collect_result(#state{mode = Mode, active = Active, result = Result, next_label = NextLabel, init_data = InitData, jobs = JobsLeft, job_fun = JobFun, @@ -258,6 +260,7 @@ collect_result(#state{mode = Mode, active = Active, result = Result, end end. +-dialyzer({no_opaque_union, [update_result/5]}). update_result(Mode, InitData, Job, Data, Result) -> if Mode =:= 'compile' -> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 91879198b1c8..aaeaf05a0f1f 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -28,34 +28,33 @@ -include("dialyzer.hrl"). -import(erl_types, - [t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, - t_is_equal/2, t_is_subtype/2, t_subtract/2, + [t_inf/2, t_inf_lists/2, + t_is_equal/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, + [any_none/1, t_any/0, t_atom/0, t_atom/1, t_atom_vals/1, 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/2, t_cons_tl/2, - t_contains_opaque/2, - t_find_opaque_mismatch/3, t_float/0, t_from_range/2, t_from_term/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_list/1, - t_is_nil/2, t_is_none/1, t_is_impossible/1, - t_is_number/2, t_is_reference/2, t_is_pid/2, t_is_port/2, + t_cons/0, 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_integer/0, t_integers/1, + t_is_any/1, t_is_atom/1, t_is_any_atom/2, + t_is_boolean/1, + t_is_integer/1, t_is_list/1, + t_is_nil/1, t_is_none/1, t_is_impossible/1, + t_is_number/1, t_is_reference/1, t_is_pid/1, t_is_port/1, t_is_unit/1, - t_limit/2, t_list/0, t_list_elements/2, + t_limit/2, t_list/0, t_list_elements/1, t_maybe_improper_list/0, t_module/0, - t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/2, + t_none/0, t_non_neg_integer/0, t_number/0, t_number_vals/1, t_pid/0, t_port/0, t_product/1, t_reference/0, 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, - t_map/0, t_map/1, t_is_singleton/2 + t_tuple/0, t_tuple/1, t_tuple_args/1, + t_tuple_subtypes/1, + t_unit/0, + t_map/0, t_map/1, t_is_singleton/1 ]). %%-define(DEBUG, true). @@ -87,7 +86,6 @@ fun_homes :: dict:dict(label(), mfa()), reachable_funs :: sets:set(label()), plt :: dialyzer_plt:plt(), - opaques :: [type()], records = dict:new() :: types(), tree_map :: dict:dict(label(), cerl:cerl()), warning_mode = false :: boolean(), @@ -353,8 +351,7 @@ handle_apply(Tree, Map, State) -> Tree, Msg), {State3, Map2, t_none()}; false -> - NewArgs = t_inf_lists(ArgTypes, - t_fun_args(OpType1, 'universe')), + NewArgs = t_inf_lists(ArgTypes, t_fun_args(OpType1)), case any_none(NewArgs) of true -> EnumNewArgs = lists:zip(lists:seq(1, length(NewArgs)), @@ -371,7 +368,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, 'universe'), + Range0 = t_fun_range(OpType1), Range = case t_is_unit(Range0) of true -> t_none(); @@ -408,12 +405,12 @@ handle_apply_or_call([{local, external}|Left], Args, ArgTypes, Map, Tree, State, none -> one; _ -> many end, - NewWarns = {NewHowMany, []}, + NewWarns = {NewHowMany, []}, handle_apply_or_call(Left, Args, ArgTypes, Map, Tree, State, ArgTypes, t_any(), true, NewWarns); handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], Args, ArgTypes, Map, Tree, - #state{opaques = Opaques} = State, + State0, AccArgTypes, AccRet, HadExternal, Warns) -> Any = t_any(), AnyArgs = [Any || _ <- Args], @@ -435,7 +432,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], BArgs = erl_bif_types:arg_types(M, F, A), BRange = fun(FunArgs) -> - erl_bif_types:type(M, F, A, FunArgs, Opaques) + erl_bif_types:type(M, F, A, FunArgs) end, {BArgs, BRange}; false -> @@ -450,22 +447,22 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], end, ?debug("--------------------------------------------------------\n", []), - ?debug("Fun: ~tp\n", [state__lookup_name(Fun, State)]), - ?debug("Module ~p\n", [State#state.module]), + ?debug("Fun: ~tp\n", [state__lookup_name(Fun, State0)]), + ?debug("Module ~p\n", [State0#state.module]), ?debug("CArgs ~ts\n", [erl_types:t_to_string(t_product(CArgs))]), ?debug("ArgTypes ~ts\n", [erl_types:t_to_string(t_product(ArgTypes))]), ?debug("BifArgs ~tp\n", [erl_types:t_to_string(t_product(BifArgs))]), - NewArgsSig = t_inf_lists(SigArgs, ArgTypes, Opaques), + NewArgsSig = t_inf_lists(SigArgs, ArgTypes), ?debug("SigArgs ~ts\n", [erl_types:t_to_string(t_product(SigArgs))]), ?debug("NewArgsSig: ~ts\n", [erl_types:t_to_string(t_product(NewArgsSig))]), - NewArgsContract = t_inf_lists(CArgs, ArgTypes, Opaques), + NewArgsContract = t_inf_lists(CArgs, ArgTypes), ?debug("NewArgsContract: ~ts\n", [erl_types:t_to_string(t_product(NewArgsContract))]), - NewArgsBif = t_inf_lists(BifArgs, ArgTypes, Opaques), + NewArgsBif = t_inf_lists(BifArgs, ArgTypes), ?debug("NewArgsBif: ~ts\n", [erl_types:t_to_string(t_product(NewArgsBif))]), NewArgTypes0 = t_inf_lists(NewArgsSig, NewArgsContract), - NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif, Opaques), + NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif), ?debug("NewArgTypes ~ts\n", [erl_types:t_to_string(t_product(NewArgTypes))]), ?debug("\n", []), @@ -487,6 +484,10 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], ?debug("FailedConj: ~p~n", [FailedConj]), ?debug("IsFailBif: ~p~n", [IsFailBif]), ?debug("IsFailSig: ~p~n", [IsFailSig]), + + State = opacity_conflicts(ArgTypes, t_inf_lists(CArgs, SigArgs), + Args, Tree, Fun, State0), + State2 = case FailedConj andalso not (IsFailBif orelse IsFailSig) of true -> @@ -513,26 +514,16 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], FailReason = apply_fail_reason(FailedSig, FailedBif, FailedContract), Msg = get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, InfSig, - Contr, CArgs, State, FailReason, Opaques), + Contr, CArgs, State, FailReason), WarnType = case Msg of {call, _} -> ?WARN_FAILING_CALL; - {apply, _} -> ?WARN_FAILING_CALL; - {call_with_opaque, _} -> ?WARN_OPAQUE; - {call_without_opaque, _} -> ?WARN_OPAQUE; - {opaque_type_test, _} -> ?WARN_OPAQUE + {apply, _} -> ?WARN_FAILING_CALL end, LocTree = case Msg of {call, [_M, _F, _ASs, ANs | _]} -> select_arg(ANs, Args, Tree); {apply, [_ASs, ANs | _]} -> - select_arg(ANs, Args, Tree); - {call_with_opaque, [_M, _F, _ASs, ANs, _EAs_]} -> - select_arg(ANs, Args, Tree); - {call_without_opaque, - [_M, _F, _ASs, [{N, _T, _TS} | _]]} -> - select_arg([N], Args, Tree); - {opaque_type_test, _} -> - Tree + select_arg(ANs, Args, Tree) end, Frc = {erlang, is_record, 3} =:= state__lookup_name(Fun, State), state__add_warning(State, WarnType, LocTree, Msg, Frc) @@ -591,6 +582,49 @@ handle_apply_or_call([], Args, _ArgTypes, Map, _Tree, State, {had_external, State1} end. +opacity_conflicts([], [], _Args, _Tree, _Fun, State0) -> + State0; +opacity_conflicts(GivenTypes, ExpectedTypes, Args, Tree, Fun, State0) -> + {Reason, Conflicts} = + opacity_conflicts_1(GivenTypes, ExpectedTypes, State0, 1, none, []), + maybe + [{N, _, _} | _] ?= Conflicts, + {Mod, Func, _A} ?= state__lookup_name(Fun, State0), + Description = case Reason of + expected_transparent -> call_with_opaque; + expected_opaque -> call_without_opaque + end, + state__add_warning(State0, + ?WARN_OPAQUE, + select_arg([N], Args, Tree), + {Description, + [Mod, + Func, + format_args(Args, GivenTypes, State0), + Conflicts, + ExpectedTypes]}) + else + _ -> State0 + end. + +opacity_conflicts_1([Given | GivenTypes], + [Expected | ExpectedTypes], + State, N, Reason, Acc0) -> + Conflict = erl_types:t_opacity_conflict(Given, Expected, State#state.module), + Acc = case Conflict of + expected_transparent -> + Acc0 ++ [{N, Given, format_type(Given, State)}]; + expected_opaque -> + Acc0 ++ [{N, Expected, format_type(Expected, State)}]; + none -> + Acc0 + end, + true = expected_opaque < none, %Assertion. + opacity_conflicts_1(GivenTypes, ExpectedTypes, State, + N + 1, min(Reason, Conflict), Acc); +opacity_conflicts_1([], [], _State, _N, Reason, Acc) -> + {Reason, Acc}. + apply_fail_reason(FailedSig, FailedBif, FailedContract) -> if (FailedSig orelse FailedBif) andalso (not FailedContract) -> only_sig; @@ -599,7 +633,7 @@ apply_fail_reason(FailedSig, FailedBif, FailedContract) -> end. get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, - Sig, Contract, ContrArgs, State, FailReason, Opaques) -> + Sig, Contract, _ContrArgs, State, FailReason) -> ArgStrings = format_args(Args, ArgTypes, State), ContractInfo = case Contract of @@ -611,52 +645,12 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, 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, 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), - 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; + {M, F, _A} -> + {call, [M, F, ArgStrings, + ArgNs, FailReason, + format_sig_args(Sig, State), + format_type(t_fun_range(Sig), State), + ContractInfo]}; Label when is_integer(Label) -> {apply, [ArgStrings, ArgNs, FailReason, @@ -665,106 +659,48 @@ get_apply_fail_msg(Fun, Args, ArgTypes, NewArgTypes, ContractInfo]} end. -%% -> [{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, 2} when FN =:= is_function -> - type_test_opaque_arg(Args, ArgTypes, State#state.opaques); - {erlang, FN, 1} -> - case t_is_any(type_test_type(FN, 1)) of - true -> - no; - false -> - type_test_opaque_arg(Args, ArgTypes, State#state.opaques) - end; - _ -> - 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) -> - [begin - Arg = lists:nth(N, ArgTypes), - {N, Arg, format_type(Arg, State)} - end || N <- ArgNs]. -add_bif_warnings({erlang, Op, 2}, [T1, T2] = Ts, Tree, State) +add_bif_warnings({erlang, Op, 2}, [T1, T2], Tree, State) when Op =:= '=:='; Op =:= '==' -> - 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 -> - %% 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) + add_bif_warnings_1(Op, T1, T2, Tree, State); +add_bif_warnings({erlang, Op, 2}, [T1, T2], Tree, State) when Op =:= '=/='; Op =:= '/=' -> - Opaques = State#state.opaques, - case - (not any_none(Ts)) - andalso (not is_int_float_eq_comp(T1, Op, T2, Opaques)) - of - true -> - 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_1(Op, T1, T2, Tree, State); add_bif_warnings(_, _, _, State) -> State. -is_int_float_eq_comp(T1, Op, T2, Opaques) -> +add_bif_warnings_1(Op, T1, T2, Tree, State0) -> + State = case {any_none([T1, T2]), + erl_types:t_opacity_conflict(T1, T2, State0#state.module)} of + {false, expected_transparent} -> + state__add_warning(State0, ?WARN_OPAQUE, Tree, + {opaque_compare, + comp_format_args([], T2, Op, T1, State0)}); + {false, expected_opaque} -> + state__add_warning(State0, ?WARN_OPAQUE, Tree, + {opaque_compare, + comp_format_args([], T1, Op, T2, State0)}); + {_, _} -> + State0 + end, + case {t_is_none(t_inf(T1, T2)), not is_int_float_eq_comp(T1, Op, T2)} of + {true, true} -> + state__add_warning(State, ?WARN_MATCHING, Tree, + {exact_compare, + comp_format_args([], T1, Op, T2, State)}); + {_, _} -> + State + end. + +is_int_float_eq_comp(T1, Op, T2) -> (Op =:= '==' orelse Op =:= '/=') andalso - ((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))). + ((erl_types:t_is_float(T1) + andalso t_is_integer(T2)) orelse + (t_is_integer(T1) + andalso erl_types:t_is_float(T2))). -comp_format_args([1|_], T1, Op, T2, State) -> - [format_type(T2, State), Op, format_type(T1, State)]; +% 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)]. @@ -826,28 +762,30 @@ handle_bitstr(Tree, Map, State) -> Offending, Msg), {State3, Map2, t_none()}; false -> - UnitVal = cerl:concrete(cerl:bitstr_unit(Tree)), - 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), - {State3, Map3, Type} + UnitVal = cerl:concrete(cerl:bitstr_unit(Tree)), + NumberVals = t_number_vals(SizeType), + State3 = case erl_types:t_opacity_conflict(SizeType, + ValType, + State#state.module) of + none -> + State2; + _ -> + Msg = {opaque_size, [format_type(SizeType, State2), + format_cerl(Size)]}, + state__add_warning(State2, ?WARN_OPAQUE, Size, Msg) + end, + {State4, Type} = case NumberVals of + [OneSize] -> + {State3, t_bitstr(0, OneSize * UnitVal)}; + unknown -> + {State3, t_bitstr()}; + _ -> + MinSize = erl_types:number_min(SizeType), + {State3, t_bitstr(UnitVal, UnitVal * MinSize)} + end, + Map3 = enter_type_lists([Val, Size, Tree], + [ValType, SizeType, Type], Map2), + {State4, Map3, Type} end end. @@ -857,15 +795,14 @@ handle_call(Tree, Map, State) -> M = cerl:call_module(Tree), F = cerl:call_name(Tree), Args = cerl:call_args(Tree), - MFAList = [M, F|Args], - {State1, Map1, [MType0, FType0|As]} = traverse_list(MFAList, Map, State), - Opaques = State#state.opaques, - MType = t_inf(t_module(), MType0, Opaques), - FType = t_inf(t_atom(), FType0, Opaques), + MFAList = [M, F | Args], + {State1, Map1, [MType0, FType0 | As]} = traverse_list(MFAList, Map, State), + MType = t_inf(t_module(), MType0), + FType = t_inf(t_atom(), FType0), 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 + case any_none([MType, FType | As]) of true -> State2 = if @@ -951,15 +888,14 @@ 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(), State2#state.opaques)) of + case t_is_none(t_inf(TlType, t_list())) of true -> - Msg = {improper_list_constr, [format_type(TlType, State2)]}, - state__add_warning(State2, ?WARN_NON_PROPER_LIST, Tree, Msg); + Msg = {improper_list_constr, [format_type(TlType, State2)]}, + state__add_warning(State2, ?WARN_NON_PROPER_LIST, Tree, Msg); false -> - State2 + State2 end, - Type = t_cons(HdType, TlType), - {State3, Map2, Type}. + {State3, Map2, t_cons(HdType, TlType)}. %%---------------------------------------- @@ -1001,9 +937,8 @@ handle_primop(Tree, Map, State) -> recv_wait_timeout -> [Arg] = cerl:primop_args(Tree), {State1, Map1, TimeoutType} = traverse(Arg, Map, State), - Opaques = State1#state.opaques, - case t_is_atom(TimeoutType, Opaques) andalso - t_atom_vals(TimeoutType, Opaques) =:= ['infinity'] of + case t_is_atom(TimeoutType) andalso + t_atom_vals(TimeoutType) =:= ['infinity'] of true -> {State1, Map1, t_boolean()}; false -> @@ -1036,23 +971,23 @@ handle_try(Tree, Map, State) -> Map2 = mark_as_fresh(Vars, Map1), {SuccState, SuccMap, SuccType} = case bind_pat_vars(Vars, TypeList, Map2, State1) of - {error, _, _, _, _} -> + {error, _, _, _} -> {State1, map__new(), t_none()}; - {SuccMap1, VarTypes} -> + {SuccMap1, VarTypes, State2} -> %% Try to bind the argument. Will only succeed if %% it is a simple structured term. SuccMap2 = case bind_pat_vars_reverse([Arg], [t_product(VarTypes)], - SuccMap1, State1) of - {error, _, _, _, _} -> SuccMap1; - {SM, _} -> SM + SuccMap1, State2) of + {error, _, _, _} -> SuccMap1; + {SM, _, _} -> SM end, - traverse(Body, SuccMap2, State1) + traverse(Body, SuccMap2, State2) end, ExcMap1 = mark_as_fresh(EVars, Map), - {State2, ExcMap2, HandlerType} = traverse(Handler, ExcMap1, SuccState), + {State3, ExcMap2, HandlerType} = traverse(Handler, ExcMap1, SuccState), TryType = t_sup(SuccType, HandlerType), - {State2, join_maps([ExcMap2, SuccMap], Map1), TryType} + {State3, join_maps([ExcMap2, SuccMap], Map1), TryType} end. %%---------------------------------------- @@ -1079,8 +1014,8 @@ handle_map(Tree,Map,State) -> of ResT -> BindT = t_map([{K, t_any()} || K <- ExactKeys]), case bind_pat_vars_reverse([Arg], [BindT], Map2, State2) of - {error, _, _, _, _} -> {State2, Map2, ResT}; - {Map3, _} -> {State2, Map3, ResT} + {error, _, _, _} -> {State2, Map2, ResT}; + {Map3, _, State3} -> {State3, Map3, ResT} end catch {none, MapType, {K,_}, KVTree} -> Msg2 = {map_update, [format_type(MapType, State2), @@ -1099,7 +1034,7 @@ traverse_map_pairs([Pair|Pairs], Map, State, ShadowKeys, PairAcc, KeyAcc) -> {State1, Map1, [K,V]} = traverse_list([Key,Val],Map,State), KeyAcc1 = case cerl:is_literal(Op) andalso cerl:concrete(Op) =:= exact andalso - t_is_singleton(K, State#state.opaques) andalso + t_is_singleton(K) andalso t_is_none(t_inf(ShadowKeys, K)) of true -> [K|KeyAcc]; false -> KeyAcc @@ -1125,7 +1060,7 @@ handle_tuple(Tree, Map, State) -> TagVal = cerl:atom_val(Tag), case state__lookup_record(TagVal, length(Left), State1) of error -> {State1, Map1, TupleType}; - {ok, RecType, FieldNames} -> + {ok, RecType, _FieldNames} -> InfTupleType = t_inf(RecType, TupleType), case t_is_none(InfTupleType) of true -> @@ -1140,7 +1075,7 @@ handle_tuple(Tree, Map, State) -> false -> case bind_pat_vars(Elements, t_tuple_args(RecType), Map1, State1) of - {error, bind, ErrorPat, ErrorType, _} -> + {error, bind, ErrorPat, ErrorType} -> Msg = {record_constr, [TagVal, format_patterns(ErrorPat), format_type(ErrorType, State1)]}, @@ -1148,27 +1083,15 @@ handle_tuple(Tree, Map, State) -> State2 = state__add_warning(State1, ?WARN_MATCHING, LocTree, Msg), {State2, Map1, t_none()}; - {error, opaque, ErrorPat, ErrorType, OpaqueType} -> - OpaqueStr = format_type(OpaqueType, State1), - Name = field_name(Elements, ErrorPat, FieldNames), - Msg = {opaque_match, - ["record field" ++ Name ++ - " declared to be of type " ++ - format_type(ErrorType, State1), - OpaqueStr, OpaqueStr]}, - LocTree = hd(ErrorPat), - State2 = state__add_warning(State1, ?WARN_OPAQUE, - LocTree, Msg), - {State2, Map1, t_none()}; - {error, record, ErrorPat, ErrorType, _} -> + {error, record, ErrorPat, ErrorType} -> Msg = {record_match, [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)} + {Map2, ETypes, State2} -> + {State2, Map2, t_tuple(ETypes)} end end end; @@ -1180,37 +1103,71 @@ handle_tuple(Tree, Map, State) -> end end. -field_name(Elements, ErrorPat, FieldNames) -> - try - [Pat] = ErrorPat, - Take = lists:takewhile(fun(X) -> X =/= Pat end, Elements), - " " ++ format_atom(lists:nth(length(Take), FieldNames)) - catch - _:_ -> "" - end. - %%---------------------------------------- %% Clauses %% -handle_clauses(Cs, Arg, ArgType, Map, State) -> - handle_clauses(Cs, Arg, ArgType, ArgType, Map, State, [], [], []). +handle_clauses(Cs, Arg, ArgType, Map, State0) -> + {MapList, State, Cases, CaseTypes, Warns0} = + handle_clauses(Cs, Arg, ArgType, ArgType, Map, State0, [], [], [], []), + Warns = opaque_clauses(Cases, CaseTypes, State) ++ Warns0, + {MapList, State, t_sup(CaseTypes), Warns}. -handle_clauses([C|Cs], Arg, ArgType, OrigArgType, MapIn, State, - CaseTypes, Acc, WarnAcc0) -> +handle_clauses([C | Cs], Arg, ArgType, OrigArgType, MapIn, State, + Cases0, CaseTypes0, Acc0, WarnAcc0) -> {State1, ClauseMap, BodyType, NewArgType, WarnAcc} = do_clause(C, Arg, ArgType, OrigArgType, MapIn, State, WarnAcc0), - case t_is_none(BodyType) of - true -> - handle_clauses(Cs, Arg, NewArgType, OrigArgType, MapIn, State1, - CaseTypes, Acc, WarnAcc); - false -> - handle_clauses(Cs, Arg, NewArgType, OrigArgType, MapIn, State1, - [BodyType|CaseTypes], [ClauseMap|Acc], WarnAcc) - end; + + {Cases, CaseTypes, Acc} = + case t_is_none(BodyType) of + true -> {Cases0, CaseTypes0, Acc0}; + false -> {[C | Cases0], [BodyType | CaseTypes0], [ClauseMap | Acc0]} + end, + + handle_clauses(Cs, Arg, NewArgType, OrigArgType, MapIn, State1, + Cases, CaseTypes, Acc, WarnAcc); handle_clauses([], _Arg, _ArgType, _OrigArgType, _MapIn, State, - CaseTypes, Acc, WarnAcc) -> - {lists:reverse(Acc), State, t_sup(CaseTypes), WarnAcc}. + Cases, CaseTypes, Acc, WarnAcc) -> + {lists:reverse(Acc), State, Cases, CaseTypes, WarnAcc}. + +opaque_clauses(Clauses, ClauseTypes, #state{module=Module}=State) -> + maybe + %% Only warn if the clause bodies have different return types (to any + %% degree no matter how small). + [_, _ | _] ?= lists:usort(ClauseTypes), + + FlatTypes = lists:flatmap(fun erl_types:t_elements/1, ClauseTypes), + + %% Do any of the clauses return opaques? + {value, Opaque} ?= lists:search(fun(Type) -> + erl_types:t_is_opaque(Type, Module) + end, FlatTypes), + + %% If yes, do all clauses return opaques from the same module? + %% + %% (This is a compromise to cut down on the number of warnings; modules + %% with multiple opaques can tell them apart more often than not, e.g. + %% `sofs:ordset() | sofs:a_set()`.) + OpaqueMod = erl_types:t_nominal_module(Opaque), + false ?= lists:all(fun(Type) -> + erl_types:t_is_any(Type) orelse + erl_types:t_is_impossible(Type) orelse + (erl_types:t_is_opaque(Type, Module) andalso + erl_types:t_nominal_module(Type) =:= OpaqueMod) + end, FlatTypes), + + %% If not, emit a warning that the clauses mix opaques and non-opaques. + [begin + Msg = {opaque_union, + [erl_types:t_is_opaque(Type, Module), + format_type(Type, State)]}, + clause_error_warning(Msg, false, Clause) + end || {Clause, Type} <- lists:zip(Clauses, ClauseTypes), + not erl_types:t_is_impossible(Type), + not erl_types:t_is_any(Type)] + else + _ -> [] + end. %% %% Process one clause. @@ -1230,7 +1187,7 @@ do_clause(C, Arg, ArgType, OrigArgType, Map, State, Warns) -> BindRes = case t_is_none(ArgType) of true -> - {error, maybe_covered, OrigArgType, ignore, ignore}; + {error, maybe_covered, OrigArgType, ignore}; false -> ArgTypes = get_arg_list(ArgType, Pats), bind_pat_vars(Pats, ArgTypes, Map1, State) @@ -1238,7 +1195,7 @@ do_clause(C, Arg, ArgType, OrigArgType, Map, State, Warns) -> %% Test whether the binding succeeded. case BindRes of - {error, _ErrorType, _NewPats, _Type, _OpaqueTerm} -> + {error, _ErrorType, _NewPats, _Type} -> ?debug("Failed binding pattern: ~ts\nto ~ts\n", [cerl_prettypr:format(C), format_type(ArgType, State)]), NewWarns = @@ -1250,14 +1207,14 @@ do_clause(C, Arg, ArgType, OrigArgType, Map, State, Warns) -> [Warn|Warns] end, {State, Map, t_none(), ArgType, NewWarns}; - {Map2, PatTypes} -> + {Map2, PatTypes, State1} -> %% Try to bind the argument. Will only succeed if %% it is a simple structured term. Map3 = case bind_pat_vars_reverse([Arg], [t_product(PatTypes)], - Map2, State) of - {error, _, _, _, _} -> Map2; - {NewMap, _} -> NewMap + Map2, State1) of + {error, _, _, _} -> Map2; + {NewMap, _, _} -> NewMap end, %% Subtract the matched type from the case argument. That will @@ -1268,35 +1225,35 @@ do_clause(C, Arg, ArgType, OrigArgType, Map, State, Warns) -> NewArgType = t_subtract(t_product(t_to_tlist(ArgType)), GenType), %% Now test whether the guard will succeed. - case bind_guard(Guard, Map3, State) of + case bind_guard(Guard, Map3, State1) of {error, Reason} -> - ?debug("Failed guard: ~ts\n", - [cerl_prettypr:format(C, [{hook, cerl_typean:pp_hook()}])]), - Warn = clause_guard_error(State, Reason, C, Pats, ArgType), - {State, Map, t_none(), NewArgType, [Warn|Warns]}; - Map4 -> + ?debug("Failed guard: ~p\n", + [C]), + Warn = clause_guard_error(State1, Reason, C, Pats, ArgType), + {State1, Map, t_none(), NewArgType, [Warn|Warns]}; + {Map4, State2} -> Body = cerl:clause_body(C), - {RetState, RetMap, BodyType} = traverse(Body, Map4, State), + {RetState, RetMap, BodyType} = traverse(Body, Map4, State2), {RetState, RetMap, BodyType, NewArgType, Warns} end end. -clause_error(State, Map, {error, maybe_covered, OrigArgType, _, _}, C, Pats, _) -> +clause_error(State, Map, {error, maybe_covered, OrigArgType, _}, C, Pats, _) -> %% This clause is covered by previous clauses, but it is possible %% that it would never match anyway. Find out by matching the %% original argument types of the case. OrigArgTypes = get_arg_list(OrigArgType, Pats), Msg = case bind_pat_vars(Pats, OrigArgTypes, Map, State) of - {_, _} -> + {_, _, State1} -> %% The pattern would match if it had not been covered. PatString = format_patterns(Pats), - ArgTypeString = format_type(OrigArgType, State), + ArgTypeString = format_type(OrigArgType, State1), {pattern_match_cov, [PatString, ArgTypeString]}; - {error, ErrorType, _, _, OpaqueTerm} -> + {error, ErrorType, _, _} -> %% This pattern can never match. failed_msg(State, ErrorType, Pats, OrigArgType, - Pats, OrigArgType, OpaqueTerm) + Pats, OrigArgType) end, Force = false, clause_error_warning(Msg, Force, C); @@ -1305,19 +1262,19 @@ clause_error(State, _Map, BindRes, C, Pats, ArgType) -> %% unless it is the default clause in a list comprehension %% without any filters. Force = not is_lc_default_clause(C), - {error, ErrorType, NewPats, NewType, OpaqueTerm} = BindRes, - Msg = failed_msg(State, ErrorType, Pats, ArgType, NewPats, NewType, OpaqueTerm), + {error, ErrorType, NewPats, NewType} = BindRes, + Msg = failed_msg(State, ErrorType, Pats, ArgType, NewPats, NewType), clause_error_warning(Msg, Force, C). -failed_msg(State, ErrorType, Pats, Type, NewPats, NewType, OpaqueTerm) -> +failed_msg(State, ErrorType, Pats, Type, NewPats, NewType) -> case ErrorType of bind -> {pattern_match, [format_patterns(Pats), format_type(Type, State)]}; record -> {record_match, [format_patterns(NewPats), format_type(NewType, State)]}; opaque -> - {opaque_match, [format_patterns(NewPats), format_type(NewType, State), - format_type(OpaqueTerm, State)]} + {opaque_match, [format_patterns(NewPats), format_type(Type, State), + format_type(NewType, State)]} end. clause_error_warning(Msg, Force, C) -> @@ -1329,6 +1286,7 @@ warn_type({Tag, _}) -> neg_guard_fail -> ?WARN_MATCHING; opaque_guard -> ?WARN_OPAQUE; opaque_match -> ?WARN_OPAQUE; + opaque_union -> ?WARN_OPAQUE_UNION; pattern_match -> ?WARN_MATCHING; pattern_match_cov -> ?WARN_MATCHING; record_match -> ?WARN_MATCHING @@ -1440,10 +1398,9 @@ bind_pat_vars(Pats, Types, Map, State, Rev) -> Error end. -do_bind_pat_vars([Pat|Pats], [Type|Types], Map, State, Rev, Acc) -> - ?debug("Binding pat: ~tw to ~ts\n", [cerl:type(Pat), format_type(Type, State)]), - Opaques = State#state.opaques, - {NewMap, TypeOut} = +do_bind_pat_vars([Pat|Pats], [Type|Types], Map, State0, Rev, Acc) -> + ?debug("Binding pat: ~tw to ~ts\n", [cerl:type(Pat), format_type(Type, State0)]), + {NewMap, TypeOut, State} = case cerl:type(Pat) of alias -> %% Map patterns are more allowing than the type of their literal. We @@ -1451,59 +1408,59 @@ do_bind_pat_vars([Pat|Pats], [Type|Types], Map, State, Rev, Acc) -> AliasPat = dialyzer_utils:refold_pattern(cerl:alias_pat(Pat)), Var = cerl:alias_var(Pat), Map1 = enter_subst(Var, AliasPat, Map), - {Map2, [PatType]} = do_bind_pat_vars([AliasPat], [Type], - Map1, State, Rev, []), - {enter_type(Var, PatType, Map2), PatType}; + {Map2, [PatType], State1} = do_bind_pat_vars([AliasPat], [Type], + Map1, State0, Rev, []), + {enter_type(Var, PatType, Map2), PatType, State1}; binary -> case Rev of true -> %% Cannot bind the binary if we are in reverse match since %% binary patterns and binary construction are not %% symmetric. - {Map, t_bitstr()}; + {Map, t_bitstr(), State0}; false -> - BinType = bind_checked_inf(Pat, t_bitstr(), Type, Opaques), + {BinType, State1} = bind_checked_inf(Pat, t_bitstr(), Type, State0), Segs = cerl:binary_segments(Pat), - {Map1, SegTypes} = bind_bin_segs(Segs, BinType, Map, State), - {Map1, t_bitstr_concat(SegTypes)} + {Map1, SegTypes, State2} = bind_bin_segs(Segs, BinType, Map, State1), + {Map1, t_bitstr_concat(SegTypes), State2} end; cons -> - Cons = bind_checked_inf(Pat, t_cons(), Type, Opaques), - {Map1, [HdType, TlType]} = + {Cons, State1} = bind_checked_inf(Pat, t_cons(), Type, State0), + {Map1, [HdType, TlType], State2} = do_bind_pat_vars([cerl:cons_hd(Pat), cerl:cons_tl(Pat)], - [t_cons_hd(Cons, Opaques), - t_cons_tl(Cons, Opaques)], - Map, State, Rev, []), - {Map1, t_cons(HdType, TlType)}; + [t_cons_hd(Cons), + t_cons_tl(Cons)], + Map, State1, Rev, []), + {Map1, t_cons(HdType, TlType), State2}; literal -> Pat0 = dialyzer_utils:refold_pattern(Pat), case cerl:is_literal(Pat0) of true -> - LiteralType = bind_checked_inf(Pat, literal_type(Pat), Type, Opaques), - {Map, LiteralType}; + {LiteralType, State1} = bind_checked_inf(Pat, literal_type(Pat), Type, State0), + {Map, LiteralType, State1}; false -> - {Map1, [PatType]} = do_bind_pat_vars([Pat0], [Type], Map, State, Rev, []), - {Map1, PatType} + {Map1, [PatType], State1} = do_bind_pat_vars([Pat0], [Type], Map, State0, Rev, []), + {Map1, PatType, State1} end; map -> - bind_map(Pat, Type, Map, State, Opaques, Rev); + bind_map(Pat, Type, Map, State0, Rev); tuple -> - bind_tuple(Pat, Type, Map, State, Opaques, Rev); + bind_tuple(Pat, Type, Map, State0, Rev); values -> Es = cerl:values_es(Pat), - {Map1, EsTypes} = do_bind_pat_vars(Es, t_to_tlist(Type), - Map, State, Rev, []), - {Map1, t_product(EsTypes)}; + {Map1, EsTypes, State1} = do_bind_pat_vars(Es, t_to_tlist(Type), + Map, State0, Rev, []), + {Map1, t_product(EsTypes), State1}; var -> VarType1 = - case state__lookup_type_for_letrec(Pat, State) of + case state__lookup_type_for_letrec(Pat, State0) of error -> lookup_type(Pat, Map); {ok, RecType} -> RecType end, %% Must do inf when binding args to pats. Vars in pats are fresh. - VarType2 = bind_checked_inf(Pat, VarType1, Type, Opaques), + {VarType2, State1} = bind_checked_inf(Pat, VarType1, Type, State0), Map1 = enter_type(Pat, VarType2, Map), - {Map1, VarType2}; + {Map1, VarType2, State1}; _Other -> %% Catch all is needed when binding args to pats ?debug("Failed match for ~p\n", [_Other]), @@ -1511,25 +1468,25 @@ do_bind_pat_vars([Pat|Pats], [Type|Types], Map, State, Rev, Acc) -> bind_error([Pat], Type, t_none(), bind) end, do_bind_pat_vars(Pats, Types, NewMap, State, Rev, [TypeOut|Acc]); -do_bind_pat_vars([], [], Map, _State, _Rev, Acc) -> - {Map, lists:reverse(Acc)}. +do_bind_pat_vars([], [], Map, State, _Rev, Acc) -> + {Map, lists:reverse(Acc), State}. -bind_map(Pat, Type, Map, State, Opaques, Rev) -> - MapT = bind_checked_inf(Pat, t_map(), Type, Opaques), +bind_map(Pat, Type, Map, State0, Rev) -> + {MapT, State1} = bind_checked_inf(Pat, t_map(), Type, State0), case Rev of %% TODO: Reverse matching (propagating a matched subset back to a value). true -> - {Map, MapT}; + {Map, MapT, State1}; false -> FoldFun = - fun(Pair, {MapAcc, ListAcc}) -> + fun(Pair, {MapAcc, ListAcc, StateAcc0}) -> %% Only exact (:=) can appear in patterns. exact = cerl:concrete(cerl:map_pair_op(Pair)), Key = cerl:map_pair_key(Pair), KeyType = case cerl:type(Key) of var -> - case state__lookup_type_for_letrec(Key, State) of + case state__lookup_type_for_letrec(Key, StateAcc0) of error -> lookup_type(Key, MapAcc); {ok, RecType} -> RecType end; @@ -1537,19 +1494,19 @@ bind_map(Pat, Type, Map, State, Opaques, Rev) -> literal_type(Key) end, Bind = erl_types:t_map_get(KeyType, MapT), - {MapAcc1, [ValType]} = + {MapAcc1, [ValType], StateAcc} = do_bind_pat_vars([cerl:map_pair_val(Pair)], - [Bind], MapAcc, State, Rev, []), - case t_is_singleton(KeyType, Opaques) of - true -> {MapAcc1, [{KeyType, ValType}|ListAcc]}; - false -> {MapAcc1, ListAcc} + [Bind], MapAcc, StateAcc0, Rev, []), + case t_is_singleton(KeyType) of + true -> {MapAcc1, [{KeyType, ValType}|ListAcc], StateAcc}; + false -> {MapAcc1, ListAcc, StateAcc} end end, - {Map1, Pairs} = lists:foldl(FoldFun, {Map, []}, cerl:map_es(Pat)), - {Map1, t_inf(MapT, t_map(Pairs))} + {Map1, Pairs, State2} = lists:foldl(FoldFun, {Map, [], State1}, cerl:map_es(Pat)), + {Map1, t_inf(MapT, t_map(Pairs)), State2} end. -bind_tuple(Pat, Type, Map, State, Opaques, Rev) -> +bind_tuple(Pat, Type, Map, State, Rev) -> Es = cerl:tuple_es(Pat), {IsTypedRecord, Prototype} = case Es of @@ -1572,34 +1529,40 @@ bind_tuple(Pat, Type, Map, State, Opaques, Rev) -> {false, t_tuple(length(Es))} end end, - Tuple = bind_checked_inf(Pat, Prototype, Type, Opaques), - SubTuples = t_tuple_subtypes(Tuple, Opaques), + {Tuple, State1} = bind_checked_inf(Pat, Prototype, Type, State), + SubTuples = t_tuple_subtypes(Tuple), MapJ = join_maps_begin(Map), %% Need to call the top function to get the try-catch wrapper. - Results = [bind_pat_vars(Es, t_tuple_args(SubTuple, Opaques), MapJ, State, Rev) || - SubTuple <- SubTuples], - case lists:keyfind(opaque, 2, Results) of - {error, opaque, _PatList, _Type, Opaque} -> - bind_error([Pat], Tuple, Opaque, opaque); - false -> - case [M || {M, _} <- Results, M =/= error] of - [] -> - case IsTypedRecord of - true -> bind_error([Pat], Tuple, Prototype, record); - false -> bind_error([Pat], Tuple, t_none(), bind) - end; - Maps -> - Map1 = join_maps_end(Maps, MapJ), - TupleType = t_sup([t_tuple(EsTypes) || - {M, EsTypes} <- Results, M =/= error]), - {Map1, TupleType} - end + {Results, State2} = lists:mapfoldl(fun(SubTuple,State0) -> + maybe + {M, P, NewState} ?= bind_pat_vars(Es, + t_tuple_args(SubTuple), + MapJ, + State0, + Rev), + {{M, P}, NewState} + else + Error -> {Error, State0} + end + end, + State1, SubTuples), + case [M || {M, _} <- Results, M =/= error] of + [] -> + case IsTypedRecord of + true -> bind_error([Pat], Tuple, Prototype, record); + false -> bind_error([Pat], Tuple, t_none(), bind) + end; + Maps -> + Map1 = join_maps_end(Maps, MapJ), + TupleType = t_sup([t_tuple(EsTypes) || + {M, EsTypes} <- Results, M =/= error]), + {Map1, TupleType, State2} end. bind_bin_segs(BinSegs, BinType, Map, State) -> bind_bin_segs(BinSegs, BinType, [], Map, State). -bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> +bind_bin_segs([Seg|Segs], BinType, Acc, Map, State0) -> Val = cerl:bitstr_val(Seg), SegType = cerl:concrete(cerl:bitstr_type(Seg)), UnitVal = cerl:concrete(cerl:bitstr_unit(Seg)), @@ -1608,34 +1571,32 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> {literal, all} -> binary = SegType, [] = Segs, %Assertion. T = t_inf(t_bitstr(UnitVal, 0), BinType), - {Map1, [Type]} = do_bind_pat_vars([Val], [T], Map, - State, false, []), - Type1 = remove_local_opaque_types(Type, State#state.opaques), - bind_bin_segs(Segs, t_none(), [Type1|Acc], Map1, State); + {Map1, [Type], State1} = do_bind_pat_vars([Val], [T], Map, + State0, false, []), + bind_bin_segs(Segs, + t_bitstr(0, 0), + [erl_types:t_structural(Type) | Acc], + Map1, + State1); SizeType when SegType =:= utf8; SegType =:= utf16; SegType =:= utf32 -> {literal, undefined} = SizeType, %Assertion. - {Map1, [_]} = do_bind_pat_vars([Val], [t_integer()], - Map, State, false, []), + {Map1, [_], State1} = do_bind_pat_vars([Val], [t_integer()], + Map, State0, false, []), Type = t_binary(), bind_bin_segs(Segs, t_bitstr_match(Type, BinType), - [Type | Acc], Map1, State); + [Type | Acc], Map1, State1); {literal, N} when not is_integer(N); N < 0 -> %% Bogus literal size, fails in runtime. bind_error([Seg], BinType, t_none(), bind); _ -> - {Map1, [SizeType]} = do_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, + {Map1, [SizeType], State1} = do_bind_pat_vars([Size], [t_non_neg_integer()], + Map, State0, false, []), + NumberVals = t_number_vals(SizeType), Type = case NumberVals of [OneSize] -> t_bitstr(0, UnitVal * OneSize); _ -> % 'unknown' too - MinSize = erl_types:number_min(SizeType, Opaques), + MinSize = erl_types:number_min(SizeType), t_bitstr(UnitVal, UnitVal * MinSize) end, ValConstr = @@ -1663,15 +1624,15 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> end end end, - {Map2, [_]} = do_bind_pat_vars([Val], [ValConstr], Map1, State, false, []), + {Map2, [_], State2} = do_bind_pat_vars([Val], [ValConstr], Map1, State1, false, []), NewBinType = t_bitstr_match(Type, BinType), case t_is_none(NewBinType) of true -> bind_error([Seg], BinType, t_none(), bind); - false -> bind_bin_segs(Segs, NewBinType, [Type|Acc], Map2, State) + false -> bind_bin_segs(Segs, NewBinType, [Type|Acc], Map2, State2) end end; -bind_bin_segs([], _BinType, Acc, Map, _State) -> - {Map, lists:reverse(Acc)}. +bind_bin_segs([], _BinType, Acc, Map, State) -> + {Map, lists:reverse(Acc), State}. bitstr_bitsize_type(Size) -> case cerl:is_literal(Size) of @@ -1681,21 +1642,23 @@ bitstr_bitsize_type(Size) -> %% Return the infimum (meet) of ExpectedType and Type if it describes a %% possible value (not 'none' or 'unit'), otherwise raise a bind_error(). -bind_checked_inf(Pat, ExpectedType, Type, Opaques) -> - Inf = t_inf(ExpectedType, Type, Opaques), +bind_checked_inf(Pat, ExpectedType, Type, State0) -> + Inf = t_inf(ExpectedType, Type), + State = case erl_types:t_opacity_conflict(Type, + ExpectedType, + State0#state.module) of + none -> + State0; + _ -> + Msg = failed_msg(State0, opaque, Pat, ExpectedType, [Pat], Inf), + state__add_warning(State0, ?WARN_OPAQUE, Pat, Msg) + end, case t_is_impossible(Inf) of - true -> - case t_find_opaque_mismatch(ExpectedType, Type, Opaques) of - {ok, T1, T2} -> - bind_error([Pat], T1, T2, opaque); - error -> - bind_error([Pat], Type, Inf, bind) - end; - false -> - Inf + true -> {bind_error([Pat], Type, Inf, bind), State}; + false -> {Inf, State} end. -bind_error(Pats, Type, OpaqueType, Error0) -> +bind_error(Pats, Type, _Inf, Error0) -> Error = case {Error0, Pats} of {bind, [Pat]} -> case is_literal_record(Pat) of @@ -1704,38 +1667,38 @@ bind_error(Pats, Type, OpaqueType, Error0) -> end; _ -> Error0 end, - throw({error, Error, Pats, Type, OpaqueType}). + throw({error, Error, Pats, Type}). %%---------------------------------------- %% Guards %% -bind_guard(Guard, Map, State) -> - try bind_guard(Guard, Map, maps:new(), pos, State) of - {Map1, _Type} -> Map1 +bind_guard(Guard, Map, State0) -> + try bind_guard(Guard, Map, maps:new(), pos, State0) of + {Map1, _Type, State} -> {Map1, State} catch throw:{fail, Warning} -> {error, Warning}; throw:{fatal_fail, Warning} -> {error, Warning} end. -bind_guard(Guard, Map, Env, Eval, State) -> +bind_guard(Guard, Map, Env, Eval, State0) -> ?debug("Handling ~tw guard: ~ts\n", [Eval, cerl_prettypr:format(Guard, [{noann, true}])]), case cerl:type(Guard) of binary -> - {Map, t_binary()}; + {Map, t_binary(), State0}; 'case' -> Arg = cerl:case_arg(Guard), Clauses = cerl:case_clauses(Guard), - bind_guard_case_clauses(Arg, Clauses, Map, Env, Eval, State); + bind_guard_case_clauses(Arg, Clauses, Map, Env, Eval, State0); cons -> Hd = cerl:cons_hd(Guard), Tl = cerl:cons_tl(Guard), - {Map1, HdType} = bind_guard(Hd, Map, Env, dont_know, State), - {Map2, TlType} = bind_guard(Tl, Map1, Env, dont_know, State), - {Map2, t_cons(HdType, TlType)}; + {Map1, HdType, State1} = bind_guard(Hd, Map, Env, dont_know, State0), + {Map2, TlType, State2} = bind_guard(Tl, Map1, Env, dont_know, State1), + {Map2, t_cons(HdType, TlType), State2}; literal -> - {Map, literal_type(Guard)}; + {Map, literal_type(Guard), State0}; 'try' -> Arg = cerl:try_arg(Guard), [Var] = cerl:try_vars(Guard), @@ -1744,21 +1707,21 @@ bind_guard(Guard, Map, Env, Eval, State) -> Map1 = join_maps_begin(Map), Map2 = mark_as_fresh(EVars, Map1), %% Visit handler first so we know if it should be ignored - {{HandlerMap, HandlerType}, HandlerE} = - try {bind_guard(cerl:try_handler(Guard), Map2, Env, Eval, State), none} + {{HandlerMap, HandlerType, State1}, HandlerE} = + try {bind_guard(cerl:try_handler(Guard), Map2, Env, Eval, State0), none} catch throw:HE -> - {{Map2, t_none()}, HE} + {{Map2, t_none(), State0}, HE} end, BodyEnv = maps:put(get_label(Var), Arg, Env), case t_is_none(guard_eval_inf(Eval, HandlerType)) of %% Handler won't save us; pretend it does not exist - true -> bind_guard(cerl:try_body(Guard), Map, BodyEnv, Eval, State); + true -> bind_guard(cerl:try_body(Guard), Map, BodyEnv, Eval, State1); false -> - {{BodyMap, BodyType}, BodyE} = + {{BodyMap, BodyType, State2}, BodyE} = try {bind_guard(cerl:try_body(Guard), Map1, BodyEnv, - Eval, State), none} + Eval, State1), none} catch throw:BE -> - {{Map1, t_none()}, BE} + {{Map1, t_none(), State1}, BE} end, Map3 = join_maps_end([BodyMap, HandlerMap], Map1), case t_is_none(Sup = t_sup(BodyType, HandlerType)) of @@ -1777,122 +1740,174 @@ bind_guard(Guard, Map, Env, Eval, State) -> {_, {_,Rsn}} -> Rsn; _ -> none end}); - false -> {Map3, Sup} + false -> {Map3, Sup, State2} end end; tuple -> Es0 = cerl:tuple_es(Guard), - {Map1, Es} = bind_guard_list(Es0, Map, Env, dont_know, State), - {Map1, t_tuple(Es)}; + {Map1, Es, State1} = bind_guard_list(Es0, Map, Env, dont_know, State0), + {Map1, t_tuple(Es), State1}; map -> case Eval of - dont_know -> handle_guard_map(Guard, Map, Env, State); - _PosOrNeg -> {Map, t_none()} %% Map exprs do not produce bools + dont_know -> handle_guard_map(Guard, Map, Env, State0); + _PosOrNeg -> {Map, t_none(), State0} %% Map exprs do not produce bools end; 'let' -> Arg = cerl:let_arg(Guard), [Var] = cerl:let_vars(Guard), %%?debug("Storing: ~w\n", [Var]), NewEnv = maps:put(get_label(Var), Arg, Env), - bind_guard(cerl:let_body(Guard), Map, NewEnv, Eval, State); + bind_guard(cerl:let_body(Guard), Map, NewEnv, Eval, State0); values -> Es = cerl:values_es(Guard), - List = [bind_guard(V, Map, Env, dont_know, State) || V <- Es], - Type = t_product([T || {_, T} <- List]), - {Map, Type}; + {Types, State1} = lists:mapfoldl(fun(V, StateAcc0) -> + {_, Type, StateAcc0} = + bind_guard(V, + Map, + Env, + dont_know, + StateAcc0), + {Type, StateAcc0} + end, State0, Es), + {Map, t_product(Types), State1}; var -> ?debug("Looking for var(~w)...", [cerl_trees:get_label(Guard)]), GuardLabel = get_label(Guard), case Env of #{GuardLabel := Tree} -> ?debug("Found it\n", []), - {Map1, Type} = bind_guard(Tree, Map, Env, Eval, State), - {enter_type(Guard, Type, Map1), Type}; + {Map1, Type, State1} = bind_guard(Tree, Map, Env, Eval, State0), + {enter_type(Guard, Type, Map1), Type, State1}; #{} -> ?debug("Did not find it\n", []), Type = lookup_type(Guard, Map), Inf = guard_eval_inf(Eval, Type), - {enter_type(Guard, Inf, Map), Inf} + {enter_type(Guard, Inf, Map), Inf, State0} end; call -> - handle_guard_call(Guard, Map, Env, Eval, State) + handle_guard_call(Guard, Map, Env, Eval, State0) end. -handle_guard_call(Guard, Map, Env, Eval, State) -> - MFA = {cerl:atom_val(cerl:call_module(Guard)), - cerl:atom_val(cerl:call_name(Guard)), - cerl:call_arity(Guard)}, +handle_guard_call(Guard, Map, Env, Eval, State0) -> + MFA = {erlang = cerl:atom_val(cerl:call_module(Guard)), %Assertion. + cerl:atom_val(cerl:call_name(Guard)), + cerl:call_arity(Guard)}, + Args = cerl:call_args(Guard), + {_, ArgTypes, State1} = bind_guard_list(Args, Map, Env, dont_know, State0), + State2 = handle_opaque_guard_warnings(MFA, Guard, Args, ArgTypes, State1), case MFA of {erlang, is_function, 2} -> - handle_guard_is_function(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_is_function(Guard, Map, Env, Eval, State2); {erlang, F, 3} when F =:= internal_is_record; F =:= is_record -> - handle_guard_is_record(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_is_record(Guard, Map, Env, Eval, State2); {erlang, '=:=', 2} -> - handle_guard_eqeq(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_eqeq(Guard, Map, Env, Eval, State2); {erlang, '==', 2} -> - handle_guard_eq(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_eq(Guard, Map, Env, Eval, State2); {erlang, 'and', 2} -> - handle_guard_and(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_and(Guard, Map, Env, Eval, State2); {erlang, 'or', 2} -> - handle_guard_or(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_or(Guard, Map, Env, Eval, State2); {erlang, 'not', 1} -> - handle_guard_not(Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_not(Guard, Map, Env, Eval, State2); {erlang, Comp, 2} when Comp =:= '<'; Comp =:= '=<'; Comp =:= '>'; Comp =:= '>=' -> - handle_guard_comp(Guard, Comp, Map, Env, Eval, State); + {_,_,_}=handle_guard_comp(Guard, Comp, Map, Env, Eval, State2); {erlang, F, A} -> TypeTestType = type_test_type(F, A), case t_is_any(TypeTestType) of true -> - handle_guard_gen_fun(MFA, Guard, Map, Env, Eval, State); + {_,_,_}=handle_guard_gen_fun(MFA, Guard, Map, Env, Eval, State2); false -> - handle_guard_type_test(Guard, TypeTestType, Map, Env, Eval, State) + {_,_,_}=handle_guard_type_test(Guard, TypeTestType, Map, Env, Eval, State2) end end. -handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State) -> +handle_opaque_guard_warnings({erlang, Op, 2}=MFA, + Guard, + [_, _]=Args, + [LHS, RHS]=ArgTypes, + State) when Op =:= '=:='; + Op =:= '=/=' -> + %% To reduce noise, we tolerate equivalence tests between two opaques with + %% the same name (or any() specifically) as it doesn't leak any information + %% about their contents. + case ((erl_types:t_is_any(LHS) orelse erl_types:t_is_any(RHS)) orelse + (erl_types:t_is_opaque(LHS) andalso + erl_types:t_is_opaque(RHS) andalso + erl_types:t_is_same_opaque(LHS, RHS))) of + true -> State; + false -> handle_opaque_guard_warnings_1(MFA, Guard, Args, ArgTypes, State) + end; +handle_opaque_guard_warnings(MFA, Guard, Args, ArgTypes, State) -> + handle_opaque_guard_warnings_1(MFA, Guard, Args, ArgTypes, State). + +handle_opaque_guard_warnings_1(MFA, Guard, Args, ArgTypes, State) -> + Ns = [Arg || {Arg, Type} <- lists:enumerate(ArgTypes), + erl_types:t_is_opaque(Type, State#state.module)], + maybe + [_ | _] ?= Ns, + {erlang, Fname, _A} = MFA, + Msg = case is_infix_op(MFA) of + true -> + [ArgType1, ArgType2] = ArgTypes, + [Arg1, Arg2] = Args, + {opaque_guard, + [format_args_1([Arg1], [ArgType1], State), + atom_to_list(Fname), + format_args_1([Arg2], [ArgType2], State), + Ns]}; + false -> + {opaque_guard, + [Fname, format_args(Args, ArgTypes, State)]} + end, + state__add_warning(State, ?WARN_OPAQUE, Guard, Msg) + else + _ -> State + end. + +handle_guard_gen_fun({M, F, A}, Guard, Map, Env, Eval, State0) -> Args = cerl:call_args(Guard), - {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), + {Map1, As, State1} = bind_guard_list(Args, Map, Env, dont_know, State0), + BifRet = erl_bif_types:type(M, F, A, As), case t_is_none(BifRet) of true -> %% Is this an error-bif? case t_is_none(erl_bif_types:type(M, F, A)) of - true -> signal_guard_fail(Eval, Guard, As, State); - false -> signal_guard_fatal_fail(Eval, Guard, As, State) + true -> signal_guard_fail(Eval, Guard, As, State1); + false -> signal_guard_fatal_fail(Eval, Guard, As, State1) end; false -> BifArgs = bif_args(M, F, A), - Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As, Opaques), Map1), + Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As), Map1), Ret = guard_eval_inf(Eval, BifRet), case t_is_none(Ret) of true -> case Eval =:= pos of - true -> signal_guard_fail(Eval, Guard, As, State); + true -> signal_guard_fail(Eval, Guard, As, State1); false -> throw({fail, none}) end; - false -> {Map2, Ret} + false -> {Map2, Ret, State1} end end. -handle_guard_type_test(Guard, TypeTestType, Map, Env, Eval, State) -> +handle_guard_type_test(Guard, TypeTestType, Map, Env, Eval, State0) -> [Arg] = cerl:call_args(Guard), - {Map1, ArgType} = bind_guard(Arg, Map, Env, dont_know, State), - case bind_type_test(Eval, TypeTestType, ArgType, State) of + {Map1, ArgType, State1} = bind_guard(Arg, Map, Env, dont_know, State0), + case bind_type_test(Eval, TypeTestType, ArgType) of error -> - ?debug("Type test: ~w failed\n", [F]), - signal_guard_fail(Eval, Guard, [ArgType], State); + ?debug("Type test: ~w failed\n", [Guard]), + signal_guard_fail(Eval, Guard, [ArgType], State1); {ok, NewArgType, Ret} -> ?debug("Type test: ~w succeeded, NewType: ~ts, Ret: ~ts\n", - [F, t_to_string(NewArgType), t_to_string(Ret)]), - {enter_type(Arg, NewArgType, Map1), Ret} + [Guard, t_to_string(NewArgType), t_to_string(Ret)]), + {enter_type(Arg, NewArgType, Map1), Ret, State1} end. -bind_type_test(Eval, Type, ArgType, State) -> +bind_type_test(Eval, Type, ArgType) -> case Eval of pos -> - Inf = t_inf(Type, ArgType, State#state.opaques), + Inf = t_inf(Type, ArgType), case t_is_none(Inf) of true -> error; false -> {ok, Inf, t_atom(true)} @@ -1928,38 +1943,37 @@ type_test_type(TypeTest, 1) -> type_test_type(_, _) -> t_any(). -handle_guard_comp(Guard, Comp, Map, Env, Eval, State) -> +handle_guard_comp(Guard, Comp, Map, Env, Eval, State0) -> Args = cerl:call_args(Guard), [Arg1, Arg2] = Args, - {Map1, ArgTypes} = bind_guard_list(Args, Map, Env, dont_know, State), - Opaques = State#state.opaques, + {Map1, ArgTypes, State1} = bind_guard_list(Args, Map, Env, dont_know, State0), [Type1, Type2] = ArgTypes, - IsInt1 = t_is_integer(Type1, Opaques), - IsInt2 = t_is_integer(Type2, Opaques), + IsInt1 = t_is_integer(Type1), + IsInt2 = t_is_integer(Type2), case {type(Arg1), type(Arg2)} of {{literal, Lit1}, {literal, Lit2}} -> case erlang:Comp(cerl:concrete(Lit1), cerl:concrete(Lit2)) of - true when Eval =:= pos -> {Map, t_atom(true)}; - true when Eval =:= dont_know -> {Map, t_atom(true)}; - true when Eval =:= neg -> {Map, t_atom(true)}; + true when Eval =:= pos -> {Map, t_atom(true), State1}; + true when Eval =:= dont_know -> {Map, t_atom(true), State1}; + true when Eval =:= neg -> {Map, t_atom(true), State1}; false when Eval =:= pos -> - signal_guard_fail(Eval, Guard, ArgTypes, State); - false when Eval =:= dont_know -> {Map, t_atom(false)}; - false when Eval =:= neg -> {Map, t_atom(false)} + signal_guard_fail(Eval, Guard, ArgTypes, State1); + false when Eval =:= dont_know -> {Map, t_atom(false), State1}; + false when Eval =:= neg -> {Map, t_atom(false), State1} end; {{literal, Lit1}, var} when IsInt1, IsInt2, Eval =:= pos -> - case bind_comp_literal_var(Lit1, Arg2, Type2, Comp, Map1, Opaques) of - error -> signal_guard_fail(Eval, Guard, ArgTypes, State); - {ok, NewMap} -> {NewMap, t_atom(true)} + case bind_comp_literal_var(Lit1, Arg2, Type2, Comp, Map1) of + error -> signal_guard_fail(Eval, Guard, ArgTypes, State1); + {ok, NewMap} -> {NewMap, t_atom(true), State1} end; {var, {literal, Lit2}} when IsInt1, IsInt2, Eval =:= pos -> case bind_comp_literal_var(Lit2, Arg1, Type1, invert_comp(Comp), - Map1, Opaques) of - error -> signal_guard_fail(Eval, Guard, ArgTypes, State); - {ok, NewMap} -> {NewMap, t_atom(true)} + Map1) of + error -> signal_guard_fail(Eval, Guard, ArgTypes, State1); + {ok, NewMap} -> {NewMap, t_atom(true), State1} end; {_, _} -> - handle_guard_gen_fun({erlang, Comp, 2}, Guard, Map, Env, Eval, State) + handle_guard_gen_fun({erlang, Comp, 2}, Guard, Map, Env, Eval, State1) end. invert_comp('=<') -> '>='; @@ -1967,10 +1981,10 @@ invert_comp('<') -> '>'; invert_comp('>=') -> '=<'; invert_comp('>') -> '<'. -bind_comp_literal_var(Lit, Var, VarType, CompOp, Map, Opaques) -> +bind_comp_literal_var(Lit, Var, VarType, CompOp, Map) -> LitVal = cerl:concrete(Lit), NewVarType = - case t_number_vals(VarType, Opaques) of + case t_number_vals(VarType) of unknown -> Range = case CompOp of @@ -1979,7 +1993,7 @@ bind_comp_literal_var(Lit, Var, VarType, CompOp, Map, Opaques) -> '>=' -> t_from_range(neg_inf, LitVal); '>' -> t_from_range(neg_inf, LitVal - 1) end, - t_inf(Range, VarType, Opaques); + t_inf(Range, VarType); NumberVals -> NewNumberVals = [X || X <- NumberVals, erlang:CompOp(LitVal, X)], t_integers(NewNumberVals) @@ -1989,84 +2003,83 @@ bind_comp_literal_var(Lit, Var, VarType, CompOp, Map, Opaques) -> false -> {ok, enter_type(Var, NewVarType, Map)} end. -handle_guard_is_function(Guard, Map, Env, Eval, State) -> +handle_guard_is_function(Guard, Map, Env, Eval, State0) -> Args = cerl:call_args(Guard), - {Map1, ArgTypes0} = bind_guard_list(Args, Map, Env, dont_know, State), + {Map1, ArgTypes0, State1} = bind_guard_list(Args, Map, Env, dont_know, State0), [FunType0, ArityType0] = ArgTypes0, - Opaques = State#state.opaques, - ArityType = t_inf(ArityType0, t_integer(), Opaques), + ArityType = t_inf(ArityType0, t_integer()), case t_is_none(ArityType) of - true -> signal_guard_fail(Eval, Guard, ArgTypes0, State); + true -> signal_guard_fail(Eval, Guard, ArgTypes0, State1); false -> FunTypeConstr = - case t_number_vals(ArityType, State#state.opaques) of + case t_number_vals(ArityType) of unknown -> t_fun(); Vals -> t_sup([t_fun(lists:duplicate(X, t_any()), t_any()) || X <- Vals]) end, - FunType = t_inf(FunType0, FunTypeConstr, Opaques), + FunType = t_inf(FunType0, FunTypeConstr), case t_is_none(FunType) of true -> case Eval of - pos -> signal_guard_fail(Eval, Guard, ArgTypes0, State); - neg -> {Map1, t_atom(false)}; - dont_know -> {Map1, t_atom(false)} + pos -> signal_guard_fail(Eval, Guard, ArgTypes0, State1); + neg -> {Map1, t_atom(false), State1}; + dont_know -> {Map1, t_atom(false), State1} end; false -> case Eval of pos -> {enter_type_lists(Args, [FunType, ArityType], Map1), - t_atom(true)}; - neg -> {Map1, t_atom(false)}; - dont_know -> {Map1, t_boolean()} + t_atom(true), State1}; + neg -> {Map1, t_atom(false), State1}; + dont_know -> {Map1, t_boolean(), State1} end end end. -handle_guard_is_record(Guard, Map, Env, Eval, State) -> +handle_guard_is_record(Guard, Map, Env, Eval, State0) -> Args = cerl:call_args(Guard), [Rec, Tag0, Arity0] = Args, Tag = cerl:atom_val(Tag0), Arity = cerl:int_val(Arity0), - {Map1, RecType} = bind_guard(Rec, Map, Env, dont_know, State), + {Map1, RecType, State1} = bind_guard(Rec, Map, Env, dont_know, State0), ArityMin1 = Arity - 1, - 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 + Inf = t_inf(Tuple, RecType), + State2 = case erl_types:t_opacity_conflict(RecType, + Tuple, + State1#state.module) of + none -> + State1; + _ -> + Msg = failed_msg(State1, opaque, Guard, Tuple, [Guard], Inf), + state__add_warning(State1, ?WARN_OPAQUE, Guard, Msg) + end, + case t_is_none(Inf) of true -> - 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; + case Eval of + pos -> signal_guard_fail(Eval, Guard, + [RecType, t_from_term(Tag), + t_from_term(Arity)], + State2); + neg -> {Map1, t_atom(false), State2}; + dont_know -> {Map1, t_atom(false), State2} + end; false -> TupleType = - case state__lookup_record(Tag, ArityMin1, State) of + case state__lookup_record(Tag, ArityMin1, State2) of error -> Tuple; {ok, Prototype, _FieldNames} -> Prototype end, - Type = t_inf(TupleType, RecType, State#state.opaques), + Type = t_inf(TupleType, RecType), 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}}); + FArgs = "record " ++ format_type(RecType, State2), + throw({fail, {Guard, {record_matching, [FArgs, Tag]}}}); false -> case Eval of - pos -> {enter_type(Rec, Type, Map1), t_atom(true)}; - neg -> {Map1, t_atom(false)}; - dont_know -> {Map1, t_boolean()} + pos -> {enter_type(Rec, Type, Map1), t_atom(true), State2}; + neg -> {Map1, t_atom(false), State2}; + dont_know -> {Map1, t_boolean(), State2} end end end. @@ -2078,17 +2091,17 @@ handle_guard_eq(Guard, Map, Env, Eval, State) -> case cerl:concrete(Lit1) =:= cerl:concrete(Lit2) of true -> if - Eval =:= pos -> {Map, t_atom(true)}; + Eval =:= pos -> {Map, t_atom(true), State}; Eval =:= neg -> ArgTypes = [t_from_term(cerl:concrete(Lit1)), t_from_term(cerl:concrete(Lit2))], signal_guard_fail(Eval, Guard, ArgTypes, State); - Eval =:= dont_know -> {Map, t_atom(true)} + Eval =:= dont_know -> {Map, t_atom(true), State} end; false -> if - Eval =:= neg -> {Map, t_atom(false)}; - Eval =:= dont_know -> {Map, t_atom(false)}; + Eval =:= neg -> {Map, t_atom(false), State}; + Eval =:= dont_know -> {Map, t_atom(false), State}; Eval =:= pos -> ArgTypes = [t_from_term(cerl:concrete(Lit1)), t_from_term(cerl:concrete(Lit2))], @@ -2118,22 +2131,19 @@ handle_guard_eq(Guard, Map, Env, Eval, State) -> end. 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), - Opaques = State#state.opaques, + {Map1, Type1, State1} = bind_guard(Arg1, Map, Env, dont_know, State), + {Map2, Type2, State2} = bind_guard(Arg2, Map1, Env, dont_know, State1), case - t_is_nil(Type1, Opaques) orelse t_is_nil(Type2, Opaques) - orelse t_is_atom(Type1, Opaques) orelse t_is_atom(Type2, Opaques) + t_is_nil(Type1) orelse t_is_nil(Type2) + orelse t_is_atom(Type1) orelse t_is_atom(Type2) of - true -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State); + true -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State2); false -> - %% XXX. Is this test OK? - OpArgs = erl_types:t_find_unknown_opaque(Type1, Type2, Opaques), - case OpArgs =:= [] of - true -> - {Map2, guard_eval_inf(Eval, t_boolean())}; - false -> - signal_guard_fail(Eval, Guard, [Type1, Type2], State) + case erl_types:t_opacity_conflict(Type1, Type2, State2#state.module) of + none -> + {Map2, guard_eval_inf(Eval, t_boolean()), State2}; + _ -> + signal_guard_fail(Eval, Guard, [Type1, Type2], State2) end end. @@ -2148,12 +2158,12 @@ handle_guard_eqeq(Guard, Map, Env, Eval, State) -> ArgTypes = [t_from_term(cerl:concrete(Lit1)), t_from_term(cerl:concrete(Lit2))], signal_guard_fail(Eval, Guard, ArgTypes, State); - Eval =:= pos -> {Map, t_atom(true)}; - Eval =:= dont_know -> {Map, t_atom(true)} + Eval =:= pos -> {Map, t_atom(true), State}; + Eval =:= dont_know -> {Map, t_atom(true), State} end; false -> - if Eval =:= neg -> {Map, t_atom(false)}; - Eval =:= dont_know -> {Map, t_atom(false)}; + if Eval =:= neg -> {Map, t_atom(false), State}; + Eval =:= dont_know -> {Map, t_atom(false), State}; Eval =:= pos -> ArgTypes = [t_from_term(cerl:concrete(Lit1)), t_from_term(cerl:concrete(Lit2))], @@ -2168,25 +2178,18 @@ handle_guard_eqeq(Guard, Map, Env, Eval, State) -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) end. -bind_eqeq_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), +bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State0) -> + {Map1, Type1, State1} = bind_guard(Arg1, Map, Env, dont_know, State0), + {Map2, Type2, State2} = bind_guard(Arg2, Map1, Env, dont_know, State1), ?debug("Types are:~ts =:= ~ts\n", [t_to_string(Type1), t_to_string(Type2)]), - Opaques = State#state.opaques, - Inf = t_inf(Type1, Type2, Opaques), + Inf = t_inf(Type1, Type2), case t_is_none(Inf) of true -> - 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) + case Eval of + neg -> {Map2, t_atom(false), State2}; + dont_know -> {Map2, t_atom(false), State2}; + pos -> signal_guard_fail(Eval, Guard, [Type1, Type2], State2) end; false -> case Eval of @@ -2195,92 +2198,90 @@ bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) -> {var, var} -> Map3 = enter_subst(Arg1, Arg2, Map2), Map4 = enter_type(Arg2, Inf, Map3), - {Map4, t_atom(true)}; + {Map4, t_atom(true), State2}; {var, _} -> Map3 = enter_type(Arg1, Inf, Map2), - {Map3, t_atom(true)}; + {Map3, t_atom(true), State2}; {_, var} -> Map3 = enter_type(Arg2, Inf, Map2), - {Map3, t_atom(true)}; + {Map3, t_atom(true), State2}; {_, _} -> - {Map2, t_atom(true)} + {Map2, t_atom(true), State2} end; neg -> - {Map2, t_atom(false)}; + {Map2, t_atom(false), State2}; dont_know -> - {Map2, t_boolean()} + {Map2, t_boolean(), State2} end end. -bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) -> +bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State0) -> 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_any_atom(true, Type, Opaques) of + {_, Type, State1} = MT = bind_guard(Arg2, Map, Env, pos, State0), + case t_is_any_atom(true, Type) of true -> MT; false -> - {_, Type0} = bind_guard(Arg2, Map, Env, Eval, State), - signal_guard_fail(Eval, Guard, [Type0, t_atom(true)], State) + {_, Type0, State2} = bind_guard(Arg2, Map, Env, Eval, State1), + signal_guard_fail(Eval, Guard, [Type0, t_atom(true)], State2) end; false -> - {Map1, Type} = bind_guard(Arg2, Map, Env, neg, State), - case t_is_any_atom(false, Type, Opaques) of - true -> {Map1, t_atom(true)}; + {Map1, Type, State1} = bind_guard(Arg2, Map, Env, neg, State0), + case t_is_any_atom(false, Type) of + true -> {Map1, t_atom(true), State1}; false -> - {_, Type0} = bind_guard(Arg2, Map, Env, Eval, State), - signal_guard_fail(Eval, Guard, [Type0, t_atom(false)], State) + {_, Type0, State2} = bind_guard(Arg2, Map, Env, Eval, State1), + signal_guard_fail(Eval, Guard, [Type0, t_atom(false)], State2) end; Term -> LitType = t_from_term(Term), - {Map1, Type} = bind_guard(Arg2, Map, Env, Eval, State), - case t_is_subtype(LitType, Type) of - false -> signal_guard_fail(Eval, Guard, [Type, LitType], State); - true -> - case cerl:is_c_var(Arg2) of - true -> {enter_type(Arg2, LitType, Map1), t_atom(true)}; - false -> {Map1, t_atom(true)} - end + {Map1, Type, State1} = bind_guard(Arg2, Map, Env, Eval, State0), + case t_is_none(t_inf(LitType, Type)) of + true -> signal_guard_fail(Eval, Guard, [Type, LitType], State1); + false -> + case cerl:is_c_var(Arg2) of + true -> {enter_type(Arg2, LitType, Map1), t_atom(true), State1}; + false -> {Map1, t_atom(true), State1} + end end end. -handle_guard_and(Guard, Map, Env, Eval, State) -> +handle_guard_and(Guard, Map, Env, Eval, State0) -> [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_any_atom(true, Type1, Opaques) of - false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State); + {Map1, Type1, State1} = bind_guard(Arg1, Map, Env, Eval, State0), + case t_is_any_atom(true, Type1) of + false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State1); true -> - {Map2, Type2} = bind_guard(Arg2, Map1, Env, Eval, State), - case t_is_any_atom(true, Type2, Opaques) of - false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State); - true -> {Map2, t_atom(true)} + {Map2, Type2, State2} = bind_guard(Arg2, Map1, Env, Eval, State1), + case t_is_any_atom(true, Type2) of + false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State2); + true -> {Map2, t_atom(true), State2} end end; neg -> MapJ = join_maps_begin(Map), - {Map1, Type1} = - try bind_guard(Arg1, MapJ, Env, neg, State) - catch throw:{fail, _} -> bind_guard(Arg2, MapJ, Env, pos, State) + {Map1, Type1, State1} = + try bind_guard(Arg1, MapJ, Env, neg, State0) + catch throw:{fail, _} -> bind_guard(Arg2, MapJ, Env, pos, State0) end, - {Map2, Type2} = - try bind_guard(Arg2, MapJ, Env, neg, State) - catch throw:{fail, _} -> bind_guard(Arg1, MapJ, Env, pos, State) + {Map2, Type2, State2} = + try bind_guard(Arg2, MapJ, Env, neg, State1) + catch throw:{fail, _} -> bind_guard(Arg1, MapJ, Env, pos, State1) end, case - t_is_any_atom(false, Type1, Opaques) - orelse t_is_any_atom(false, Type2, Opaques) + t_is_any_atom(false, Type1) + orelse t_is_any_atom(false, Type2) of - true -> {join_maps_end([Map1, Map2], MapJ), t_atom(false)}; - false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State) + true -> {join_maps_end([Map1, Map2], MapJ), t_atom(false), State2}; + false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State2) end; dont_know -> MapJ = join_maps_begin(Map), - {Map1, Type1} = bind_guard(Arg1, MapJ, Env, dont_know, State), - {Map2, Type2} = bind_guard(Arg2, MapJ, Env, dont_know, State), + {Map1, Type1, State1} = bind_guard(Arg1, MapJ, Env, dont_know, State0), + {Map2, Type2, State2} = bind_guard(Arg2, MapJ, Env, dont_know, State1), Bool1 = t_inf(Type1, t_boolean()), Bool2 = t_inf(Type2, t_boolean()), case t_is_none(Bool1) orelse t_is_none(Bool2) of @@ -2288,114 +2289,114 @@ handle_guard_and(Guard, Map, Env, Eval, State) -> false -> NewMap = join_maps_end([Map1, Map2], MapJ), NewType = - case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of + case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of {['true'] , ['true'] } -> t_atom(true); {['false'], _ } -> t_atom(false); {_ , ['false']} -> t_atom(false); {unknown , _ } -> - signal_guard_fail(Eval, Guard, [Type1, Type2], State); + signal_guard_fail(Eval, Guard, [Type1, Type2], State2); {_ , unknown } -> - signal_guard_fail(Eval, Guard, [Type1, Type2], State); + signal_guard_fail(Eval, Guard, [Type1, Type2], State2); {_ , _ } -> t_boolean() end, - {NewMap, NewType} + {NewMap, NewType, State2} end end. -handle_guard_or(Guard, Map, Env, Eval, State) -> +handle_guard_or(Guard, Map, Env, Eval, State0) -> [Arg1, Arg2] = cerl:call_args(Guard), - Opaques = State#state.opaques, case Eval of pos -> MapJ = join_maps_begin(Map), - {Map1, Bool1} = - try bind_guard(Arg1, MapJ, Env, pos, State) + {Map1, Bool1, State1} = + try bind_guard(Arg1, MapJ, Env, pos, State0) catch - throw:{fail,_} -> bind_guard(Arg1, MapJ, Env, dont_know, State) + throw:{fail,_} -> bind_guard(Arg1, MapJ, Env, dont_know, State0) end, - {Map2, Bool2} = - try bind_guard(Arg2, MapJ, Env, pos, State) + {Map2, Bool2, State2} = + try bind_guard(Arg2, MapJ, Env, pos, State1) catch - throw:{fail,_} -> bind_guard(Arg2, MapJ, Env, dont_know, State) + throw:{fail,_} -> bind_guard(Arg2, MapJ, Env, dont_know, State1) end, case - ((t_is_any_atom(true, Bool1, Opaques) - andalso t_is_boolean(Bool2, Opaques)) + ((t_is_any_atom(true, Bool1) + andalso t_is_boolean(Bool2)) orelse - (t_is_any_atom(true, Bool2, Opaques) - andalso t_is_boolean(Bool1, Opaques))) + (t_is_any_atom(true, Bool2) + andalso t_is_boolean(Bool1))) of - true -> {join_maps_end([Map1, Map2], MapJ), t_atom(true)}; - false -> signal_guard_fail(Eval, Guard, [Bool1, Bool2], State) + true -> {join_maps_end([Map1, Map2], MapJ), t_atom(true), State2}; + false -> signal_guard_fail(Eval, Guard, [Bool1, Bool2], State2) end; neg -> - {Map1, Type1} = bind_guard(Arg1, Map, Env, neg, State), - case t_is_any_atom(false, Type1, Opaques) of - false -> signal_guard_fail(Eval, Guard, [Type1, t_any()], State); + {Map1, Type1, State1} = bind_guard(Arg1, Map, Env, neg, State0), + case t_is_any_atom(false, Type1) of + false -> + signal_guard_fail(Eval, Guard, [Type1, t_any()], State1); true -> - {Map2, Type2} = bind_guard(Arg2, Map1, Env, neg, State), - case t_is_any_atom(false, Type2, Opaques) of - false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State); - true -> {Map2, t_atom(false)} + {Map2, Type2, State2} = bind_guard(Arg2, Map1, Env, neg, State1), + case t_is_any_atom(false, Type2) of + false -> signal_guard_fail(Eval, Guard, [Type1, Type2], State2); + true -> {Map2, t_atom(false), State2} end end; dont_know -> MapJ = join_maps_begin(Map), - {Map1, Type1} = bind_guard(Arg1, MapJ, Env, dont_know, State), - {Map2, Type2} = bind_guard(Arg2, MapJ, Env, dont_know, State), + {Map1, Type1, State1} = bind_guard(Arg1, MapJ, Env, dont_know, State0), + {Map2, Type2, State2} = bind_guard(Arg2, MapJ, Env, dont_know, State1), Bool1 = t_inf(Type1, t_boolean()), Bool2 = t_inf(Type2, t_boolean()), case t_is_none(Bool1) orelse t_is_none(Bool2) of - true -> throw({fatal_fail, none}); + true -> + throw({fatal_fail, none}); false -> NewMap = join_maps_end([Map1, Map2], MapJ), NewType = - case {t_atom_vals(Bool1, Opaques), t_atom_vals(Bool2, Opaques)} of + case {t_atom_vals(Bool1), t_atom_vals(Bool2)} of {['false'], ['false']} -> t_atom(false); {['true'] , _ } -> t_atom(true); {_ , ['true'] } -> t_atom(true); {unknown , _ } -> - signal_guard_fail(Eval, Guard, [Type1, Type2], State); + signal_guard_fail(Eval, Guard, [Type1, Type2], State2); {_ , unknown } -> - signal_guard_fail(Eval, Guard, [Type1, Type2], State); + signal_guard_fail(Eval, Guard, [Type1, Type2], State2); {_ , _ } -> t_boolean() end, - {NewMap, NewType} + {NewMap, NewType, State2} end end. -handle_guard_not(Guard, Map, Env, Eval, State) -> +handle_guard_not(Guard, Map, Env, Eval, State0) -> [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_any_atom(true, Type, Opaques) of - true -> {Map1, t_atom(false)}; + {Map1, Type, State1} = bind_guard(Arg, Map, Env, pos, State0), + case t_is_any_atom(true, Type) of + true -> {Map1, t_atom(false), State1}; false -> - {_, Type0} = bind_guard(Arg, Map, Env, Eval, State), - signal_guard_fail(Eval, Guard, [Type0], State) + {_, Type0, State2} = bind_guard(Arg, Map, Env, Eval, State1), + signal_guard_fail(Eval, Guard, [Type0], State2) end; pos -> - {Map1, Type} = bind_guard(Arg, Map, Env, neg, State), - case t_is_any_atom(false, Type, Opaques) of - true -> {Map1, t_atom(true)}; + {Map1, Type, State1} = bind_guard(Arg, Map, Env, neg, State0), + case t_is_any_atom(false, Type) of + true -> {Map1, t_atom(true), State1}; false -> - {_, Type0} = bind_guard(Arg, Map, Env, Eval, State), - signal_guard_fail(Eval, Guard, [Type0], State) + {_, Type0, State2} = bind_guard(Arg, Map, Env, Eval, State1), + signal_guard_fail(Eval, Guard, [Type0], State2) end; dont_know -> - {Map1, Type} = bind_guard(Arg, Map, Env, dont_know, State), + {Map1, Type, State1} = bind_guard(Arg, Map, Env, dont_know, State0), Bool = t_inf(Type, t_boolean()), case t_is_none(Bool) of true -> throw({fatal_fail, none}); false -> - case t_atom_vals(Bool, Opaques) of - ['true'] -> {Map1, t_atom(false)}; - ['false'] -> {Map1, t_atom(true)}; - [_, _] -> {Map1, Bool}; - unknown -> signal_guard_fail(Eval, Guard, [Type], State) + case t_atom_vals(Bool) of + ['true'] -> {Map1, t_atom(false), State1}; + ['false'] -> {Map1, t_atom(true), State1}; + [_, _] -> {Map1, Bool, State1}; + unknown -> signal_guard_fail(Eval, Guard, [Type], State1) end end end. @@ -2404,33 +2405,33 @@ bind_guard_list(Guards, Map, Env, Eval, State) -> bind_guard_list(Guards, Map, Env, Eval, State, []). bind_guard_list([G|Gs], Map, Env, Eval, State, Acc) -> - {Map1, T} = bind_guard(G, Map, Env, Eval, State), - bind_guard_list(Gs, Map1, Env, Eval, State, [T|Acc]); -bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> - {Map, lists:reverse(Acc)}. + {Map1, T, State1} = bind_guard(G, Map, Env, Eval, State), + bind_guard_list(Gs, Map1, Env, Eval, State1, [T|Acc]); +bind_guard_list([], Map, _Env, _Eval, State, Acc) -> + {Map, lists:reverse(Acc), State}. -handle_guard_map(Guard, Map, Env, State) -> +handle_guard_map(Guard, Map, Env, State0) -> Pairs = cerl:map_es(Guard), Arg = cerl:map_arg(Guard), - {Map1, ArgType0} = bind_guard(Arg, Map, Env, dont_know, State), + {Map1, ArgType0, State1} = bind_guard(Arg, Map, Env, dont_know, State0), ArgType1 = t_inf(t_map(), ArgType0), case t_is_impossible(ArgType1) of - true -> {Map1, t_none()}; + true -> {Map1, t_none(), State1}; false -> - {Map2, TypePairs} = bind_guard_map_pairs(Pairs, Map1, Env, State, []), + {Map2, TypePairs, State2} = bind_guard_map_pairs(Pairs, Map1, Env, State1, []), {Map2, lists:foldl(fun({KV,assoc},Acc) -> erl_types:t_map_put(KV,Acc); ({KV,exact},Acc) -> erl_types:t_map_update(KV,Acc) - end, ArgType1, TypePairs)} + end, ArgType1, TypePairs), State2} end. -bind_guard_map_pairs([], Map, _Env, _State, PairAcc) -> - {Map, lists:reverse(PairAcc)}; -bind_guard_map_pairs([Pair|Pairs], Map, Env, State, PairAcc) -> +bind_guard_map_pairs([], Map, _Env, State, PairAcc) -> + {Map, lists:reverse(PairAcc), State}; +bind_guard_map_pairs([Pair|Pairs], Map, Env, State0, PairAcc) -> Key = cerl:map_pair_key(Pair), Val = cerl:map_pair_val(Pair), Op = cerl:map_pair_op(Pair), - {Map1, [K,V]} = bind_guard_list([Key,Val],Map,Env,dont_know,State), - bind_guard_map_pairs(Pairs, Map1, Env, State, + {Map1, [K,V], State1} = bind_guard_list([Key,Val],Map,Env,dont_know,State0), + bind_guard_map_pairs(Pairs, Map1, Env, State1, [{{K,V},cerl:concrete(Op)}|PairAcc]). -type eval() :: 'pos' | 'neg' | 'dont_know'. @@ -2458,19 +2459,12 @@ signal_guard_fatal_fail(Eval, Guard, ArgTypes, State) -> signal_guard_failure(Eval, Guard, ArgTypes, Tag, State) -> Args = cerl:call_args(Guard), F = cerl:atom_val(cerl:call_name(Guard)), - {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, + MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)}, + Kind = case Eval of + neg -> neg_guard_fail; + pos -> guard_fail; + dont_know -> guard_fail + end, FArgs = case is_infix_op(MFA) of true -> @@ -2478,17 +2472,12 @@ signal_guard_failure(Eval, Guard, ArgTypes, Tag, State) -> [Arg1, Arg2] = Args, [format_args_1([Arg1], [ArgType1], State), atom_to_list(F), - format_args_1([Arg2], [ArgType2], State)] ++ XInfo; + format_args_1([Arg2], [ArgType2], State)]; false -> [F, format_args(Args, ArgTypes, State)] end, Msg = {Kind, FArgs}, - LocTree = - case XInfo of - [] -> Guard; - [Ns1] -> select_arg(Ns1, Args, Guard) - end, - throw({Tag, {LocTree, Msg}}). + throw({Tag, {Guard, Msg}}). is_infix_op({erlang, F, 2}) -> erl_internal:comp_op(F, 2); @@ -2501,12 +2490,12 @@ bif_args(M, F, A) -> List -> List end. -bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State) -> +bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State0) -> Clauses1 = filter_fail_clauses(Clauses), Map = join_maps_begin(Map0), - {GenMap, GenArgType} = bind_guard(Arg, Map, Env, dont_know, State), + {GenMap, GenArgType, State1} = bind_guard(Arg, Map, Env, dont_know, State0), bind_guard_case_clauses(GenArgType, GenMap, Arg, Clauses1, Map, Env, Eval, - t_none(), [], [], State). + t_none(), [], [], State1). filter_fail_clauses([Clause|Left]) -> case (cerl:clause_pats(Clause) =:= []) of @@ -2525,41 +2514,41 @@ filter_fail_clauses([]) -> []. bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left], - Map, Env, Eval, AccType, AccMaps, Throws, State) -> + Map, Env, Eval, AccType, AccMaps, Throws, State0) -> Pats = cerl:clause_pats(Clause), - {NewMap0, ArgType} = + {NewMap0, ArgType, State1} = case Pats of [Pat] -> case cerl:is_literal(Pat) of true -> try case cerl:concrete(Pat) of - true -> bind_guard(ArgExpr, Map, Env, pos, State); - false -> bind_guard(ArgExpr, Map, Env, neg, State); - _ -> {GenMap, GenArgType} + true -> bind_guard(ArgExpr, Map, Env, pos, State0); + false -> bind_guard(ArgExpr, Map, Env, neg, State0); + _ -> {GenMap, GenArgType, State0} end catch - throw:{fail, _} -> {none, GenArgType} + throw:{fail, _} -> {none, GenArgType, State0} end; false -> - {GenMap, GenArgType} + {GenMap, GenArgType, State0} end; - _ -> {GenMap, GenArgType} + _ -> {GenMap, GenArgType, State0} end, - NewMap1 = + {NewMap1, State3} = case Pats =:= [] of - true -> NewMap0; + true -> {NewMap0, State1}; false -> case t_is_none(ArgType) of - true -> none; + true -> {none, State1}; false -> ArgTypes = case t_is_any(ArgType) of true -> Any = t_any(), [Any || _ <- Pats]; false -> t_to_tlist(ArgType) end, - case bind_pat_vars(Pats, ArgTypes, NewMap0, State) of - {error, _, _, _, _} -> none; - {PatMap, _PatTypes} -> PatMap + case bind_pat_vars(Pats, ArgTypes, NewMap0, State1) of + {error, _, _, _} -> {none, State1}; + {PatMap, _PatTypes, State2} -> {PatMap, State2} end end end, @@ -2569,53 +2558,41 @@ bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left], case (NewMap1 =:= none) orelse t_is_none(GenArgType) of true -> bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env, - Eval, AccType, AccMaps, Throws, State); + Eval, AccType, AccMaps, Throws, State3); false -> - {NewAccType, NewAccMaps, NewThrows} = - try - {NewMap2, GuardType} = bind_guard(Guard, NewMap1, Env, pos, State), - case t_is_none(t_inf(t_atom(true), GuardType)) of - true -> throw({fail, none}); - false -> ok - end, - {NewMap3, CType} = bind_guard(cerl:clause_body(Clause), NewMap2, - Env, Eval, State), - Opaques = State#state.opaques, - case Eval of - pos -> - case t_is_any_atom(true, CType, Opaques) of - true -> ok; - false -> throw({fail, none}) - end; - neg -> - case t_is_any_atom(false, CType, Opaques) of - true -> ok; - false -> throw({fail, none}) - end; - dont_know -> - ok - end, - {t_sup(AccType, CType), [NewMap3|AccMaps], Throws} - catch - throw:{fail, Reason} -> - Throws1 = case Reason of - none -> Throws; - _ -> Throws ++ [Reason] - end, - {AccType, AccMaps, Throws1} + {NewAccType, NewAccMaps, NewThrows, State6} = + try maybe + {NewMap2, GuardType, State4} = bind_guard(Guard, NewMap1, Env, pos, State3), + true ?= not t_is_none(t_inf(t_atom(true), GuardType)), + {NewMap3, CType, State5} = bind_guard(cerl:clause_body(Clause), NewMap2, + Env, Eval, State4), + true ?= case Eval of + pos -> t_is_any_atom(true, CType); + neg -> t_is_any_atom(false, CType); + dont_know -> true + end, + {t_sup(AccType, CType), [NewMap3|AccMaps], Throws, State5} + else + false -> {AccType, AccMaps, Throws, State3} + end + of + Res -> Res + catch + throw:{fail, Reason} -> + {AccType, AccMaps, Throws ++ [Reason], State3} end, bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env, - Eval, NewAccType, NewAccMaps, NewThrows, State) + Eval, NewAccType, NewAccMaps, NewThrows, State6) end; bind_guard_case_clauses(_GenArgType, _GenMap, _ArgExpr, [], Map, _Env, _Eval, - AccType, AccMaps, Throws, _State) -> + AccType, AccMaps, Throws, State) -> case t_is_none(AccType) of true -> case Throws of [Throw|_] -> throw({fail, Throw}); [] -> throw({fail, none}) end; - false -> {join_maps_end(AccMaps, Map), AccType} + false -> {join_maps_end(AccMaps, Map), AccType, State} end. %%% =========================================================================== @@ -2837,15 +2814,11 @@ get_label(L) when is_integer(L) -> get_label(T) -> cerl_trees:get_label(T). -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_simple(ArgType, _State) -> + 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_structured(ArgType) -> %% case t_is_nil(ArgType) of @@ -2874,11 +2847,10 @@ is_send(send) -> true; is_send(_) -> false. is_lc_simple_list(Tree, TreeType, State) -> - Opaques = State#state.opaques, Ann = cerl:get_ann(Tree), lists:member(list_comprehension, Ann) andalso t_is_list(TreeType) - andalso t_is_simple(t_list_elements(TreeType, Opaques), State). + andalso t_is_simple(t_list_elements(TreeType), State). %%% =========================================================================== %%% @@ -2887,7 +2859,6 @@ is_lc_simple_list(Tree, TreeType, State) -> %%% =========================================================================== state__new(Callgraph, Codeserver, Tree, Plt, Module, Records) -> - Opaques = erl_types:t_opaque_from_records(Records), {TreeMap, FunHomes} = build_tree_map(Tree, Callgraph), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), @@ -2901,7 +2872,7 @@ state__new(Callgraph, Codeserver, Tree, Plt, Module, Records) -> Env = lists:foldl(fun(Fun, Env) -> dict:store(Fun, map__new(), Env) end, dict:new(), Funs), #state{callgraph = Callgraph, codeserver = Codeserver, - envs = Env, fun_tab = FunTab, fun_homes = FunHomes, opaques = Opaques, + envs = Env, fun_tab = FunTab, fun_homes = FunHomes, plt = Plt, records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, module = Module, reachable_funs = sets:new()}. @@ -2933,28 +2904,19 @@ state__add_warning(#state{warning_mode = false} = State, _, _, _, _) -> state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, Tag, Tree, Msg, Force) -> Ann = cerl:get_ann(Tree), - case Force of + case Force orelse (not is_compiler_generated(Ann)) of true -> WarningInfo = {get_file(Ann, State), get_location(Tree), State#state.curr_fun}, Warn = {Tag, WarningInfo, Msg}, - ?debug("MSG ~ts\n", [dialyzer:format_warning(Warn)]), + case Tag of + ?WARN_CONTRACT_RANGE -> ok; + _ -> ?debug("MSG ~ts\n", [dialyzer:format_warning(Warn)]) + end, State#state{warnings = [Warn|Warnings]}; false -> - case is_compiler_generated(Ann) of - true -> State; - false -> - WarningInfo = {get_file(Ann, State), - get_location(Tree), - State#state.curr_fun}, - Warn = {Tag, WarningInfo, Msg}, - case Tag of - ?WARN_CONTRACT_RANGE -> ok; - _ -> ?debug("MSG ~ts\n", [dialyzer:format_warning(Warn)]) - end, - State#state{warnings = [Warn|Warnings]} - end + State end. state__remove_added_warnings(OldState, NewState) -> @@ -3408,8 +3370,8 @@ format_field_diffs(RecConstruction, #state{records = R}) -> -spec format_sig_args(type(), state()) -> string(). -format_sig_args(Type, #state{opaques = Opaques} = State) -> - SigArgs = t_fun_args(Type, Opaques), +format_sig_args(Type, State) -> + SigArgs = t_fun_args(Type), case SigArgs of [] -> "()"; [SArg|SArgs] -> @@ -3462,9 +3424,6 @@ map_pats(Pats) -> fold_literals(TreeList) -> [cerl:fold_literal(Tree) || Tree <- TreeList]. -format_atom(A) -> - format_cerl(cerl:c_atom(A)). - type(Tree) -> Folded = cerl:fold_literal(Tree), case cerl:type(Folded) of diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index 90b156f86576..0e68559785be 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -38,6 +38,7 @@ build(Opts) -> ?WARN_FUN_APP, ?WARN_MATCHING, ?WARN_OPAQUE, + ?WARN_OPAQUE_UNION, ?WARN_CALLGRAPH, ?WARN_FAILING_CALL, ?WARN_BIN_CONSTRUCTION, @@ -501,7 +502,9 @@ build_warnings([Opt|Opts], Warnings) -> no_match -> ordsets:del_element(?WARN_MATCHING, Warnings); no_opaque -> - ordsets:del_element(?WARN_OPAQUE, Warnings); + S = ordsets:from_list([?WARN_OPAQUE, + ?WARN_OPAQUE_UNION]), + ordsets:subtract(Warnings, S); no_fail_call -> ordsets:del_element(?WARN_FAILING_CALL, Warnings); no_contracts -> @@ -543,6 +546,10 @@ build_warnings([Opt|Opts], Warnings) -> ordsets:add_element(?WARN_CONTRACT_MISSING_RETURN, Warnings); no_missing_return -> ordsets:del_element(?WARN_CONTRACT_MISSING_RETURN, Warnings); + opaque_union -> + ordsets:add_element(?WARN_OPAQUE_UNION, Warnings); + no_opaque_union -> + ordsets:del_element(?WARN_OPAQUE_UNION, Warnings); unknown -> ordsets:add_element(?WARN_UNKNOWN, Warnings); overlapping_contract -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 76396a5446a1..f4ebe6560c20 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -125,27 +125,25 @@ find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) -> FilteredFunTypes = sofs:to_external(sofs:restriction(BinRel, Set)), FunMFAContracts = get_contracts(FilteredFunTypes, Callgraph, Codeserver), - ModOpaques = get_module_opaques(FunMFAContracts, Codeserver), - DecoratedFunTypes = decorate_succ_typings(FunMFAContracts, ModOpaques), %% Check contracts Contracts = orddict:from_list([{MFA, Contract} || {_, {MFA, Contract}} <- FunMFAContracts]), PltContracts = dialyzer_contracts:check_contracts(Contracts, Callgraph, - DecoratedFunTypes, - ModOpaques), - debug_pp_functions("SCC", FilteredFunTypes, DecoratedFunTypes, Callgraph), + FilteredFunTypes), + NewPltContracts = [MC || {MFA, _C}=MC <- PltContracts, %% Check the non-deleted PLT not dialyzer_plt:is_contract(Plt, MFA)], - _ = insert_into_plt(DecoratedFunTypes, Callgraph, Plt), + + _ = insert_into_plt(FilteredFunTypes, Callgraph, Plt), _ = dialyzer_plt:insert_contract_list(Plt, NewPltContracts), %% Check whether we have reached a fixpoint. case NewPltContracts =:= [] andalso - reached_fixpoint_strict(PropTypes, DecoratedFunTypes) of + reached_fixpoint_strict(PropTypes, FilteredFunTypes) of true -> []; false -> ?debug("Not fixpoint for: ~tw\n", [AllFuns]), @@ -162,12 +160,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> NewFunTypes = dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records), - FunMFAContracts = get_contracts(NewFunTypes, Callgraph, CodeServer), - ModOpaques = get_module_opaques(FunMFAContracts, CodeServer), - DecoratedFunTypes = decorate_succ_typings(FunMFAContracts, ModOpaques), - debug_pp_functions("Refine", NewFunTypes, DecoratedFunTypes, Callgraph), - - case updated_types(FunTypes, DecoratedFunTypes) of + case updated_types(FunTypes, NewFunTypes) of [] -> []; [_|_]=NotFixpoint -> ?debug("Not fixpoint\n", []), @@ -381,31 +374,6 @@ get_contracts(FunTypes, Callgraph, Codeserver) -> end, lists:foldl(F, [], FunTypes). -get_module_opaques(Contracts, Codeserver) -> - OpaqueModules = ordsets:from_list([M || {_LabelType, {{M, _, _}, _Con}} <- Contracts]), - [{M, lookup_opaques(M, Codeserver)} || M <- OpaqueModules]. - -decorate_succ_typings(FunTypesContracts, ModOpaques) -> - F = fun({{Label, Type}, {{M, _, _}, Contract}}, Acc) -> - case lists:keyfind(M, 1, ModOpaques) of - {M, []} -> - [{Label, Type}|Acc]; - {M, Opaques} -> - Args = dialyzer_contracts:get_contract_args(Contract), - Ret = dialyzer_contracts:get_contract_return(Contract), - C = erl_types:t_fun(Args, Ret), - R = erl_types:t_decorate_with_opaque(Type, C, Opaques), - [{Label, R}|Acc] - end; - ({LabelType, no}, Acc) -> - [LabelType|Acc] - end, - orddict:from_list(lists:foldl(F, [], FunTypesContracts)). - -lookup_opaques(Module, Codeserver) -> - Records = dialyzer_codeserver:lookup_mod_records(Module, Codeserver), - erl_types:t_opaque_from_records(Records). - get_fun_types_from_plt(FunList, Callgraph, Plt) -> get_fun_types_from_plt(FunList, Callgraph, Plt, []). @@ -475,26 +443,7 @@ debug_pp_succ_typings(SuccTypes) -> || {MFA, {contract, RetFun, ArgT}} <- SuccTypes], ?debug("\n", []), ok. - -debug_pp_functions(Header, FTypes, DTypes, Callgraph) -> - ?debug("FunTypes (~s)\n", [Header]), - Fun = fun({{Label, Type},{Label, DecoratedType}}) -> - Name = lookup_name(Label, Callgraph), - ?debug("~tw (~w): ~ts\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: ~ts\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. diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 1a4853cb239b..da809051b399 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2267,8 +2267,7 @@ solve_subtype(Type, Inf, Map) -> %% Similar to enter_type/3 over a list, but refines known types rather than %% replaces them. refine_bindings([{Key, Val} | Tail], Map, U0) -> - ?debug("Unifying ~ts :: ~ts\n", - [format_type(t_var(Key)), format_type(Val)]), + ?debug("Unifying ~p :: ~ts\n", [Key, format_type(Val)]), %% It's important to keep opaque types whose internal structure is any(), %% hence the equality check on t_any() rather than t_is_any/1. case t_is_equal(Val, t_any()) of @@ -3168,7 +3167,7 @@ pp_constrs_scc(SCC, State) -> [pp_constrs(Fun, state__get_cs(Fun, State), State) || Fun <- SCC]. pp_constrs(Fun, Cs, State) -> - io:format("Constraints for fun: ~tw", [debug_lookup_name(Fun)]), + io:format("Constraints for fun: ~tw~n", [debug_lookup_name(Fun)]), MaxDepth = pp_constraints(Cs, State), io:format("Depth: ~w\n", [MaxDepth]). diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 3868851b0a75..ed6edeafdb37 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -176,7 +176,7 @@ get_record_and_type_info([{type, Location, [{{record, Name}, Fields0, []}]} get_record_and_type_info(Left, Module, NewRecDict, File); get_record_and_type_info([{Attr, Location, [{Name, TypeForm}]}|Left], Module, RecDict, File) - when Attr =:= 'type'; Attr =:= 'opaque' -> + when Attr =:= 'type'; Attr =:= 'opaque'; Attr =:= 'nominal' -> FN = {File, Location}, try add_new_type(Attr, Name, TypeForm, [], Module, FN, RecDict) of NewRecDict -> @@ -186,7 +186,7 @@ get_record_and_type_info([{Attr, Location, [{Name, TypeForm}]}|Left], end; get_record_and_type_info([{Attr, Location, [{Name, TypeForm, Args}]}|Left], Module, RecDict, File) - when Attr =:= 'type'; Attr =:= 'opaque' -> + when Attr =:= 'type'; Attr =:= 'opaque'; Attr =:= 'nominal' -> FN = {File, Location}, try add_new_type(Attr, Name, TypeForm, Args, Module, FN, RecDict) of NewRecDict -> @@ -375,6 +375,8 @@ process_opaque_types(AllModules, CServer, TempExpTypes) -> {{Key, {F, Type}}, C3}; {type, _Name, _NArgs} -> {{Key, Value}, C2}; + {nominal, _Name, _NArgs} -> + {{Key, Value}, C2}; {record, _RecName} -> {{Key, Value}, C2} end diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 1fd948336755..a5e925961c06 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -72,6 +72,7 @@ run(#state{coordinator = Coordinator, job = Job} = State) -> ?debug("~w: Done: ~p\n",[self(), Job]), dialyzer_coordinator:job_done(Job, Result, Coordinator). +-dialyzer({no_opaque_union, [run_job/1]}). run_job(#state{mode = Mode, job = Job, init_data = InitData} = State) -> ?debug("~w: ~p: ~p\n", [self(), Mode, Job]), StartableJob = dialyzer_coordinator:get_job_input(Mode, Job), diff --git a/lib/dialyzer/src/erl_bif_types.erl b/lib/dialyzer/src/erl_bif_types.erl index 37d9dcec8908..7cfd1c014d7d 100644 --- a/lib/dialyzer/src/erl_bif_types.erl +++ b/lib/dialyzer/src/erl_bif_types.erl @@ -23,17 +23,17 @@ -moduledoc false. -define(BITS, 128). %This is only in bsl to convert answer to pos_inf/neg_inf. --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, infinity_add/2]). --import(erl_types, [number_max/2, - number_min/2, +-import(erl_types, [number_max/1, + number_min/1, t_any/0, t_arity/0, t_atom/0, t_atom/1, t_atoms/1, - t_atom_vals/2, + t_atom_vals/1, t_binary/0, t_bitstr/0, t_boolean/0, @@ -49,11 +49,10 @@ t_from_term/1, t_fun/0, t_fun/2, - t_fun_args/2, - t_fun_range/2, + t_fun_args/1, + t_fun_range/1, t_identifier/0, - t_has_opaque_subtype/2, - t_inf/3, + t_inf/2, t_integer/0, t_integer/1, t_non_neg_fixnum/0, @@ -61,28 +60,28 @@ t_pos_integer/0, t_integers/1, t_is_any/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_atom/1, + t_is_binary/1, + t_is_bitstr/1, + t_is_boolean/1, + t_is_cons/1, + t_is_float/1, + t_is_fun/1, t_is_impossible/1, - t_is_integer/2, - t_is_nil/1, t_is_nil/2, + t_is_integer/1, + t_is_nil/1, t_is_none/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_number/1, + t_is_pid/1, + t_is_port/1, + t_is_maybe_improper_list/1, + t_is_reference/1, t_is_subtype/2, - t_is_tuple/2, + t_is_tuple/1, t_list/0, t_list/1, - t_list_elements/2, - t_list_termination/2, + t_list_elements/1, + t_list_termination/1, t_module/0, t_nil/0, t_node/0, @@ -90,7 +89,7 @@ t_nonempty_list/0, t_nonempty_list/1, t_number/0, - t_number_vals/2, + t_number_vals/1, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -101,21 +100,22 @@ t_sup/2, t_tuple/0, t_tuple/1, - t_tuple_args/2, - t_tuple_size/2, - t_tuple_subtypes/2, - t_is_map/2, + t_tuple_args/1, + t_tuple_size/1, + t_tuple_subtypes/1, + t_is_map/1, t_map/0, t_map/3, - t_map_def_key/2, - t_map_def_val/2, - t_map_get/3, - t_map_is_key/3, - t_map_entries/2, - t_map_put/3, - t_map_remove/3, - t_map_update/3, - t_map_pairwise_merge/4 + t_map_def_key/1, + t_map_def_val/1, + t_map_get/2, + t_map_is_key/2, + t_map_entries/1, + t_map_put/2, + t_map_remove/2, + t_map_update/2, + t_map_pairwise_merge/3, + t_inf_lists/2 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -127,62 +127,52 @@ -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() :: erl_types:opaques(). - --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, error, 3, _, _) -> t_none(); -type(erlang, throw, 1, _, _) -> t_none(); -type(erlang, '==', 2, Xs = [X1, X2], Opaques) -> +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, error, 3, _) -> t_none(); +type(erlang, throw, 1, _) -> t_none(); +type(erlang, '==', 2, Xs = [X1, X2]) -> case - t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=:=', 2, Xs, Opaques); + true -> type(erlang, '=:=', 2, Xs); false -> - case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of - true -> type(erlang, '=:=', 2, Xs, Opaques); + case t_is_integer(X1) andalso t_is_integer(X2) of + true -> type(erlang, '=:=', 2, Xs); false -> strict2(Xs, t_boolean()) end end; -type(erlang, '/=', 2, Xs = [X1, X2], Opaques) -> +type(erlang, '/=', 2, Xs = [X1, X2]) -> case - t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=/=', 2, Xs, Opaques); + true -> type(erlang, '=/=', 2, Xs); false -> - case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of - true -> type(erlang, '=/=', 2, Xs, Opaques); + case t_is_integer(X1) andalso t_is_integer(X2) of + true -> type(erlang, '=/=', 2, Xs); false -> strict2(Xs, t_boolean()) end end; -type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_none(t_inf(Lhs, Rhs, Opaques)) of + case t_is_none(t_inf(Lhs, Rhs)) of true -> t_atom('false'); false -> - case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of + case t_is_atom(Lhs) andalso t_is_atom(Rhs) of true -> - case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of + case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[X], [X]} -> t_atom('true'); @@ -195,19 +185,19 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) -> end; false -> case - t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + t_is_integer(Lhs) andalso t_is_integer(Rhs) of false -> t_boolean(); true -> case - {t_number_vals(Lhs, Opaques), t_number_vals(Rhs, Opaques)} + {t_number_vals(Lhs), t_number_vals(Rhs)} of {[X], [X]} when is_integer(X) -> t_atom('true'); _ -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), @@ -223,14 +213,14 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) -> end end, strict2(Xs, Ans); -type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_none(t_inf(Lhs, Rhs, Opaques)) of + case t_is_none(t_inf(Lhs, Rhs)) of true -> t_atom('true'); false -> - case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of + case t_is_atom(Lhs) andalso t_is_atom(Rhs) of true -> - case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of + case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[Val], [Val]} -> t_atom('false'); @@ -239,14 +229,14 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) -> end; false -> case - t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + t_is_integer(Lhs) andalso t_is_integer(Rhs) of false -> t_boolean(); true -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin) @@ -264,14 +254,14 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) -> end end, strict2(Xs, Ans); -type(erlang, '>', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of + case t_is_integer(Lhs) andalso t_is_integer(Rhs) of true -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), T = t_atom('true'), F = t_atom('false'), if @@ -279,17 +269,17 @@ type(erlang, '>', 2, Xs = [Lhs, Rhs], Opaques) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F; true -> t_boolean() end; - false -> compare('>', Lhs, Rhs, Opaques) + false -> compare('>', Lhs, Rhs) end, strict2(Xs, Ans); -type(erlang, '>=', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of + case t_is_integer(Lhs) andalso t_is_integer(Rhs) of true -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), T = t_atom('true'), F = t_atom('false'), if @@ -297,17 +287,17 @@ type(erlang, '>=', 2, Xs = [Lhs, Rhs], Opaques) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F; true -> t_boolean() end; - false -> compare('>=', Lhs, Rhs, Opaques) + false -> compare('>=', Lhs, Rhs) end, strict2(Xs, Ans); -type(erlang, '<', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of + case t_is_integer(Lhs) andalso t_is_integer(Rhs) of true -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), T = t_atom('true'), F = t_atom('false'), if @@ -315,17 +305,17 @@ type(erlang, '<', 2, Xs = [Lhs, Rhs], Opaques) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F; true -> t_boolean() end; - false -> compare('<', Lhs, Rhs, Opaques) + false -> compare('<', Lhs, Rhs) end, strict2(Xs, Ans); -type(erlang, '=<', 2, Xs = [Lhs, Rhs], Opaques) -> +type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> Ans = - case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of + case t_is_integer(Lhs) andalso t_is_integer(Rhs) of true -> - LhsMax = number_max(Lhs, Opaques), - LhsMin = number_min(Lhs, Opaques), - RhsMax = number_max(Rhs, Opaques), - RhsMin = number_min(Rhs, Opaques), + LhsMax = number_max(Lhs), + LhsMin = number_min(Lhs), + RhsMax = number_max(Rhs), + RhsMin = number_min(Rhs), T = t_atom('true'), F = t_atom('false'), if @@ -333,100 +323,100 @@ type(erlang, '=<', 2, Xs = [Lhs, Rhs], Opaques) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F; true -> t_boolean() end; - false -> compare('=<', Lhs, Rhs, Opaques) + false -> compare('=<', Lhs, Rhs) end, strict2(Xs, Ans); -type(erlang, '+', 1, Xs, Opaques) -> - strict(erlang, '+', 1, Xs, fun ([X]) -> X end, Opaques); -type(erlang, '-', 1, Xs, Opaques) -> +type(erlang, '+', 1, Xs) -> + strict(erlang, '+', 1, Xs, fun ([X]) -> X end); +type(erlang, '-', 1, Xs) -> strict(erlang, '-', 1, Xs, fun ([X]) -> - case t_is_integer(X, Opaques) of + case t_is_integer(X) of true -> type(erlang, '-', 2, [t_integer(0), X]); false -> X end - end, Opaques); -type(erlang, '!', 2, Xs, Opaques) -> - strict(erlang, '!', 2, Xs, fun ([_, X2]) -> X2 end, Opaques); -type(erlang, '+', 2, Xs, Opaques) -> + end); +type(erlang, '!', 2, Xs) -> + strict(erlang, '!', 2, Xs, fun ([_, X2]) -> X2 end); +type(erlang, '+', 2, Xs) -> strict(erlang, '+', 2, Xs, fun ([X1, X2]) -> - case arith('+', X1, X2, Opaques) of + case arith('+', X1, X2) of {ok, T} -> T; error -> case - t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + t_is_float(X1) orelse t_is_float(X2) of true -> t_float(); false -> t_number() end end - end, Opaques); -type(erlang, '-', 2, Xs, Opaques) -> + end); +type(erlang, '-', 2, Xs) -> strict(erlang, '-', 2, Xs, fun ([X1, X2]) -> - case arith('-', X1, X2, Opaques) of + case arith('-', X1, X2) of {ok, T} -> T; error -> case - t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + t_is_float(X1) orelse t_is_float(X2) of true -> t_float(); false -> t_number() end end - end, Opaques); -type(erlang, '*', 2, Xs, Opaques) -> + end); +type(erlang, '*', 2, Xs) -> strict(erlang, '*', 2, Xs, fun ([X1, X2]) -> - case arith('*', X1, X2, Opaques) of + case arith('*', X1, X2) of {ok, T} -> T; error -> case - t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + t_is_float(X1) orelse t_is_float(X2) of true -> t_float(); false -> t_number() end end - end, Opaques); -type(erlang, '/', 2, Xs, Opaques) -> - strict(erlang, '/', 2, Xs, fun (_) -> t_float() end, Opaques); -type(erlang, 'div', 2, Xs, Opaques) -> + end); +type(erlang, '/', 2, Xs) -> + strict(erlang, '/', 2, Xs, fun (_) -> t_float() end); +type(erlang, 'div', 2, Xs) -> strict(erlang, 'div', 2, Xs, fun ([X1, X2]) -> - case arith('div', X1, X2, Opaques) of + case arith('div', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); -type(erlang, 'rem', 2, Xs, Opaques) -> + end); +type(erlang, 'rem', 2, Xs) -> strict(erlang, 'rem', 2, Xs, fun ([X1, X2]) -> - case arith('rem', X1, X2, Opaques) of + case arith('rem', X1, X2) of error -> t_non_neg_integer(); {ok, T} -> T end - end, Opaques); -type(erlang, '++', 2, Xs, Opaques) -> + end); +type(erlang, '++', 2, Xs) -> strict(erlang, '++', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1, Opaques) of + case t_is_nil(X1) of true -> X2; % even if X2 is not a list false -> - case t_is_nil(X2, Opaques) of + case t_is_nil(X2) of true -> X1; false -> - E1 = t_list_elements(X1, Opaques), - case t_is_cons(X1, Opaques) of + E1 = t_list_elements(X1), + case t_is_cons(X1) of true -> t_cons(E1, X2); false -> t_sup(X2, t_cons(E1, X2)) end end end - end, Opaques); -type(erlang, '--', 2, Xs, Opaques) -> + end); +type(erlang, '--', 2, Xs) -> %% 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, @@ -434,137 +424,137 @@ type(erlang, '--', 2, Xs, Opaques) -> %% possibly be empty even if X1 is nonempty. strict(erlang, '--', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1, Opaques) of + case t_is_nil(X1) of true -> t_nil(); false -> - case t_is_nil(X2, Opaques) of + case t_is_nil(X2) of true -> X1; - false -> t_list(t_list_elements(X1, Opaques)) + false -> t_list(t_list_elements(X1)) end end - 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) -> + end); +type(erlang, 'and', 2, Xs) -> + strict(erlang, 'and', 2, Xs, fun (_) -> t_boolean() end); +type(erlang, 'or', 2, Xs) -> + strict(erlang, 'or', 2, Xs, fun (_) -> t_boolean() end); +type(erlang, 'xor', 2, Xs) -> + strict(erlang, 'xor', 2, Xs, fun (_) -> t_boolean() end); +type(erlang, 'not', 1, Xs) -> + strict(erlang, 'not', 1, Xs, fun (_) -> t_boolean() end); +type(erlang, 'band', 2, Xs) -> strict(erlang, 'band', 2, Xs, fun ([X1, X2]) -> - case arith('band', X1, X2, Opaques) of + case arith('band', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% The result is not wider than the smallest argument. We need to %% kill any value-sets in the result. %% 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) -> +%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2), t_byte()) end); +type(erlang, 'bor', 2, Xs) -> strict(erlang, 'bor', 2, Xs, fun ([X1, X2]) -> - case arith('bor', X1, X2, Opaques) of + case arith('bor', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. %% strict(erlang, 'bor', 2, Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); -type(erlang, 'bxor', 2, Xs, Opaques) -> +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); +type(erlang, 'bxor', 2, Xs) -> strict(erlang, 'bxor', 2, Xs, fun ([X1, X2]) -> - case arith('bxor', X1, X2, Opaques) of + case arith('bxor', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. %% strict(erlang, 'bxor', 2, Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); -type(erlang, 'bsr', 2, Xs, Opaques) -> +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); +type(erlang, 'bsr', 2, Xs) -> strict(erlang, 'bsr', 2, Xs, fun ([X1, X2]) -> - case arith('bsr', X1, X2, Opaques) of + case arith('bsr', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% 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(erlang, 'bsr', 2, Xs, -%% fun ([X, _]) -> t_sup(X, t_byte()) end, Opaques); -type(erlang, 'bsl', 2, Xs, Opaques) -> +%% fun ([X, _]) -> t_sup(X, t_byte()) end); +type(erlang, 'bsl', 2, Xs) -> strict(erlang, 'bsl', 2, Xs, fun ([X1, X2]) -> - case arith('bsl', X1, X2, Opaques) of + case arith('bsl', X1, X2) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% Not worth doing anything special here. -%% strict(erlang, 'bsl', 2, Xs, fun (_) -> t_integer() end, Opaques); -type(erlang, 'bnot', 1, Xs, Opaques) -> +%% strict(erlang, 'bsl', 2, Xs, fun (_) -> t_integer() end); +type(erlang, 'bnot', 1, Xs) -> strict(erlang, 'bnot', 1, Xs, fun ([X1]) -> - case arith_bnot(X1, Opaques) of + case arith_bnot(X1) of error -> t_integer(); {ok, T} -> T end - end, Opaques); + end); %% Guard bif, needs to be here. -type(erlang, abs, 1, Xs, Opaques) -> +type(erlang, abs, 1, Xs) -> strict(erlang, abs, 1, Xs, - fun ([X1]) -> arith_abs(X1, Opaques) end, Opaques); + fun ([X1]) -> arith_abs(X1) end); %% This returns (-X)-1, so it often gives a negative result. -%% 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) -> +%% strict(erlang, 'bnot', 1, Xs, fun (_) -> t_integer() end); +type(erlang, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias +type(erlang, apply, 2, Xs) -> Fun = fun ([X, _Y]) -> - case t_is_fun(X, Opaques) of + case t_is_fun(X) of true -> - t_fun_range(X, Opaques); + t_fun_range(X); false -> t_any() end end, - strict(erlang, apply, 2, Xs, Fun, Opaques); -type(erlang, apply, 3, Xs, Opaques) -> - strict(erlang, apply, 3, Xs, fun (_) -> t_any() end, Opaques); + strict(erlang, apply, 2, Xs, Fun); +type(erlang, apply, 3, Xs) -> + strict(erlang, apply, 3, Xs, fun (_) -> t_any() end); %% Guard bif, needs to be here. -type(erlang, binary_part, 2, Xs, Opaques) -> - strict(erlang, binary_part, 2, Xs, fun (_) -> t_binary() end, Opaques); +type(erlang, binary_part, 2, Xs) -> + strict(erlang, binary_part, 2, Xs, fun (_) -> t_binary() end); %% Guard bif, needs to be here. -type(erlang, binary_part, 3, Xs, Opaques) -> - strict(erlang, binary_part, 3, Xs, fun (_) -> t_binary() end, Opaques); +type(erlang, binary_part, 3, Xs) -> + strict(erlang, binary_part, 3, Xs, fun (_) -> t_binary() end); %% Guard bif, needs to be here. -type(erlang, bit_size, 1, Xs, Opaques) -> +type(erlang, bit_size, 1, Xs) -> strict(erlang, bit_size, 1, Xs, - fun (_) -> t_non_neg_integer() end, Opaques); + fun (_) -> t_non_neg_integer() end); %% Guard bif, needs to be here. -type(erlang, byte_size, 1, Xs, Opaques) -> +type(erlang, byte_size, 1, Xs) -> strict(erlang, byte_size, 1, Xs, - fun (_) -> t_non_neg_integer() end, Opaques); + fun (_) -> t_non_neg_integer() end); %% Guard bif, needs to be here. -type(erlang, ceil, 1, Xs, Opaques) -> - strict(erlang, ceil, 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, ceil, 1, Xs) -> + strict(erlang, ceil, 1, Xs, fun (_) -> t_integer() end); %% Guard bif, needs to be here. %% Also much more expressive than anything you could write in a spec... -type(erlang, element, 2, Xs, Opaques) -> +type(erlang, element, 2, Xs) -> strict(erlang, element, 2, Xs, fun ([X1, X2]) -> - case t_tuple_subtypes(X2, Opaques) of + case t_tuple_subtypes(X2) of unknown -> t_any(); [_] -> - Sz = t_tuple_size(X2, Opaques), - As = t_tuple_args(X2, Opaques), - case t_number_vals(X1, Opaques) of + Sz = t_tuple_size(X2), + As = t_tuple_args(X2), + case t_number_vals(X1) of unknown -> t_sup(As); Ns when is_list(Ns) -> Fun = fun @@ -578,15 +568,15 @@ type(erlang, element, 2, Xs, Opaques) -> Ts when is_list(Ts) -> t_sup([type(erlang, element, 2, [X1, Y]) || Y <- Ts]) end - end, Opaques); + end); %% Guard bif, needs to be here. -type(erlang, float, 1, Xs, Opaques) -> - strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques); +type(erlang, float, 1, Xs) -> + strict(erlang, float, 1, Xs, fun (_) -> t_float() end); %% Guard bif, needs to be here. -type(erlang, floor, 1, Xs, Opaques) -> - strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, floor, 1, Xs) -> + strict(erlang, floor, 1, Xs, fun (_) -> t_integer() end); %% Primop, needs to be somewhere. -type(erlang, build_stacktrace, 0, _, _Opaques) -> +type(erlang, build_stacktrace, 0, _) -> t_list(t_tuple([t_module(), t_atom(), t_sup([t_arity(),t_list()]), @@ -594,156 +584,144 @@ type(erlang, build_stacktrace, 0, _, _Opaques) -> t_tuple([t_atom('file'),t_string()]), t_tuple([t_atom('line'),t_pos_integer()])]))])); %% Guard bif, needs to be here. -type(erlang, hd, 1, Xs, Opaques) -> - strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques); -type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias +type(erlang, hd, 1, Xs) -> + strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end); +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, Opaques) -> +type(erlang, is_atom, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_atom(Y, Opaques) end, - t_atom(), Opaques) + check_guard(X, fun (Y) -> t_is_atom(Y) end, + t_atom()) end, - strict(erlang, is_atom, 1, Xs, Fun, Opaques); -type(erlang, is_binary, 1, Xs, Opaques) -> + strict(erlang, is_atom, 1, Xs, Fun); +type(erlang, is_binary, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_binary(Y, Opaques) end, - t_binary(), Opaques) + check_guard(X, fun (Y) -> t_is_binary(Y) end, + t_binary()) end, - strict(erlang, is_binary, 1, Xs, Fun, Opaques); -type(erlang, is_bitstring, 1, Xs, Opaques) -> + strict(erlang, is_binary, 1, Xs, Fun); +type(erlang, is_bitstring, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_bitstr(Y, Opaques) end, - t_bitstr(), Opaques) + check_guard(X, fun (Y) -> t_is_bitstr(Y) end, + t_bitstr()) end, - strict(erlang, is_bitstring, 1, Xs, Fun, Opaques); -type(erlang, is_boolean, 1, Xs, Opaques) -> + strict(erlang, is_bitstring, 1, Xs, Fun); +type(erlang, is_boolean, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_boolean(Y, Opaques) end, - t_boolean(), Opaques) + check_guard(X, fun (Y) -> t_is_boolean(Y) end, + t_boolean()) end, - strict(erlang, is_boolean, 1, Xs, Fun, Opaques); -type(erlang, is_float, 1, Xs, Opaques) -> + strict(erlang, is_boolean, 1, Xs, Fun); +type(erlang, is_float, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_float(Y, Opaques) end, - t_float(), Opaques) + check_guard(X, fun (Y) -> t_is_float(Y) end, + t_float()) end, - strict(erlang, is_float, 1, Xs, Fun, Opaques); -type(erlang, is_function, 1, Xs, Opaques) -> + strict(erlang, is_float, 1, Xs, Fun); +type(erlang, is_function, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_fun(Y, Opaques) end, - t_fun(), Opaques) + check_guard(X, fun (Y) -> t_is_fun(Y) end, + t_fun()) end, - strict(erlang, is_function, 1, Xs, Fun, Opaques); -type(erlang, is_function, 2, Xs, Opaques) -> + strict(erlang, is_function, 1, Xs, Fun); +type(erlang, is_function, 2, Xs) -> Fun = fun ([FunType, ArityType]) -> - case t_number_vals(ArityType, Opaques) of + case t_number_vals(ArityType) 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, Opaques); + check_guard_single(FunType, Fun2, FunConstr); IntList when is_list(IntList) -> t_boolean() %% true? end end, - strict(erlang, is_function, 2, Xs, Fun, Opaques); -type(erlang, is_integer, 1, Xs, Opaques) -> + strict(erlang, is_function, 2, Xs, Fun); +type(erlang, is_integer, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_integer(Y, Opaques) end, - t_integer(), Opaques) + check_guard(X, fun (Y) -> t_is_integer(Y) end, + t_integer()) end, - strict(erlang, is_integer, 1, Xs, Fun, Opaques); -type(erlang, is_list, 1, Xs, Opaques) -> + strict(erlang, is_integer, 1, Xs, Fun); +type(erlang, is_list, 1, Xs) -> Fun = fun (X) -> - Fun2 = fun (Y) -> t_is_maybe_improper_list(Y, Opaques) end, - check_guard(X, Fun2, t_maybe_improper_list(), Opaques) + Fun2 = fun (Y) -> t_is_maybe_improper_list(Y) end, + check_guard(X, Fun2, t_maybe_improper_list()) end, - strict(erlang, is_list, 1, Xs, Fun, Opaques); -type(erlang, is_map, 1, Xs, Opaques) -> + strict(erlang, is_list, 1, Xs, Fun); +type(erlang, is_map, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end, - t_map(), Opaques) end, - strict(erlang, is_map, 1, Xs, Fun, Opaques); -type(erlang, is_map_key, 2, Xs, Opaques) -> - type(maps, is_key, 2, Xs, Opaques); -type(erlang, is_number, 1, Xs, Opaques) -> + check_guard(X, fun (Y) -> t_is_map(Y) end, + t_map()) end, + strict(erlang, is_map, 1, Xs, Fun); +type(erlang, is_map_key, 2, Xs) -> + type(maps, is_key, 2, Xs); +type(erlang, is_number, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, - t_number(), Opaques) + check_guard(X, fun (Y) -> t_is_number(Y) end, + t_number()) end, - strict(erlang, is_number, 1, Xs, Fun, Opaques); -type(erlang, is_pid, 1, Xs, Opaques) -> + strict(erlang, is_number, 1, Xs, Fun); +type(erlang, is_pid, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_pid(Y, Opaques) end, - t_pid(), Opaques) + check_guard(X, fun (Y) -> t_is_pid(Y) end, + t_pid()) end, - strict(erlang, is_pid, 1, Xs, Fun, Opaques); -type(erlang, is_port, 1, Xs, Opaques) -> + strict(erlang, is_pid, 1, Xs, Fun); +type(erlang, is_port, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_port(Y, Opaques) end, - t_port(), Opaques) + check_guard(X, fun (Y) -> t_is_port(Y) end, + t_port()) end, - strict(erlang, is_port, 1, Xs, Fun, Opaques); -type(erlang, is_record, 2, Xs, Opaques) -> + strict(erlang, is_port, 1, Xs, Fun); +type(erlang, is_record, 2, Xs) -> Fun = fun ([X, Y]) -> - case t_is_tuple(X, Opaques) of + case t_is_tuple(X) of 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; + case t_is_none(t_inf(t_tuple(), X)) of + true -> t_atom('false'); false -> t_boolean() end; true -> - case t_tuple_subtypes(X, Opaques) of + case t_tuple_subtypes(X) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple, Opaques) of + case t_tuple_args(Tuple) of %% any -> t_boolean(); - [Tag|_] -> check_record_tag(Tag, Y, Opaques) + [Tag|_] -> check_record_tag(Tag, Y) end; List when length(List) >= 2 -> t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List]) end end end, - strict(erlang, is_record, 2, Xs, Fun, Opaques); -type(erlang, is_record, 3, Xs, Opaques) -> + strict(erlang, is_record, 2, Xs, Fun); +type(erlang, is_record, 3, Xs) -> Fun = fun ([X, Y, Z]) -> - Arity = t_number_vals(Z, Opaques), - case t_is_tuple(X, Opaques) of + Arity = t_number_vals(Z), + case t_is_tuple(X) of false when length(Arity) =:= 1 -> [RealArity] = Arity, - 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; + case t_is_none(t_inf(t_tuple(RealArity), X)) of + true -> t_atom('false'); false -> t_boolean() end; 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; + case t_is_none(t_inf(t_tuple(), X)) of + true -> t_atom('false'); false -> t_boolean() end; true when length(Arity) =:= 1 -> [RealArity] = Arity, - case t_tuple_subtypes(X, Opaques) of + case t_tuple_subtypes(X) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple, Opaques) of + case t_tuple_args(Tuple) of %% any -> t_boolean(); Args when length(Args) =:= RealArity -> - check_record_tag(hd(Args), Y, Opaques); + check_record_tag(hd(Args), Y); Args when length(Args) =/= RealArity -> t_atom('false') end; @@ -754,36 +732,34 @@ type(erlang, is_record, 3, Xs, Opaques) -> t_boolean() end end, - strict(erlang, is_record, 3, Xs, Fun, Opaques); -type(erlang, is_reference, 1, Xs, Opaques) -> + strict(erlang, is_record, 3, Xs, Fun); +type(erlang, is_reference, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_reference(Y, Opaques) end, - t_reference(), Opaques) + check_guard(X, fun (Y) -> t_is_reference(Y) end, + t_reference()) end, - strict(erlang, is_reference, 1, Xs, Fun, Opaques); -type(erlang, is_tuple, 1, Xs, Opaques) -> + strict(erlang, is_reference, 1, Xs, Fun); +type(erlang, is_tuple, 1, Xs) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_tuple(Y, Opaques) end, - t_tuple(), Opaques) + check_guard(X, fun (Y) -> t_is_tuple(Y) end, + t_tuple()) end, - strict(erlang, is_tuple, 1, Xs, Fun, Opaques); + strict(erlang, is_tuple, 1, Xs, Fun); %% Guard bif, needs to be here. -type(erlang, length, 1, Xs, Opaques) -> - strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); +type(erlang, length, 1, Xs) -> + strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end); %% Guard bif, needs to be here. -type(erlang, map_size, 1, Xs, Opaques) -> - type(maps, size, 1, Xs, Opaques); -type(erlang, max, 2, Xs, Opaques) -> - strict(erlang, max, 2, Xs, - fun([A, B]) -> t_sup(A, B) end, - Opaques); +type(erlang, map_size, 1, Xs) -> + type(maps, size, 1, Xs); +type(erlang, max, 2, Xs) -> + strict(erlang, max, 2, Xs, fun([A, B]) -> t_sup(A, B) end); %% Guard bif, needs to be here. -type(erlang, map_get, 2, Xs, Opaques) -> - type(maps, get, 2, Xs, Opaques); -type(erlang, make_fun, 3, Xs, Opaques) -> +type(erlang, map_get, 2, Xs) -> + type(maps, get, 2, Xs); +type(erlang, make_fun, 3, Xs) -> strict(erlang, make_fun, 3, Xs, fun ([_, _, Arity]) -> - case t_number_vals(Arity, Opaques) of + case t_number_vals(Arity) of [N] -> case is_integer(N) andalso 0 =< N andalso N =< 255 of true -> t_fun(N, t_any()); @@ -791,58 +767,56 @@ type(erlang, make_fun, 3, Xs, Opaques) -> end; _Other -> t_fun() end - end, Opaques); -type(erlang, make_tuple, 2, Xs, Opaques) -> + end); +type(erlang, make_tuple, 2, Xs) -> strict(erlang, make_tuple, 2, Xs, fun ([Int, _]) -> - case t_number_vals(Int, Opaques) of + case t_number_vals(Int) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end, Opaques); -type(erlang, make_tuple, 3, Xs, Opaques) -> + end); +type(erlang, make_tuple, 3, Xs) -> strict(erlang, make_tuple, 3, Xs, fun ([Int, _, _]) -> - case t_number_vals(Int, Opaques) of + case t_number_vals(Int) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end, Opaques); -type(erlang, min, 2, Xs, Opaques) -> - strict(erlang, min, 2, Xs, - fun([A, B]) -> t_sup(A, B) end, - Opaques); -type(erlang, nif_error, 1, Xs, Opaques) -> + end); +type(erlang, min, 2, Xs) -> + strict(erlang, min, 2, Xs, fun([A, B]) -> t_sup(A, B) end); +type(erlang, nif_error, 1, Xs) -> %% 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); + strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end); +type(erlang, nif_error, 2, Xs) -> + strict(erlang, nif_error, 2, Xs, fun (_) -> t_any() end); %% Guard bif, needs to be here. -type(erlang, node, 0, _, _Opaques) -> t_node(); +type(erlang, node, 0, _) -> t_node(); %% Guard bif, needs to be here. -type(erlang, node, 1, Xs, Opaques) -> - strict(erlang, node, 1, Xs, fun (_) -> t_node() end, Opaques); -type(erlang, raise, 3, Xs, Opaques) -> +type(erlang, node, 1, Xs) -> + strict(erlang, node, 1, Xs, fun (_) -> t_node() end); +type(erlang, raise, 3, Xs) -> Ts = arg_types(erlang, raise, 3), - Xs1 = inf_lists(Xs, Ts, Opaques), + Xs1 = t_inf_lists(Xs, Ts), case any_is_none_or_unit(Xs1) of true -> t_atom('badarg'); false -> t_none() end; %% Guard bif, needs to be here. -type(erlang, round, 1, Xs, Opaques) -> - strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, round, 1, Xs) -> + strict(erlang, round, 1, Xs, fun (_) -> t_integer() end); %% Guard bif, needs to be here. -type(erlang, self, 0, _, _Opaques) -> t_pid(); -type(erlang, setelement, 3, Xs, Opaques) -> +type(erlang, self, 0, _) -> t_pid(); +type(erlang, setelement, 3, Xs) -> strict(erlang, setelement, 3, Xs, fun ([X1, X2, X3]) -> - case t_tuple_subtypes(X2, Opaques) of + case t_tuple_subtypes(X2) of unknown -> t_tuple(); [_] -> - Sz = t_tuple_size(X2, Opaques), - As = t_tuple_args(X2, Opaques), - case t_number_vals(X1, Opaques) of + Sz = t_tuple_size(X2), + As = t_tuple_args(X2), + case t_number_vals(X1) of unknown -> t_tuple([t_sup(X, X3) || X <- As]); [N] when is_integer(N), 1 =< N, N =< Sz -> @@ -864,17 +838,17 @@ type(erlang, setelement, 3, Xs, Opaques) -> Ts when is_list(Ts) -> t_sup([type(erlang, setelement, 3, [X1, Y, X3]) || Y <- Ts]) end - end, Opaques); + end); %% Guard bif, needs to be here. -type(erlang, size, 1, Xs, Opaques) -> - strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); -type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias -type(erlang, system_info, 1, Xs, Opaques) -> +type(erlang, size, 1, Xs) -> + strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end); +type(erlang, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias +type(erlang, system_info, 1, Xs) -> strict(erlang, system_info, 1, Xs, fun ([Type]) -> - case t_is_atom(Type, Opaques) of + case t_is_atom(Type) of true -> - case t_atom_vals(Type, Opaques) of + case t_atom_vals(Type) of ['allocated_areas'] -> t_list(t_sup([t_tuple([t_atom(),t_non_neg_integer()]), t_tuple([t_atom(), @@ -986,28 +960,28 @@ type(erlang, system_info, 1, Xs, Opaques) -> false -> %% This currently handles only {allocator, Alloc} t_any() %% overapproximation as the return value might change end - end, Opaques); + end); %% Guard bif, needs to be here. -type(erlang, tl, 1, Xs, Opaques) -> - strict(erlang, tl, 1, Xs, fun ([X]) -> t_cons_tl(X) end, Opaques); +type(erlang, tl, 1, Xs) -> + strict(erlang, tl, 1, Xs, fun ([X]) -> t_cons_tl(X) end); %% Guard bif, needs to be here. -type(erlang, trunc, 1, Xs, Opaques) -> - strict(erlang, trunc, 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, trunc, 1, Xs) -> + strict(erlang, trunc, 1, Xs, fun (_) -> t_integer() end); %% Guard bif, needs to be here. -type(erlang, tuple_size, 1, Xs, Opaques) -> +type(erlang, tuple_size, 1, Xs) -> strict(erlang, tuple_size, 1, Xs, - fun (_) -> t_non_neg_integer() end, Opaques); -type(erlang, tuple_to_list, 1, Xs, Opaques) -> + fun (_) -> t_non_neg_integer() end); +type(erlang, tuple_to_list, 1, Xs) -> strict(erlang, tuple_to_list, 1, Xs, fun ([X]) -> - case t_tuple_subtypes(X, Opaques) of + case t_tuple_subtypes(X) of unknown -> t_list(); SubTypes -> - Args = lists:append([t_tuple_args(ST, Opaques) || + Args = lists:append([t_tuple_args(ST) || ST <- SubTypes]), %% Can be nil if the tuple can be {} case lists:any(fun (T) -> - t_tuple_size(T, Opaques) =:= 0 + t_tuple_size(T) =:= 0 end, SubTypes) of true -> %% Be careful here. If we had only {} we need to @@ -1017,105 +991,105 @@ type(erlang, tuple_to_list, 1, Xs, Opaques) -> t_nonempty_list(t_sup(Args)) end end - end, Opaques); + end); %%-- lists -------------------------------------------------------------------- -type(lists, all, 2, Xs, Opaques) -> +type(lists, all, 2, Xs) -> strict(lists, all, 2, Xs, fun ([F, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_atom('true'); false -> - El = t_list_elements(L, Opaques), - case check_fun_application(F, [El], Opaques) of + El = t_list_elements(L), + case check_fun_application(F, [El]) of ok -> - case t_is_cons(L, Opaques) of - true -> t_fun_range(F, Opaques); + case t_is_cons(L) of + true -> t_fun_range(F); false -> %% The list can be empty. - t_sup(t_atom('true'), t_fun_range(F, Opaques)) + t_sup(t_atom('true'), t_fun_range(F)) end; error -> - case t_is_cons(L, Opaques) of + case t_is_cons(L) of true -> t_none(); - false -> t_fun_range(F, Opaques) + false -> t_fun_range(F) end end end - end, Opaques); -type(lists, any, 2, Xs, Opaques) -> + end); +type(lists, any, 2, Xs) -> strict(lists, any, 2, Xs, fun ([F, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_atom('false'); false -> - El = t_list_elements(L, Opaques), - case check_fun_application(F, [El], Opaques) of + El = t_list_elements(L), + case check_fun_application(F, [El]) of ok -> - case t_is_cons(L, Opaques) of - true -> t_fun_range(F, Opaques); + case t_is_cons(L) of + true -> t_fun_range(F); false -> %% The list can be empty - t_sup(t_atom('false'), t_fun_range(F, Opaques)) + t_sup(t_atom('false'), t_fun_range(F)) end; error -> - case t_is_cons(L, Opaques) of + case t_is_cons(L) of true -> t_none(); - false -> t_fun_range(F, Opaques) + false -> t_fun_range(F) end end end - end, Opaques); -type(lists, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias -type(lists, delete, 2, Xs, Opaques) -> + end); +type(lists, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias +type(lists, delete, 2, Xs) -> strict(lists, delete, 2, Xs, fun ([_, List]) -> - case t_is_cons(List, Opaques) of + case t_is_cons(List) of true -> t_cons_tl(List); false -> List end - end, Opaques); -type(lists, dropwhile, 2, Xs, Opaques) -> + end); +type(lists, dropwhile, 2, Xs) -> strict(lists, dropwhile, 2, Xs, fun ([F, X]) -> - case t_is_nil(X, Opaques) of + case t_is_nil(X) of true -> t_nil(); false -> - X1 = t_list_elements(X, Opaques), - case check_fun_application(F, [X1], Opaques) of + X1 = t_list_elements(X), + case check_fun_application(F, [X1]) of ok -> - case t_atom_vals(t_fun_range(F, Opaques), Opaques) of + case t_atom_vals(t_fun_range(F)) of ['true'] -> - case t_is_none(t_inf(t_list(), X, Opaques)) of + case t_is_none(t_inf(t_list(), X)) of true -> t_none(); false -> t_nil() end; ['false'] -> - case t_is_none(t_inf(t_list(), X, Opaques)) of + case t_is_none(t_inf(t_list(), X)) of true -> t_none(); false -> X end; _ -> - t_inf(t_cons_tl(t_inf(X, t_cons(), Opaques)), - t_maybe_improper_list(), Opaques) + t_inf(t_cons_tl(t_inf(X, t_cons())), + t_maybe_improper_list()) end; error -> - case t_is_cons(X, Opaques) of + case t_is_cons(X) of true -> t_none(); false -> t_nil() end end end - end, Opaques); -type(lists, filter, 2, Xs, Opaques) -> + end); +type(lists, filter, 2, Xs) -> strict(lists, filter, 2, Xs, fun ([F, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_nil(); false -> - T = t_list_elements(L, Opaques), - case check_fun_application(F, [T], Opaques) of + T = t_list_elements(L), + case check_fun_application(F, [T]) of ok -> - RangeVals = t_atom_vals(t_fun_range(F, Opaques), Opaques), + RangeVals = t_atom_vals(t_fun_range(F)), case RangeVals =:= ['false'] of true -> t_nil(); false -> @@ -1125,47 +1099,46 @@ type(lists, filter, 2, Xs, Opaques) -> end end; error -> - case t_is_cons(L, Opaques) of + case t_is_cons(L) of true -> t_none(); false -> t_nil() end end end - end, Opaques); -type(lists, flatten, 1, Xs, Opaques) -> + end); +type(lists, flatten, 1, Xs) -> strict(lists, flatten, 1, Xs, fun ([L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> L; % (nil has undefined elements) false -> %% Avoiding infinite recursion is tricky - X1 = t_list_elements(L, Opaques), + X1 = t_list_elements(L), case t_is_any(X1) of true -> t_list(); false -> - X2 = type(lists, flatten, 1, [t_inf(X1, t_list(), Opaques)]), + X2 = type(lists, flatten, 1, [t_inf(X1, t_list())]), t_sup(t_list(t_subtract(X1, t_list())), X2) end end - end, Opaques); -type(lists, flatmap, 2, Xs, Opaques) -> + end); +type(lists, flatmap, 2, Xs) -> strict(lists, flatmap, 2, Xs, fun ([F, List]) -> - case t_is_nil(List, Opaques) of + case t_is_nil(List) of true -> t_nil(); false -> case - check_fun_application(F, [t_list_elements(List, Opaques)], - Opaques) + check_fun_application(F, [t_list_elements(List)]) of ok -> - R = t_fun_range(F, Opaques), + R = t_fun_range(F), case t_is_nil(R) of true -> t_nil(); false -> - Elems = t_list_elements(R, Opaques), - case t_is_cons(List, Opaques) of + Elems = t_list_elements(R), + case t_is_cons(List) of true -> case t_is_subtype(t_nil(), R) of true -> t_list(Elems); @@ -1175,21 +1148,20 @@ type(lists, flatmap, 2, Xs, Opaques) -> end end; error -> - case t_is_cons(List, Opaques) of + case t_is_cons(List) of true -> t_none(); false -> t_nil() end end end - end, Opaques); -type(lists, foreach, 2, Xs, Opaques) -> + end); +type(lists, foreach, 2, Xs) -> strict(lists, foreach, 2, Xs, fun ([F, List]) -> - case t_is_cons(List, Opaques) of + case t_is_cons(List) of true -> case - check_fun_application(F, [t_list_elements(List, Opaques)], - Opaques) + check_fun_application(F, [t_list_elements(List)]) of ok -> t_atom('ok'); error -> t_none() @@ -1197,43 +1169,42 @@ type(lists, foreach, 2, Xs, Opaques) -> false -> t_atom('ok') end - end, Opaques); -type(lists, foldl, 3, Xs, Opaques) -> + end); +type(lists, foldl, 3, Xs) -> strict(lists, foldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List, Opaques) of + case t_is_nil(List) of true -> Acc; false -> case check_fun_application(F, - [t_list_elements(List, Opaques),Acc], - Opaques) + [t_list_elements(List),Acc]) of ok -> - case t_is_cons(List, Opaques) of - true -> t_fun_range(F, Opaques); - false -> t_sup(t_fun_range(F, Opaques), Acc) + case t_is_cons(List) of + true -> t_fun_range(F); + false -> t_sup(t_fun_range(F), Acc) end; error -> - case t_is_cons(List, Opaques) of + case t_is_cons(List) of true -> t_none(); false -> Acc end end end - end, Opaques); -type(lists, foldr, 3, Xs, _Opaques) -> type(lists, foldl, 3, Xs); % same -type(lists, keydelete, 3, Xs, Opaques) -> + end); +type(lists, foldr, 3, Xs) -> type(lists, foldl, 3, Xs); % same +type(lists, keydelete, 3, Xs) -> strict(lists, keydelete, 3, Xs, fun ([_, _, L]) -> - Term = t_list_termination(L, Opaques), - t_sup(Term, erl_types:lift_list_to_pos_empty(L, Opaques)) - end, Opaques); -type(lists, keyfind, 3, Xs, Opaques) -> + Term = t_list_termination(L), + t_sup(Term, erl_types:lift_list_to_pos_empty(L)) + end); +type(lists, keyfind, 3, Xs) -> strict(lists, keyfind, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z, Opaques), - Tuple = t_inf(t_tuple(), ListEs, Opaques), + ListEs = t_list_elements(Z), + Tuple = t_inf(t_tuple(), ListEs), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1243,61 +1214,61 @@ type(lists, keyfind, 3, Xs, Opaques) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple, Opaques) of + case t_tuple_subtypes(Tuple) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List, Opaques) of + case key_comparisons_fail(X, Y, List) of true -> t_atom('false'); false -> Ret end end end end - end, Opaques); -type(lists, keymap, 3, Xs, Opaques) -> + end); +type(lists, keymap, 3, Xs) -> strict(lists, keymap, 3, Xs, fun ([F, _I, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> L; - false -> t_list(t_sup(t_fun_range(F, Opaques), - t_list_elements(L, Opaques))) + false -> t_list(t_sup(t_fun_range(F), + t_list_elements(L))) end - end, Opaques); -type(lists, keymember, 3, Xs, Opaques) -> + end); +type(lists, keymember, 3, Xs) -> strict(lists, keymember, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z, Opaques), - Tuple = t_inf(t_tuple(), ListEs, Opaques), + ListEs = t_list_elements(Z), + Tuple = t_inf(t_tuple(), ListEs), 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, Opaques) of + case t_tuple_subtypes(Tuple) of unknown -> t_boolean(); List -> - case key_comparisons_fail(X, Y, List, Opaques) of + case key_comparisons_fail(X, Y, List) of true -> t_atom('false'); false -> t_boolean() end end end end - end, Opaques); -type(lists, keymerge, 3, Xs, Opaques) -> + end); +type(lists, keymerge, 3, Xs) -> strict(lists, keymerge, 3, Xs, - fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end, Opaques); -type(lists, keyreplace, 4, Xs, Opaques) -> + fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end); +type(lists, keyreplace, 4, Xs) -> 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) -> + t_list(t_sup(t_list_elements(L), T)) + end); +type(lists, keysearch, 3, Xs) -> strict(lists, keysearch, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z, Opaques), - Tuple = t_inf(t_tuple(), ListEs, Opaques), + ListEs = t_list_elements(Z), + Tuple = t_inf(t_tuple(), ListEs), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1306,92 +1277,92 @@ type(lists, keysearch, 3, Xs, Opaques) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple, Opaques) of + case t_tuple_subtypes(Tuple) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List, Opaques) of + case key_comparisons_fail(X, Y, List) of true -> t_atom('false'); false -> Ret end end end end - end, Opaques); -type(lists, keysort, 2, Xs, Opaques) -> - strict(lists, keysort, 2, Xs, fun ([_, L]) -> L end, Opaques); -type(lists, last, 1, Xs, Opaques) -> + end); +type(lists, keysort, 2, Xs) -> + strict(lists, keysort, 2, Xs, fun ([_, L]) -> L end); +type(lists, last, 1, Xs) -> strict(lists, last, 1, Xs, - fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); -type(lists, map, 2, Xs, Opaques) -> + fun ([L]) -> t_list_elements(L) end); +type(lists, map, 2, Xs) -> strict(lists, map, 2, Xs, fun ([F, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> L; false -> - El = t_list_elements(L, Opaques), - case t_is_cons(L, Opaques) of + El = t_list_elements(L), + case t_is_cons(L) of true -> - case check_fun_application(F, [El], Opaques) of - ok -> t_nonempty_list(t_fun_range(F, Opaques)); + case check_fun_application(F, [El]) of + ok -> t_nonempty_list(t_fun_range(F)); error -> t_none() end; false -> - case check_fun_application(F, [El], Opaques) of - ok -> t_list(t_fun_range(F, Opaques)); + case check_fun_application(F, [El]) of + ok -> t_list(t_fun_range(F)); error -> t_nil() end end end - end, Opaques); -type(lists, mapfoldl, 3, Xs, Opaques) -> + end); +type(lists, mapfoldl, 3, Xs) -> strict(lists, mapfoldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List, Opaques) of + case t_is_nil(List) of true -> t_tuple([List, Acc]); false -> - El = t_list_elements(List, Opaques), - R = t_fun_range(F, Opaques), - case t_is_cons(List, Opaques) of + El = t_list_elements(List), + R = t_fun_range(F), + case t_is_cons(List) of true -> - case check_fun_application(F, [El, Acc], Opaques) of + case check_fun_application(F, [El, Acc]) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple, Opaques), + [T1, T2] = t_tuple_args(RangeTuple), t_tuple([t_nonempty_list(T1), T2]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); error -> t_none() end; false -> - case check_fun_application(F, [El, Acc], Opaques) of + case check_fun_application(F, [El, Acc]) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple, Opaques), + [T1, T2] = t_tuple_args(RangeTuple), t_tuple([t_list(T1), t_sup(Acc, T2)]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); error -> t_tuple([t_nil(), Acc]) end end end - end, Opaques); -type(lists, mapfoldr, 3, Xs, _Opaques) -> type(lists, mapfoldl, 3, Xs); % same -type(lists, max, 1, Xs, Opaques) -> + end); +type(lists, mapfoldr, 3, Xs) -> type(lists, mapfoldl, 3, Xs); % same +type(lists, max, 1, Xs) -> strict(lists, max, 1, Xs, - fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); -type(lists, member, 2, Xs, Opaques) -> + fun ([L]) -> t_list_elements(L) end); +type(lists, member, 2, Xs) -> strict(lists, member, 2, Xs, fun ([X, Y]) -> - Y1 = t_list_elements(Y, Opaques), - case t_is_none(t_inf(Y1, X, Opaques)) of + Y1 = t_list_elements(Y), + case t_is_none(t_inf(Y1, X)) of true -> t_atom('false'); false -> t_boolean() end - end, Opaques); -%% type(lists, merge, 1, Xs, Opaques) -> -type(lists, merge, 2, Xs, Opaques) -> + end); +%% type(lists, merge, 1, Xs) -> +type(lists, merge, 2, Xs) -> strict(lists, merge, 2, Xs, fun ([L1, L2]) -> case t_is_none(L1) of @@ -1402,31 +1373,31 @@ type(lists, merge, 2, Xs, Opaques) -> false -> t_sup(L1, L2) end end - end, Opaques); -type(lists, min, 1, Xs, Opaques) -> + end); +type(lists, min, 1, Xs) -> strict(lists, min, 1, Xs, - fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); -type(lists, nth, 2, Xs, Opaques) -> + fun ([L]) -> t_list_elements(L) end); +type(lists, nth, 2, Xs) -> strict(lists, nth, 2, Xs, - fun ([_, Y]) -> t_list_elements(Y, Opaques) end, Opaques); -type(lists, nthtail, 2, Xs, Opaques) -> + fun ([_, Y]) -> t_list_elements(Y) end); +type(lists, nthtail, 2, Xs) -> strict(lists, nthtail, 2, Xs, - fun ([_, Y]) -> t_sup(Y, t_list()) end, Opaques); -type(lists, partition, 2, Xs, Opaques) -> + fun ([_, Y]) -> t_sup(Y, t_list()) end); +type(lists, partition, 2, Xs) -> strict(lists, partition, 2, Xs, fun ([F, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_tuple([L,L]); false -> - El = t_list_elements(L, Opaques), - case check_fun_application(F, [El], Opaques) of + El = t_list_elements(L), + case check_fun_application(F, [El]) of error -> - case t_is_cons(L, Opaques) of + case t_is_cons(L) of true -> t_none(); false -> t_tuple([t_nil(), t_nil()]) end; ok -> - case t_atom_vals(t_fun_range(F, Opaques), Opaques) of + case t_atom_vals(t_fun_range(F)) of ['true'] -> t_tuple([L, t_nil()]); ['false'] -> t_tuple([t_nil(), L]); [_, _] -> @@ -1435,206 +1406,204 @@ type(lists, partition, 2, Xs, Opaques) -> end end end - end, Opaques); -type(lists, reverse, 1, Xs, Opaques) -> - strict(lists, reverse, 1, Xs, fun ([X]) -> X end, Opaques); -type(lists, reverse, 2, Xs, _Opaques) -> + end); +type(lists, reverse, 1, Xs) -> + strict(lists, reverse, 1, Xs, fun ([X]) -> X end); +type(lists, reverse, 2, Xs) -> type(erlang, '++', 2, Xs); % reverse-onto is just like append -type(lists, sort, 1, Xs, Opaques) -> - strict(lists, sort, 1, Xs, fun ([X]) -> X end, Opaques); -type(lists, sort, 2, Xs, Opaques) -> +type(lists, sort, 1, Xs) -> + strict(lists, sort, 1, Xs, fun ([X]) -> X end); +type(lists, sort, 2, Xs) -> strict(lists, sort, 2, Xs, fun ([F, L]) -> - R = t_fun_range(F, Opaques), - case t_is_boolean(R, Opaques) of + R = t_fun_range(F), + case t_is_boolean(R) of true -> L; false -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_nil(); false -> t_none() end end - end, Opaques); -type(lists, split, 2, Xs, Opaques) -> + end); +type(lists, split, 2, Xs) -> strict(lists, split, 2, Xs, fun ([_, L]) -> - case t_is_nil(L, Opaques) of + case t_is_nil(L) of true -> t_tuple([L, L]); false -> - T = t_list_elements(L, Opaques), + T = t_list_elements(L), t_tuple([t_list(T), t_list(T)]) end - end, Opaques); -type(lists, splitwith, 2, Xs, _Opaques) -> + end); +type(lists, splitwith, 2, Xs) -> 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, _Opaques) -> type(erlang, '--', 2, Xs); % alias -type(lists, takewhile, 2, Xs, Opaques) -> +type(lists, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias +type(lists, takewhile, 2, Xs) -> strict(lists, takewhile, 2, Xs, fun([F, L]) -> - case t_is_none(t_inf(t_list(), L, Opaques)) of + case t_is_none(t_inf(t_list(), L)) of false -> type(lists, filter, 2, Xs); true -> %% This works for non-proper lists as well. - El = t_list_elements(L, Opaques), + El = t_list_elements(L), type(lists, filter, 2, [F, t_list(El)]) end - 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) -> + 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(lists, unzip, 1, Xs, fun ([Ps]) -> - case t_is_nil(Ps, Opaques) of + case t_is_nil(Ps) of true -> t_tuple([t_nil(), t_nil()]); false -> % Ps is a proper list of pairs - TupleTypes = t_tuple_subtypes(t_list_elements(Ps, Opaques), - Opaques), + TupleTypes = t_tuple_subtypes(t_list_elements(Ps)), lists:foldl(fun(Tuple, Acc) -> - [A, B] = t_tuple_args(Tuple, Opaques), + [A, B] = t_tuple_args(Tuple), t_sup(t_tuple([t_list(A), t_list(B)]), Acc) end, t_none(), TupleTypes) end - end, Opaques); -type(lists, unzip3, 1, Xs, Opaques) -> + end); +type(lists, unzip3, 1, Xs) -> strict(lists, unzip3, 1, Xs, fun ([Ts]) -> - case t_is_nil(Ts, Opaques) of + case t_is_nil(Ts) 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, Opaques), - Opaques), + TupleTypes = t_tuple_subtypes(t_list_elements(Ts)), lists:foldl(fun(T, Acc) -> - [A, B, C] = t_tuple_args(T, Opaques), + [A, B, C] = t_tuple_args(T), t_sup(t_tuple([t_list(A), t_list(B), t_list(C)]), Acc) end, t_none(), TupleTypes) end - end, Opaques); -type(lists, zip, 2, Xs, Opaques) -> + end); +type(lists, zip, 2, Xs) -> strict(lists, zip, 2, Xs, fun ([As, Bs]) -> - case (t_is_nil(As, Opaques) orelse t_is_nil(Bs, Opaques)) of + case (t_is_nil(As) orelse t_is_nil(Bs)) of true -> t_nil(); false -> - A = t_list_elements(As, Opaques), - B = t_list_elements(Bs, Opaques), + A = t_list_elements(As), + B = t_list_elements(Bs), t_list(t_tuple([A, B])) end - end, Opaques); -type(lists, zip3, 3, Xs, Opaques) -> + end); +type(lists, zip3, 3, Xs) -> strict(lists, zip3, 3, Xs, fun ([As, Bs, Cs]) -> case - (t_is_nil(As, Opaques) - orelse t_is_nil(Bs, Opaques) - orelse t_is_nil(Cs, Opaques)) + (t_is_nil(As) + orelse t_is_nil(Bs) + orelse t_is_nil(Cs)) of true -> t_nil(); false -> - A = t_list_elements(As, Opaques), - B = t_list_elements(Bs, Opaques), - C = t_list_elements(Cs, Opaques), + A = t_list_elements(As), + B = t_list_elements(Bs), + C = t_list_elements(Cs), t_list(t_tuple([A, B, C])) end - end, Opaques); -type(lists, zipwith, 3, Xs, Opaques) -> + end); +type(lists, zipwith, 3, Xs) -> 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) -> + fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F)), + t_nil()) end); +type(lists, zipwith3, 4, Xs) -> strict(lists, zipwith3, 4, Xs, - fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), - t_nil()) end, Opaques); + fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F)), + t_nil()) end); %%-- maps --------------------------------------------------------------------- -type(maps, from_keys, 2, Xs, Opaques) -> +type(maps, from_keys, 2, Xs) -> strict(maps, from_keys, 2, Xs, fun ([List, Value]) -> - case t_is_nil(List, Opaques) of + case t_is_nil(List) of true -> t_from_term(#{}); - false -> t_map([], t_list_elements(List, Opaques), Value) + false -> t_map([], t_list_elements(List), Value) end - end, Opaques); -type(maps, from_list, 1, Xs, Opaques) -> + end); +type(maps, from_list, 1, Xs) -> strict(maps, from_list, 1, Xs, fun ([List]) -> - case t_is_nil(List, Opaques) of + case t_is_nil(List) of true -> t_from_term(#{}); false -> - T = t_list_elements(List, Opaques), - case t_tuple_subtypes(T, Opaques) of + T = t_list_elements(List), + case t_tuple_subtypes(T) of unknown -> t_map(); Stypes when length(Stypes) >= 1 -> t_sup([begin - [K, V] = t_tuple_args(Args, Opaques), + [K, V] = t_tuple_args(Args), t_map([], K, V) end || Args <- Stypes]) end end - end, Opaques); -type(maps, get, 2, Xs, Opaques) -> + end); +type(maps, get, 2, Xs) -> strict(maps, get, 2, Xs, fun ([Key, Map]) -> - t_map_get(Key, Map, Opaques) - end, Opaques); -type(maps, is_key, 2, Xs, Opaques) -> + t_map_get(Key, Map) + end); +type(maps, is_key, 2, Xs) -> strict(maps, is_key, 2, Xs, fun ([Key, Map]) -> - t_map_is_key(Key, Map, Opaques) - end, Opaques); -type(maps, merge, 2, Xs, Opaques) -> + t_map_is_key(Key, Map) + end); +type(maps, merge, 2, Xs) -> strict(maps, merge, 2, Xs, fun ([MapA, MapB]) -> - ADefK = t_map_def_key(MapA, Opaques), - BDefK = t_map_def_key(MapB, Opaques), - ADefV = t_map_def_val(MapA, Opaques), - BDefV = t_map_def_val(MapB, Opaques), + ADefK = t_map_def_key(MapA), + BDefK = t_map_def_key(MapB), + ADefV = t_map_def_val(MapA), + BDefV = t_map_def_val(MapB), t_map(t_map_pairwise_merge( fun(K, _, _, mandatory, V) -> {K, mandatory, V}; (K, MNess, VA, optional, VB) -> {K, MNess, t_sup(VA,VB)} - end, MapA, MapB, Opaques), + end, MapA, MapB), t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)) - end, Opaques); -type(maps, put, 3, Xs, Opaques) -> + end); +type(maps, put, 3, Xs) -> strict(maps, put, 3, Xs, fun ([Key, Value, Map]) -> - t_map_put({Key, Value}, Map, Opaques) - end, Opaques); -type(maps, remove, 2, Xs, Opaques) -> + t_map_put({Key, Value}, Map) + end); +type(maps, remove, 2, Xs) -> strict(maps, remove, 2, Xs, fun ([Key, Map]) -> - t_map_remove(Key, Map, Opaques) - end, Opaques); -type(maps, size, 1, Xs, Opaques) -> + t_map_remove(Key, Map) + end); +type(maps, size, 1, Xs) -> strict(maps, size, 1, Xs, fun ([Map]) -> - Mand = [E || E={_,mandatory,_} <- t_map_entries(Map, Opaques)], + Mand = [E || E={_,mandatory,_} <- t_map_entries(Map)], LowerBound = length(Mand), - case t_is_none(t_map_def_key(Map, Opaques)) of + case t_is_none(t_map_def_key(Map)) of false -> t_from_range(LowerBound, pos_inf); true -> - Opt = [E || E={_,optional,_} <- t_map_entries(Map, Opaques)], + Opt = [E || E={_,optional,_} <- t_map_entries(Map)], UpperBound = LowerBound + length(Opt), t_from_range(LowerBound, UpperBound) end - end, Opaques); -type(maps, update, 3, Xs, Opaques) -> + end); +type(maps, update, 3, Xs) -> strict(maps, update, 3, Xs, fun ([Key, Value, Map]) -> - t_map_update({Key, Value}, Map, Opaques) - end, Opaques); + t_map_update({Key, Value}, Map) + end); %%----------------------------------------------------------------------------- -type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), +type(M, F, A, Xs) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> strict(Xs, t_any()). % safe approximation for all functions. @@ -1643,11 +1612,9 @@ type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), %% Auxiliary functions %%----------------------------------------------------------------------------- -strict(M, F, A, Xs, Fun, Opaques) -> +strict(M, F, A, Xs, Fun) -> 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]), + Xs1 = t_inf_lists(Xs, Ts), case any_is_none_or_unit(Xs1) of true -> t_none(); false -> Fun(Xs1) @@ -1665,11 +1632,6 @@ strict(Xs, X) -> false -> X end. -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()). any_list(N, A) when N > 0 -> @@ -1685,39 +1647,31 @@ list_replace(1, E, [_X | Xs]) -> any_is_none_or_unit(Ts) -> lists:any(fun erl_types:t_is_impossible/1, Ts). -check_guard([X], Test, Type, Opaques) -> - check_guard_single(X, Test, Type, Opaques). +check_guard([X], Test, Type) -> + check_guard_single(X, Test, Type). -check_guard_single(X, Test, Type, Opaques) -> +check_guard_single(X, Test, Type) -> case Test(X) of true -> t_atom('true'); false -> - 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; + case t_is_none(t_inf(Type, X)) of + true -> t_atom('false'); false -> t_boolean() end end. -check_record_tag(Tag, Y, Opaques) -> - case t_is_atom(Tag, Opaques) of +check_record_tag(Tag, Y) -> + case t_is_atom(Tag) of false -> - TagAtom = t_inf(Tag, t_atom(), Opaques), + TagAtom = t_inf(Tag, t_atom()), case t_is_none(TagAtom) of - true -> - case t_has_opaque_subtype(Tag, Opaques) of - true -> t_none(); - false -> t_atom('false') - end; + true -> t_atom('false'); false -> t_boolean() end; true -> - case t_atom_vals(Tag, Opaques) of + case t_atom_vals(Tag) of [RealTag] -> - case t_atom_vals(Y, Opaques) of + case t_atom_vals(Y) of [RealTag] -> t_atom('true'); _ -> t_boolean() end; @@ -1877,26 +1831,26 @@ negwidth(X, N) -> false -> negwidth(X, N+1) end. -arith_bnot(X1, Opaques) -> - case t_is_integer(X1, Opaques) of +arith_bnot(X1) -> + case t_is_integer(X1) of false -> error; true -> - Min1 = number_min(X1, Opaques), - Max1 = number_max(X1, Opaques), + Min1 = number_min(X1), + Max1 = number_max(X1), {ok, t_from_range(infinity_add(infinity_inv(Max1), -1), infinity_add(infinity_inv(Min1), -1))} end. -arith_abs(X1, Opaques) -> - case t_is_integer(X1, Opaques) of +arith_abs(X1) -> + case t_is_integer(X1) of false -> - case t_is_float(X1, Opaques) of + case t_is_float(X1) of true -> t_float(); false -> t_number() end; true -> - Min1 = number_min(X1, Opaques), - Max1 = number_max(X1, Opaques), + Min1 = number_min(X1), + Max1 = number_max(X1), {NewMin, NewMax} = case infinity_geq(Min1, 0) of true -> {Min1, Max1}; @@ -1977,13 +1931,13 @@ arith_bor_range_set({Min, Max}, [Int|IntList]) -> IntList), {infinity_bor(Min, SafeAnd), infinity_bor(Max, SafeAnd)}. -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), +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), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2); @@ -1993,13 +1947,13 @@ arith_band(X1, X2, Opaques) -> arith_band_ranges(Min1, Max1, Min2, Max2) end. -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), +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), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2); @@ -2037,19 +1991,18 @@ arith_bor_ranges(Min1, Max1, Min2, Max2) -> end, {Min, Max}. -arith(Op, X1, X2, Opaques) -> - %% io:format("arith ~p ~p ~p~n", [Op, X1, X2]), - case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of +arith(Op, X1, X2) -> + case t_is_integer(X1) andalso t_is_integer(X2) of false -> error; true -> - L1 = t_number_vals(X1, Opaques), - L2 = t_number_vals(X2, Opaques), + L1 = t_number_vals(X1), + L2 = t_number_vals(X2), case (L1 =:= unknown) orelse (L2 =:= unknown) of true -> - Min1 = number_min(X1, Opaques), - Max1 = number_max(X1, Opaques), - Min2 = number_min(X2, Opaques), - Max2 = number_max(X2, Opaques), + Min1 = number_min(X1), + Max1 = number_max(X1), + Min2 = number_min(X2), + Max2 = number_max(X2), {NewMin, NewMax} = case Op of '+' -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)}; @@ -2062,11 +2015,10 @@ arith(Op, X1, X2, Opaques) -> 'bsr' -> NewMin2 = infinity_inv(Max2), NewMax2 = infinity_inv(Min2), arith_bsl(Min1, Max1, NewMin2, NewMax2); - 'band' -> arith_band(X1, X2, Opaques); - 'bor' -> arith_bor(X1, X2, Opaques); + 'band' -> arith_band(X1, X2); + 'bor' -> arith_bor(X1, X2); 'bxor' -> arith_bor_ranges(Min1, Max1, Min2, Max2) %% overaprox. end, - %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]), {ok, t_from_range(NewMin, NewMax)}; false -> %% Some of these arithmetic operations might throw a system_limit @@ -2095,59 +2047,56 @@ arith(Op, X1, X2, Opaques) -> %% Comparison of terms %%============================================================================= -compare(Op, Lhs, Rhs, Opaques) -> - case t_is_none(t_inf(Lhs, Rhs, Opaques)) of - false -> t_boolean(); +compare(Op, Lhs, Rhs) -> + case t_is_none(t_inf(Lhs, Rhs)) of + false -> + t_boolean(); true -> - 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() + case Op of + '<' -> always_smaller(Lhs, Rhs); + '>' -> always_smaller(Rhs, Lhs); + '=<' -> always_smaller(Lhs, Rhs); + '>=' -> always_smaller(Rhs, Lhs) end end. -always_smaller(Type1, Type2, Opaques) -> - {Min1, Max1} = type_ranks(Type1, Opaques), - {Min2, Max2} = type_ranks(Type2, Opaques), +always_smaller(Type1, Type2) -> + {Min1, Max1} = type_ranks(Type1), + {Min2, Max2} = type_ranks(Type2), if Max1 < Min2 -> t_atom('true'); Min1 > Max2 -> t_atom('false'); true -> t_boolean() end. -type_ranks(Type, Opaques) -> - type_ranks(Type, 1, 0, 0, type_order(), Opaques). +type_ranks(Type) -> + type_ranks(Type, 1, 0, 0, type_order()). -type_ranks(_Type, _I, Min, Max, [], _Opaques) -> {Min, Max}; -type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> +type_ranks(_Type, _I, Min, Max, []) -> {Min, Max}; +type_ranks(Type, I, Min, Max, [TypeClass|Rest]) -> {NewMin, NewMax} = - case t_is_none(t_inf(Type, TypeClass, Opaques)) of + case t_is_none(t_inf(Type, TypeClass)) of true -> {Min, Max}; false -> case Min of 0 -> {I, I}; _ -> {Min, I} end end, - type_ranks(Type, I+1, NewMin, NewMax, Rest, Opaques). + type_ranks(Type, I+1, NewMin, NewMax, Rest). type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), t_map(), t_list(), t_bitstr()]. -key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> +key_comparisons_fail(X0, KeyPos, TupleList) -> X = erl_types:t_widen_to_number(X0), lists:all(fun(Tuple) -> Key = type(erlang, element, 2, [KeyPos, Tuple]), - t_is_none(t_inf(Key, X, Opaques)) + t_is_none(t_inf(Key, X)) end, TupleList). %%============================================================================= --spec arg_types(atom(), atom(), arity()) -> arg_types() | 'unknown'. +-spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'. %%------- erlang -------------------------------------------------------------- arg_types(erlang, '!', 2) -> @@ -2508,75 +2457,20 @@ arg_types(M, F, A) when is_atom(M), is_atom(F), 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 -> - (t_is_atom(Y, Opaques) andalso - 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. - -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 +check_fun_application(Fun, Args) -> + case t_is_fun(Fun) of true -> - case t_fun_args(Fun, Opaques) of + case t_fun_args(Fun) of unknown -> - case t_is_impossible(t_fun_range(Fun, Opaques)) of + case t_is_impossible(t_fun_range(Fun)) of true -> error; false -> ok end; FunDom when length(FunDom) =:= length(Args) -> - case any_is_none_or_unit(inf_lists(FunDom, Args, Opaques)) of + case any_is_none_or_unit(t_inf_lists(FunDom, Args)) of true -> error; false -> - case t_is_impossible(t_fun_range(Fun, Opaques)) of + case t_is_impossible(t_fun_range(Fun)) of true -> error; false -> ok end diff --git a/lib/dialyzer/src/erl_types.erl b/lib/dialyzer/src/erl_types.erl index 0f528f6a45e5..a772b3252020 100644 --- a/lib/dialyzer/src/erl_types.erl +++ b/lib/dialyzer/src/erl_types.erl @@ -35,15 +35,15 @@ lookup_record/3, max/2, min/2, - number_max/1, number_max/2, - number_min/1, number_min/2, + number_max/1, + number_min/1, t_abstract_records/2, t_any/0, t_arity/0, t_atom/0, t_atom/1, t_atoms/1, - t_atom_vals/1, t_atom_vals/2, + t_atom_vals/1, t_binary/0, t_bitstr/0, t_bitstr/2, @@ -59,14 +59,9 @@ t_collect_var_names/1, t_cons/0, t_cons/2, - t_cons_hd/1, t_cons_hd/2, - t_cons_tl/1, t_cons_tl/2, - t_contains_opaque/1, t_contains_opaque/2, - t_decorate_with_opaque/3, + t_cons_hd/1, + t_cons_tl/1, t_elements/1, - t_elements/2, - t_find_opaque_mismatch/3, - t_find_unknown_opaque/3, t_fixnum/0, t_non_neg_fixnum/0, t_pos_fixnum/0, @@ -82,18 +77,15 @@ t_fun/0, t_fun/1, t_fun/2, - t_fun_args/1, t_fun_args/2, - t_fun_arity/1, t_fun_arity/2, - t_fun_range/1, t_fun_range/2, - t_has_opaque_subtype/2, + t_fun_args/1, + t_fun_arity/1, + t_fun_range/1, t_has_var/1, t_identifier/0, %% t_improper_list/2, t_inf/1, t_inf/2, - t_inf/3, t_inf_lists/2, - t_inf_lists/3, t_integer/0, t_integer/1, t_non_neg_integer/0, @@ -102,62 +94,63 @@ t_iodata/0, t_iolist/0, t_is_any/1, - t_is_atom/1, t_is_atom/2, - t_is_any_atom/2, t_is_any_atom/3, - t_is_binary/1, t_is_binary/2, - t_is_bitstr/1, t_is_bitstr/2, - t_is_boolean/1, t_is_boolean/2, + t_is_atom/1, + t_is_any_atom/2, + t_is_binary/1, + t_is_bitstr/1, + t_is_boolean/1, t_is_byte/1, t_is_char/1, - t_is_cons/1, t_is_cons/2, + t_is_cons/1, t_is_equal/2, - t_is_float/1, t_is_float/2, - t_is_fun/1, t_is_fun/2, + t_is_float/1, + t_is_fun/1, t_is_identifier/1, t_is_impossible/1, - t_is_instance/2, - t_is_integer/1, t_is_integer/2, + t_is_integer/1, t_is_list/1, t_is_map/1, - t_is_map/2, - t_is_nil/1, t_is_nil/2, + t_is_nil/1, t_is_non_neg_integer/1, t_is_none/1, t_is_none_or_unit/1, - t_is_number/1, t_is_number/2, - t_is_opaque/1, t_is_opaque/2, - t_is_pid/1, t_is_pid/2, - t_is_port/1, t_is_port/2, - t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, - t_is_reference/1, t_is_reference/2, + t_is_number/1, + t_is_opaque/1, + t_is_opaque/2, + t_is_pid/1, + t_is_port/1, + t_is_maybe_improper_list/1, + t_is_reference/1, + t_is_same_opaque/2, t_is_singleton/1, - t_is_singleton/2, t_is_string/1, t_is_subtype/2, - t_is_tuple/1, t_is_tuple/2, + t_is_tuple/1, t_is_unit/1, t_is_var/1, t_limit/2, t_list/0, t_list/1, - t_list_elements/1, t_list_elements/2, - t_list_termination/1, t_list_termination/2, + t_list_elements/1, + t_list_termination/1, t_map/0, t_map/1, t_map/3, - t_map_entries/2, t_map_entries/1, - t_map_def_key/2, t_map_def_key/1, - t_map_def_val/2, t_map_def_val/1, - t_map_get/2, t_map_get/3, - t_map_is_key/2, t_map_is_key/3, - t_map_update/2, t_map_update/3, - t_map_pairwise_merge/4, - t_map_put/2, t_map_put/3, - t_map_remove/3, + t_map_entries/1, + t_map_def_key/1, + t_map_def_val/1, + t_map_get/2, + t_map_is_key/2, + t_map_update/2, + t_map_pairwise_merge/3, + t_map_put/2, + t_map_remove/2, t_mfa/0, t_module/0, t_nil/0, t_node/0, + t_nominal/2, + t_nominal_module/1, t_none/0, t_nonempty_binary/0, t_nonempty_bitstring/0, @@ -166,13 +159,11 @@ t_nonempty_string/0, t_number/0, t_number/1, - t_number_vals/1, t_number_vals/2, - t_opaque_from_records/1, - t_opaque_structure/1, + t_number_vals/1, + t_opacity_conflict/3, t_pid/0, t_port/0, t_maybe_improper_list/0, - %% t_maybe_improper_list/2, t_product/1, t_reference/0, t_string/0, @@ -187,23 +178,20 @@ t_to_tlist/1, t_tuple/0, t_tuple/1, - t_tuple_args/1, t_tuple_args/2, - t_tuple_size/1, t_tuple_size/2, + t_tuple_args/1, + t_tuple_size/1, t_tuple_sizes/1, t_tuple_subtypes/1, - t_tuple_subtypes/2, t_unify_table_only/2, t_unit/0, - t_unopaque/1, t_unopaque/2, + t_structural/1, t_var/1, t_var_name/1, t_widen_to_number/1, - %% t_assign_variables_to_subtype/2, type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, - lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, - is_opaque_type/2, + lift_list_to_pos_empty/1, is_erl_type/1, atom_to_string/1, var_table__new/0, @@ -214,15 +202,14 @@ -compile({no_auto_import,[min/2,max/2,map_get/2]}). --export_type([erl_type/0, opaques/0, type_table/0, - var_table/0, cache/0]). +-export_type([erl_type/0, type_table/0, var_table/0, cache/0]). %%-define(DEBUG, true). -ifdef(DEBUG). --define(debug(__A), __A). +-define(debug(__A, __B), case __A of true -> ok; false -> error(__B) end). -else. --define(debug(__A), ok). +-define(debug(__A, __B), ok). -endif. %%============================================================================= @@ -257,11 +244,12 @@ -define(binary_tag, binary). -define(function_tag, function). -define(identifier_tag, identifier). +-define(nominal_tag, nominal). +-define(nominal_set_tag,nominal_set). -define(list_tag, list). -define(map_tag, map). -define(nil_tag, nil). -define(number_tag, number). --define(opaque_tag, opaque). -define(product_tag, product). -define(tuple_set_tag, tuple_set). -define(tuple_tag, tuple). @@ -270,7 +258,8 @@ -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag | ?list_tag | ?map_tag | ?nil_tag | ?number_tag - | ?opaque_tag | ?product_tag + | ?nominal_tag | ?nominal_set_tag + | ?product_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. -define(float_qual, float). @@ -288,15 +277,27 @@ %% The type representation %% --define(any, any). +%% Top type +-define(any, any). + +%% Bottom type -define(none, none). + +%% Special type used to mark infinite loops: functions are assumed to return +%% a supertype of ?unit rather than ?none during analysis, letting us +%% distingish between functions that intentionally never return (like server +%% loops) and functions that never return because of a crash. -define(unit, unit). + +%% Special type used to mark opaque nominals during opacity violation checking. +-define(opaque, opaque). + %% Generic constructor - elements can be many things depending on the tag. --record(c, {tag :: tag(), - elements = [] :: term(), - qualifier = ?unknown_qual :: qual()}). +-record(c, {tag :: tag(), + elements = [] :: term(), + qualifier = ?unknown_qual :: qual()}). --opaque erl_type() :: ?any | ?none | ?unit | #c{}. +-nominal erl_type() :: ?any | ?none | ?unit | ?opaque | #c{}. %%----------------------------------------------------------------------------- %% Auxiliary types and convenient macros @@ -308,30 +309,30 @@ -record(int_set, {set :: [integer()]}). -record(int_rng, {from :: rng_elem(), to :: rng_elem()}). --record(opaque, {mod :: module(), name :: atom(), - arity = 0 :: arity(), struct :: erl_type()}). - -define(atom(Set), #c{tag=?atom_tag, elements=Set}). -define(bitstr(Unit, Base), #c{tag=?binary_tag, elements={Unit,Base}}). -define(float, ?number(?any, ?float_qual)). -define(function(Domain, Range), #c{tag=?function_tag, - elements={Domain,Range}}). + elements={Domain,Range}}). -define(identifier(Types), #c{tag=?identifier_tag, elements=Types}). -define(integer(Types), ?number(Types, ?integer_qual)). -define(int_range(From, To), ?integer(#int_rng{from=From, to=To})). -define(int_set(Set), ?integer(#int_set{set=Set})). +-define(nominal(Name, Types), #c{tag=?nominal_tag, elements={Name,Types}}). +-define(nominal_set(Nominals, + Structurals), #c{tag=?nominal_set_tag, + elements={Nominals, Structurals}}). -define(list(Types, Term, Size), #c{tag=?list_tag, elements={Types,Term}, - qualifier=Size}). + qualifier=Size}). -define(nil, #c{tag=?nil_tag}). -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, - qualifier=Qualifier}). + qualifier=Qualifier}). -define(map(Pairs,DefKey,DefVal), #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}). --define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, - qualifier={Arity, Qual}}). + qualifier={Arity, Qual}}). -define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}). -define(var(Id), #c{tag=?var_tag, elements=Id}). @@ -341,11 +342,9 @@ -define(integer_non_neg, ?int_range(0, pos_inf)). -define(integer_neg, ?int_range(neg_inf, -1)). --type opaques() :: [erl_type()] | 'universe'. - -type file_line() :: {file:name(), erl_anno:line()}. -type record_key() :: {'record', atom()}. --type type_key() :: {'type' | 'opaque', atom(), arity()}. +-type type_key() :: {'type' | 'opaque' | 'nominal', atom(), arity()}. -type field() :: {atom(), erl_parse:abstract_expr(), erl_type()}. -type record_value() :: {file_line(), [{RecordSize :: non_neg_integer(), [field()]}]}. @@ -363,20 +362,19 @@ %% -define(union(List), #c{tag=?union_tag, elements=List}). --define(untagged_union(A, B, F, I, L, N, T, O, Map), [A,B,F,I,L,N,T,O,Map]). +-define(untagged_union(A, B, F, I, L, N, T, Map), [A,B,F,I,L,N,T,Map]). -define(num_types_in_union, length(?untagged_union(?any, ?any, ?any, ?any, ?any, - ?any, ?any, ?any, ?any))). - --define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none,?none])). --define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none,?none])). --define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none,?none])). --define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none,?none])). --define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none,?none])). --define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none,?none])). --define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none])). --define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none])). --define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T])). + ?any, ?any, ?any))). + +-define(atom_union(T), ?union([T,?none,?none,?none,?none,?none,?none,?none])). +-define(bitstr_union(T), ?union([?none,T,?none,?none,?none,?none,?none,?none])). +-define(function_union(T), ?union([?none,?none,T,?none,?none,?none,?none,?none])). +-define(identifier_union(T), ?union([?none,?none,?none,T,?none,?none,?none,?none])). +-define(list_union(T), ?union([?none,?none,?none,?none,T,?none,?none,?none])). +-define(number_union(T), ?union([?none,?none,?none,?none,?none,T,?none,?none])). +-define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none])). +-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). @@ -400,7 +398,7 @@ t_any() -> -spec t_is_any(erl_type()) -> boolean(). t_is_any(Type) -> - do_opaque(Type, 'universe', fun is_any/1). + structural(Type, fun is_any/1). is_any(?any) -> true; is_any(_) -> false. @@ -419,347 +417,86 @@ t_is_none(_) -> false. %% Opaque types %% --spec t_opaque(module(), atom(), [_], erl_type()) -> erl_type(). - -t_opaque(Mod, Name, Args, Struct) -> - O = #opaque{mod = Mod, name = Name, arity = length(Args), struct = Struct}, - ?opaque(set_singleton(O)). - --spec t_is_opaque(erl_type(), [erl_type()]) -> boolean(). - -t_is_opaque(?opaque(_) = Type, Opaques) -> - not is_opaque_type(Type, Opaques); -t_is_opaque(_Type, _Opaques) -> false. - --spec t_is_opaque(erl_type()) -> boolean(). - -t_is_opaque(?opaque(_)) -> true; -t_is_opaque(_) -> false. - --spec t_has_opaque_subtype(erl_type(), opaques()) -> boolean(). - -t_has_opaque_subtype(Type, Opaques) -> - do_opaque(Type, Opaques, fun has_opaque_subtype/1). - -has_opaque_subtype(?union(Ts)) -> - lists:any(fun t_is_opaque/1, Ts); -has_opaque_subtype(T) -> - t_is_opaque(T). - --spec t_opaque_structure(erl_type()) -> erl_type(). - -t_opaque_structure(?opaque(Elements)) -> - t_sup([Struct || #opaque{struct = Struct} <- Elements]). - --spec t_contains_opaque(erl_type()) -> boolean(). - -t_contains_opaque(Type) -> - t_contains_opaque(Type, []). - -%% Returns 'true' iff there is an opaque type that is *not* one of -%% the types of the second argument. - --spec t_contains_opaque(erl_type(), [erl_type()]) -> boolean(). - -t_contains_opaque(?any, _Opaques) -> false; -t_contains_opaque(?none, _Opaques) -> false; -t_contains_opaque(?unit, _Opaques) -> false; -t_contains_opaque(?atom(_Set), _Opaques) -> false; -t_contains_opaque(?bitstr(_Unit, _Base), _Opaques) -> false; -t_contains_opaque(?float, _Opaques) -> false; -t_contains_opaque(?function(Domain, Range), Opaques) -> - t_contains_opaque(Domain, Opaques) - orelse t_contains_opaque(Range, Opaques); -t_contains_opaque(?identifier(_Types), _Opaques) -> false; -t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; -t_contains_opaque(?int_set(_Set), _Opaques) -> false; -t_contains_opaque(?integer(_Types), _Opaques) -> false; -t_contains_opaque(?list(Type, ?nil, _), Opaques) -> - t_contains_opaque(Type, Opaques); -t_contains_opaque(?list(Type, Tail, _), Opaques) -> - t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(_, _, _) = Map, Opaques) -> - list_contains_opaque(map_all_types(Map), Opaques); -t_contains_opaque(?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([H|T], Opaques) -> - t_contains_opaque(H, Opaques) orelse list_contains_opaque(T, Opaques); -list_contains_opaque([], _Opaques) -> false. - -%% t_find_opaque_mismatch/2 of two types should only be used if their -%% t_inf is t_none() due to some opaque type violation. However, -%% 'error' is returned if a structure mismatch is found. -%% -%% The first argument of the function is the pattern and its second -%% argument the type we are matching against the pattern. - --spec t_find_opaque_mismatch(erl_type(), erl_type(), [erl_type()]) -> - 'error' | {'ok', erl_type(), erl_type()}. - -t_find_opaque_mismatch(T1, T2, Opaques) -> - try t_find_opaque_mismatch(T1, T2, T2, Opaques) - catch throw:error -> error - end. - -t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error; -t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error); -t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) -> - t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques); -t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) -> - case is_opaque_type(T2, Opaques) of - false -> - case t_is_opaque(T1) andalso compatible_opaque_types(T1, T2) =/= [] of - true -> error; - false -> {ok, TopType, T2} - end; - true -> - t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques) - end; -t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) -> - %% The generated message is somewhat misleading: - case is_opaque_type(T1, Opaques) of - false -> - case t_is_opaque(T2) andalso compatible_opaque_types(T1, T2) =/= [] of - true -> error; - false -> {ok, TopType, T1} - end; - true -> - t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques) - end; -t_find_opaque_mismatch(?product(T1), ?product(T2), TopType, Opaques) -> - t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); -t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), - TopType, Opaques) -> - t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); -t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, - TopType, Opaques) -> - Tuples1 = t_tuple_subtypes(T1), - Tuples2 = t_tuple_subtypes(T2), - t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques); -t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) -> - t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques); -t_find_opaque_mismatch(T1, T2, _TopType, Opaques) -> - case t_is_none(t_inf(T1, T2, Opaques)) of - false -> error; - true -> throw(error) - end. - -t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) - when is_list(L1), is_list(L2) -> - List = lists:zipwith(fun(T1, T2) -> - t_find_opaque_mismatch(T1, T2, TopType, Opaques) - end, L1, L2), - t_find_opaque_mismatch_list(List); -t_find_opaque_mismatch_ordlists(_, _, _TopType, _Opaques) -> - error. - -t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) - when is_list(L1), is_list(L2) -> - List = [try t_find_opaque_mismatch(T1, T2, T2, Opaques) - catch throw:error -> error - end || T1 <- L1, T2 <- L2], - t_find_opaque_mismatch_list(List); -t_find_opaque_mismatch_lists(_, _, _TopType, _Opaques) -> - error. - -t_find_opaque_mismatch_list([]) -> throw(error); -t_find_opaque_mismatch_list([H|T]) -> - case H of - {ok, _T1, _T2} -> H; - error -> t_find_opaque_mismatch_list(T) - end. - --spec t_find_unknown_opaque(erl_type(), erl_type(), opaques()) -> - [pos_integer()]. - -%% The nice thing about using two types and t_inf() as compared to -%% calling t_contains_opaque/2 is that the traversal stops when -%% there is a mismatch which means that unknown opaque types "below" -%% the mismatch are not found. -t_find_unknown_opaque(_T1, _T2, 'universe') -> []; -t_find_unknown_opaque(T1, T2, Opaques) -> - try t_inf(T1, T2, {match, Opaques}) of - _ -> [] - catch throw:{pos, Ns} -> Ns - end. - --spec t_decorate_with_opaque(erl_type(), erl_type(), [erl_type()]) -> erl_type(). - -%% The first argument can contain opaque types. The second argument -%% is assumed to be taken from the contract. - -t_decorate_with_opaque(T1, T2, Opaques) -> - case - Opaques =:= [] orelse t_is_equal(T1, T2) orelse not t_contains_opaque(T2) - of - true -> T1; - false -> - T = t_inf(T1, T2), - case t_contains_opaque(T) of - false -> T1; - true -> - R = decorate(T1, T, Opaques), - ?debug(case catch - not t_is_equal(t_unopaque(R), t_unopaque(T1)) - orelse - t_is_equal(T1, T) andalso not t_is_equal(T1, R) - of - false -> ok; - _ -> - io:format("T1 = ~p,\n", [T1]), - io:format("T2 = ~p,\n", [T2]), - io:format("O = ~p,\n", [Opaques]), - io:format("erl_types:t_decorate_with_opaque(T1,T2,O).\n"), - throw({error, "Failed to handle opaque types"}) - end), - R - end - end. - -decorate(Type, ?none, _Opaques) -> Type; -decorate(?function(Domain, Range), ?function(D, R), Opaques) -> - ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques)); -decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) -> - ?list(decorate(Types, Ts, Opaques), decorate(Tail, Tl, Opaques), Size); -decorate(?product(Types), ?product(Ts), Opaques) -> - ?product(list_decorate(Types, Ts, Opaques)); -decorate(?tuple(_, _, _)=T, ?tuple(?any, _, _), _Opaques) -> T; -decorate(?tuple(?any, _, _)=T, ?tuple(_, _, _), _Opaques) -> T; -decorate(?tuple(Types, Arity, Tag), ?tuple(Ts, Arity, _), Opaques) -> - ?tuple(list_decorate(Types, Ts, Opaques), Arity, Tag); -decorate(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> - decorate_tuple_sets(List, [{Arity, [T]}], Opaques); -decorate(?tuple_set(List), ?tuple_set(L), Opaques) -> - decorate_tuple_sets(List, L, Opaques); -decorate(?union(List), T, Opaques) when T =/= ?any -> - ?union(L) = force_union(T), - union_decorate(List, L, Opaques); -decorate(T, ?union(L), Opaques) when T =/= ?any -> - ?union(List) = force_union(T), - union_decorate(List, L, Opaques); -decorate(Type, ?opaque(_)=T, Opaques) -> - decorate_with_opaque(Type, T, Opaques); -decorate(Type, _T, _Opaques) -> Type. - -%% Note: it is important that #opaque.struct is a subtype of the -%% opaque type. -decorate_with_opaque(Type, ?opaque(Set2), Opaques) -> - case decoration(Set2, Type, Opaques, [], false) of - {[], false} -> Type; - {List, All} when List =/= [] -> - NewType = sup_opaque(List), - case All of - true -> NewType; - false -> t_sup(NewType, Type) - end - end. - -decoration([#opaque{struct = S} = Opaque|OpaqueTypes], Type, Opaques, - NewOpaqueTypes0, All) -> - IsOpaque = is_opaque_type2(Opaque, Opaques), - I = t_inf(Type, S), - case not IsOpaque orelse t_is_none(I) of - true -> decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes0, All); - false -> - NewI = decorate(I, S, Opaques), - NewOpaque = combine(NewI, [Opaque]), - NewAll = All orelse t_is_equal(I, Type), - NewOpaqueTypes = NewOpaque ++ NewOpaqueTypes0, - decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes, NewAll) - end; -decoration([], _Type, _Opaques, NewOpaqueTypes, All) -> - {NewOpaqueTypes, All}. - --spec list_decorate([erl_type()], [erl_type()], opaques()) -> [erl_type()]. - -list_decorate(List, L, Opaques) -> - [decorate(Elem, E, Opaques) || {Elem, E} <- lists:zip(List, L)]. - -union_decorate(U1, U2, Opaques) -> - Union = union_decorate(U1, U2, Opaques, 0, []), - ?untagged_union(A,B,F,I,L,N,T,_,Map) = U1, - ?untagged_union(_,_,_,_,_,_,_,Opaque,_) = U2, - List = [A,B,F,I,L,N,T,Map], - DecList = [Dec || - E <- List, - not t_is_none(E), - not t_is_none(Dec = decorate(E, Opaque, Opaques))], - t_sup([Union|DecList]). - -union_decorate([?none|Left1], [_|Left2], Opaques, N, Acc) -> - union_decorate(Left1, Left2, Opaques, N, [?none|Acc]); -union_decorate([T1|Left1], [?none|Left2], Opaques, N, Acc) -> - union_decorate(Left1, Left2, Opaques, N+1, [T1|Acc]); -union_decorate([T1|Left1], [T2|Left2], Opaques, N, Acc) -> - union_decorate(Left1, Left2, Opaques, N+1, [decorate(T1, T2, Opaques)|Acc]); -union_decorate([], [], _Opaques, N, Acc) -> - if N =:= 0 -> ?none; - N =:= 1 -> - [Type] = [T || T <- Acc, T =/= ?none], - Type; - N >= 2 -> ?union(lists:reverse(Acc)) +%% Returns whether the `Given` type implicitly violates the opacity of opaque +%% nominals of the `Required` type. +-spec t_opacity_conflict(Given :: erl_type(), + Required :: erl_type(), + Module :: module()) -> + none | expected_opaque | expected_transparent. +t_opacity_conflict(Given, Required, Module) -> + %% Opacity violations are detected by selectively blinding the infimum + %% routine to the structure of opaque types that we are not supposed to know + %% anything about. + %% + %% If the infimum of the `Given` and `Required` types is possible, we replace + %% the structural component of opaques with a magic value whose infimum with + %% anything else becomes `none()`, forcing a failure when the original + %% opaques introduce more information. + %% + %% Conversely, if the infimum of the `Given` and `Required` types is + %% impossible, we replace the structural component of opaques with `any()` to + %% force success when the altered opaques introduce more information (note + %% the inversion). + %% + %% From there, we can detect opacity violations by checking whether the + %% infimum of (blinded `Given`) and (blinded `Required`) is equal to the + %% blinded infimum of `Given` and `Required`. + Direction = case t_is_impossible(t_inf(Given, Required)) of + true -> ?any; + false -> ?opaque + end, + + RequiredBlind = oc_mark(Required, Direction, Module), + GivenBlind = oc_mark(Given, Direction, Module), + + %% If the `Required` type does not change when blinded, we know that the call + %% expects a transparent type and not an opaque. Note that this is merely a + %% heuristic, and we can clash in both ways at once should the types be + %% complex enough. + ErrorType = case t_is_equal(RequiredBlind, Required) of + true -> expected_transparent; + false -> expected_opaque + end, + + case {t_is_impossible(t_inf(GivenBlind, RequiredBlind)), Direction} of + {true, ?opaque} -> ErrorType; + {false, ?any} -> ErrorType; + {_, _} -> none 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) +oc_mark(?nominal({Mod, _Name, _Arity, Opacity}=Name, S0), Direction, Module) -> + case (Opacity =:= transparent) orelse (Mod =:= Module) of + true -> t_nominal(Name, oc_mark(S0, Direction, Module)); + false -> t_nominal(Name, Direction) end; -decorate_tuples_in_sets([T1|Tuples], L2, Opaques, Acc) -> - decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]); -decorate_tuples_in_sets([], _L, _Opaques, Acc) -> - lists:reverse(Acc). - --spec t_opaque_from_records(type_table()) -> [erl_type()]. - -t_opaque_from_records(RecMap) -> - Any = t_any(), - [begin - Rep = Any, % not used for anything right now - Args = [Any || _ <- ArgNames], - t_opaque(Module, Name, Args, Rep) - end || {opaque, Name, _} := {{Module, _, _, ArgNames}, _} <- RecMap]. +oc_mark(?nominal_set(Ns, Other), Direction, Module) -> + normalize_nominal_set([oc_mark(N, Direction, Module) || N <- Ns], + oc_mark(Other, Direction, Module), + []); +oc_mark(?list(ElemT, Termination, Sz), Direction, Module) -> + ?list(oc_mark(ElemT, Direction, Module), + oc_mark(Termination, Direction, Module), Sz); +oc_mark(?tuple(?any, _, _) = T, _Direction, _Module) -> + T; +oc_mark(?tuple(ArgTs, Sz, Tag), Direction, Module) when is_list(ArgTs) -> + ?tuple([oc_mark(A, Direction, Module) || A <- ArgTs], Sz, Tag); +oc_mark(?tuple_set(Set0), Direction, Module) -> + ?tuple_set([{Sz, [oc_mark(T, Direction, Module) || T <- Tuples]} + || {Sz, Tuples} <- Set0]); +oc_mark(?product(Types), Direction, Module) -> + ?product([oc_mark(T, Direction, Module) || T <- Types]); +oc_mark(?function(Domain, Range), Direction, Module) -> + ?function(oc_mark(Domain, Direction, Module), + oc_mark(Range, Direction, Module)); +oc_mark(?union(U0), Direction, Module) -> + ?union([oc_mark(T, Direction, Module) || T <- U0]); +oc_mark(?map(Pairs, DefK, DefV), Direction, Module) -> + %% K is always a singleton, and thus can't contain any nominals. + t_map([{K, MNess, oc_mark(V, Direction, Module)} || {K, MNess, V} <- Pairs], + oc_mark(DefK, Direction, Module), + oc_mark(DefV, Direction, Module)); +oc_mark(T, _Direction, _Module) -> + T. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. @@ -807,16 +544,10 @@ t_atoms(List) when is_list(List) -> -spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. t_atom_vals(Type) -> - t_atom_vals(Type, 'universe'). - --spec t_atom_vals(erl_type(), opaques()) -> 'unknown' | [atom(),...]. - -t_atom_vals(Type, Opaques) -> - do_opaque(Type, Opaques, fun atom_vals/1). + structural(Type, fun atom_vals/1). atom_vals(?atom(?any)) -> unknown; atom_vals(?atom(Set)) -> Set; -atom_vals(?opaque(_)) -> unknown; atom_vals(Other) -> ?atom(_) = Atm = t_inf(t_atom(), Other), atom_vals(Atm). @@ -824,12 +555,7 @@ atom_vals(Other) -> -spec t_is_atom(erl_type()) -> boolean(). t_is_atom(Type) -> - t_is_atom(Type, 'universe'). - --spec t_is_atom(erl_type(), opaques()) -> boolean(). - -t_is_atom(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_atom1/1). + structural(Type, fun is_atom1/1). is_atom1(?atom(_)) -> true; is_atom1(_) -> false. @@ -837,12 +563,7 @@ is_atom1(_) -> false. -spec t_is_any_atom(atom(), erl_type()) -> boolean(). t_is_any_atom(Atom, SomeAtomsType) -> - t_is_any_atom(Atom, SomeAtomsType, 'universe'). - --spec t_is_any_atom(atom(), erl_type(), opaques()) -> boolean(). - -t_is_any_atom(Atom, SomeAtomsType, Opaques) -> - do_opaque(SomeAtomsType, Opaques, + structural(SomeAtomsType, fun(AtomsType) -> is_any_atom(Atom, AtomsType) end). is_any_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false; @@ -855,12 +576,7 @@ 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). + structural(Type, fun is_boolean/1). -spec t_boolean() -> erl_type(). @@ -893,12 +609,7 @@ t_nonempty_binary() -> -spec t_is_binary(erl_type()) -> boolean(). t_is_binary(Type) -> - t_is_binary(Type, 'universe'). - --spec t_is_binary(erl_type(), opaques()) -> boolean(). - -t_is_binary(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_binary/1). + structural(Type, fun is_binary/1). is_binary(?bitstr(U, B)) -> ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0); @@ -954,24 +665,19 @@ t_bitstr_concat_1([], Acc) -> t_bitstr_concat(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), - bitstr_concat(t_unopaque(T1p), t_unopaque(T2p)). + bitstr_concat(t_structural(T1p), t_structural(T2p)). -spec t_bitstr_match(erl_type(), erl_type()) -> erl_type(). t_bitstr_match(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), - bitstr_match(t_unopaque(T1p), t_unopaque(T2p)). + bitstr_match(t_structural(T1p), t_structural(T2p)). -spec t_is_bitstr(erl_type()) -> boolean(). t_is_bitstr(Type) -> - t_is_bitstr(Type, 'universe'). - --spec t_is_bitstr(erl_type(), opaques()) -> boolean(). - -t_is_bitstr(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_bitstr/1). + structural(Type, fun is_bitstr/1). is_bitstr(?bitstr(_, _)) -> true; is_bitstr(_) -> false. @@ -1000,12 +706,7 @@ t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 -> -spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()]. t_fun_args(Type) -> - t_fun_args(Type, 'universe'). - --spec t_fun_args(erl_type(), opaques()) -> 'unknown' | [erl_type()]. - -t_fun_args(Type, Opaques) -> - do_opaque(Type, Opaques, fun fun_args/1). + structural(Type, fun fun_args/1). fun_args(?function(?any, _)) -> unknown; @@ -1015,12 +716,7 @@ fun_args(?function(?product(Domain), _)) when is_list(Domain) -> -spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer(). t_fun_arity(Type) -> - t_fun_arity(Type, 'universe'). - --spec t_fun_arity(erl_type(), opaques()) -> 'unknown' | non_neg_integer(). - -t_fun_arity(Type, Opaques) -> - do_opaque(Type, Opaques, fun fun_arity/1). + structural(Type, fun fun_arity/1). fun_arity(?function(?any, _)) -> unknown; @@ -1030,12 +726,7 @@ fun_arity(?function(?product(Domain), _)) -> -spec t_fun_range(erl_type()) -> erl_type(). t_fun_range(Type) -> - t_fun_range(Type, 'universe'). - --spec t_fun_range(erl_type(), opaques()) -> erl_type(). - -t_fun_range(Type, Opaques) -> - do_opaque(Type, Opaques, fun fun_range/1). + structural(Type, fun fun_range/1). fun_range(?function(_, Range)) -> Range. @@ -1043,12 +734,7 @@ fun_range(?function(_, Range)) -> -spec t_is_fun(erl_type()) -> boolean(). t_is_fun(Type) -> - t_is_fun(Type, 'universe'). - --spec t_is_fun(erl_type(), opaques()) -> boolean(). - -t_is_fun(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_fun/1). + structural(Type, fun is_fun/1). is_fun(?function(_, _)) -> true; is_fun(_) -> false. @@ -1077,12 +763,7 @@ t_port() -> -spec t_is_port(erl_type()) -> boolean(). t_is_port(Type) -> - t_is_port(Type, 'universe'). - --spec t_is_port(erl_type(), opaques()) -> boolean(). - -t_is_port(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_port1/1). + structural(Type, fun is_port1/1). is_port1(?identifier(?any)) -> false; is_port1(?identifier(Set)) -> set_is_singleton(?port_qual, Set); @@ -1098,12 +779,7 @@ t_pid() -> -spec t_is_pid(erl_type()) -> boolean(). t_is_pid(Type) -> - t_is_pid(Type, 'universe'). - --spec t_is_pid(erl_type(), opaques()) -> boolean(). - -t_is_pid(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_pid1/1). + structural(Type, fun is_pid1/1). is_pid1(?identifier(?any)) -> false; is_pid1(?identifier(Set)) -> set_is_singleton(?pid_qual, Set); @@ -1119,12 +795,7 @@ t_reference() -> -spec t_is_reference(erl_type()) -> boolean(). t_is_reference(Type) -> - t_is_reference(Type, 'universe'). - --spec t_is_reference(erl_type(), opaques()) -> boolean(). - -t_is_reference(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_reference1/1). + structural(Type, fun is_reference1/1). is_reference1(?identifier(?any)) -> false; is_reference1(?identifier(Set)) -> set_is_singleton(?reference_qual, Set); @@ -1147,12 +818,7 @@ t_number(X) when is_integer(X) -> -spec t_is_number(erl_type()) -> boolean(). t_is_number(Type) -> - t_is_number(Type, 'universe'). - --spec t_is_number(erl_type(), opaques()) -> boolean(). - -t_is_number(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_number/1). + structural(Type, fun is_number/1). is_number(?number(_, _)) -> true; is_number(_) -> false. @@ -1164,16 +830,10 @@ is_number(_) -> false. -spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...]. t_number_vals(Type) -> - t_number_vals(Type, 'universe'). - --spec t_number_vals(erl_type(), opaques()) -> 'unknown' | [integer(),...]. - -t_number_vals(Type, Opaques) -> - do_opaque(Type, Opaques, fun number_vals/1). + structural(Type, fun number_vals/1). number_vals(?int_set(Set)) -> 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 @@ -1189,12 +849,7 @@ t_float() -> -spec t_is_float(erl_type()) -> boolean(). t_is_float(Type) -> - t_is_float(Type, 'universe'). - --spec t_is_float(erl_type(), opaques()) -> boolean(). - -t_is_float(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_float1/1). + structural(Type, fun is_float1/1). is_float1(?float) -> true; is_float1(_) -> false. @@ -1219,12 +874,7 @@ t_integers(List) when is_list(List) -> -spec t_is_integer(erl_type()) -> boolean(). t_is_integer(Type) -> - t_is_integer(Type, 'universe'). - --spec t_is_integer(erl_type(), opaques()) -> boolean(). - -t_is_integer(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_integer1/1). + structural(Type, fun is_integer1/1). is_integer1(?integer(_)) -> true; is_integer1(_) -> false. @@ -1302,17 +952,12 @@ t_cons(Hd, Tail) -> end. cons_tail(Type) -> - do_opaque(Type, 'universe', fun(T) -> T end). + structural(Type, fun(T) -> T end). -spec t_is_cons(erl_type()) -> boolean(). t_is_cons(Type) -> - t_is_cons(Type, 'universe'). - --spec t_is_cons(erl_type(), opaques()) -> boolean(). - -t_is_cons(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_cons/1). + structural(Type, fun is_cons/1). is_cons(?nonempty_list(_, _)) -> true; is_cons(_) -> false. @@ -1320,24 +965,14 @@ is_cons(_) -> false. -spec t_cons_hd(erl_type()) -> erl_type(). t_cons_hd(Type) -> - t_cons_hd(Type, 'universe'). - --spec t_cons_hd(erl_type(), opaques()) -> erl_type(). - -t_cons_hd(Type, Opaques) -> - do_opaque(Type, Opaques, fun cons_hd/1). + structural(Type, fun cons_hd/1). cons_hd(?nonempty_list(Contents, _Termination)) -> Contents. -spec t_cons_tl(erl_type()) -> erl_type(). t_cons_tl(Type) -> - t_cons_tl(Type, 'universe'). - --spec t_cons_tl(erl_type(), opaques()) -> erl_type(). - -t_cons_tl(Type, Opaques) -> - do_opaque(Type, Opaques, fun cons_tl/1). + structural(Type, fun cons_tl/1). cons_tl(?nonempty_list(_Contents, Termination) = T) -> t_sup(Termination, T). @@ -1350,16 +985,55 @@ t_nil() -> -spec t_is_nil(erl_type()) -> boolean(). t_is_nil(Type) -> - t_is_nil(Type, 'universe'). - --spec t_is_nil(erl_type(), opaques()) -> boolean(). - -t_is_nil(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_nil/1). + structural(Type, fun is_nil/1). is_nil(?nil) -> true; is_nil(_) -> false. +-spec t_nominal(any(), erl_type()) -> erl_type(). + +t_nominal(Name, Type) -> + case not t_is_impossible(Type) of + true -> ?nominal(Name, Type); + false -> ?none + end. + +-spec t_nominal_module(erl_type()) -> term(). + +t_nominal_module(?nominal({Module, _, _, _},_)) -> Module. + +-ifdef(DEBUG). +-spec t_is_nominal(erl_type()) -> boolean(). + +t_is_nominal(?nominal_set(_,?none)) -> true; +t_is_nominal(?nominal(_,_)) -> true; +t_is_nominal(_) -> false. +-endif. + +-spec t_is_opaque(erl_type()) -> boolean(). + +t_is_opaque(?nominal({_,_,_,opaque},_)) -> true; +t_is_opaque(_) -> false. + +-spec t_is_opaque(erl_type(), module()) -> boolean(). + +t_is_opaque(?nominal({ModA,_,_,opaque},_), ModB) -> + ModA =/= ModB; +t_is_opaque(?nominal_set(Ns, ?none), Mod) -> + %% This is a relaxed check to reduce noise; there are many benign violations + %% of opacity throughout OTP and user code where we have a union of an opaque + %% type and a structural one that doesn't overlap. + lists:any(fun(N) -> t_is_opaque(N, Mod) end, Ns); +t_is_opaque(_, _) -> + false. + +-spec t_is_same_opaque(erl_type(), erl_type()) -> boolean(). + +t_is_same_opaque(?nominal({_,_,_,opaque}=Same,_), ?nominal(Same,_)) -> + true; +t_is_same_opaque(?nominal({_,_,_,opaque},_), ?nominal({_,_,_,opaque},_)) -> + false. + -spec t_list() -> erl_type(). t_list() -> @@ -1373,25 +1047,18 @@ t_list(Contents) -> -spec t_list_elements(erl_type()) -> erl_type(). t_list_elements(Type) -> - t_list_elements(Type, 'universe'). - --spec t_list_elements(erl_type(), opaques()) -> erl_type(). - -t_list_elements(Type, Opaques) -> - do_opaque(Type, Opaques, fun list_elements/1). + structural(Type, fun list_elements/1). list_elements(?list(Contents, _, _)) -> Contents; list_elements(?nil) -> ?none. --spec t_list_termination(erl_type(), opaques()) -> erl_type(). - -t_list_termination(Type, Opaques) -> - do_opaque(Type, Opaques, fun t_list_termination/1). - -spec t_list_termination(erl_type()) -> erl_type(). -t_list_termination(?nil) -> ?nil; -t_list_termination(?list(_, Term, _)) -> Term. +t_list_termination(Type) -> + structural(Type, fun list_termination/1). + +list_termination(?nil) -> ?nil; +list_termination(?list(_, Term, _)) -> Term. -spec t_is_list(erl_type()) -> boolean(). @@ -1444,12 +1111,7 @@ t_maybe_improper_list(Content, Termination) -> -spec t_is_maybe_improper_list(erl_type()) -> boolean(). t_is_maybe_improper_list(Type) -> - t_is_maybe_improper_list(Type, 'universe'). - --spec t_is_maybe_improper_list(erl_type(), opaques()) -> boolean(). - -t_is_maybe_improper_list(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_maybe_improper_list/1). + structural(Type, fun is_maybe_improper_list/1). is_maybe_improper_list(?list(_, _, _)) -> true; is_maybe_improper_list(?nil) -> true; @@ -1465,15 +1127,13 @@ is_maybe_improper_list(_) -> false. %% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). --spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type(). - -lift_list_to_pos_empty(Type, Opaques) -> - do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1). - -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). -lift_list_to_pos_empty(?nil) -> ?nil; -lift_list_to_pos_empty(?list(Content, Termination, _)) -> +lift_list_to_pos_empty(Type) -> + structural(Type, fun lift_list_to_pos_empty_1/1). + +lift_list_to_pos_empty_1(?nil) -> ?nil; +lift_list_to_pos_empty_1(?list(Content, Termination, _)) -> ?list(Content, Termination, ?unknown_qual). -spec t_widen_to_number(erl_type()) -> erl_type(). @@ -1501,10 +1161,11 @@ t_widen_to_number(?map(Pairs, DefK, DefV)) -> t_map(L, t_widen_to_number(DefK), t_widen_to_number(DefV)); t_widen_to_number(?nil) -> ?nil; t_widen_to_number(?number(_Set, _Tag)) -> t_number(); -t_widen_to_number(?opaque(Set)) -> - L = [Opaque#opaque{struct = t_widen_to_number(S)} || - #opaque{struct = S} = Opaque <- Set], - ?opaque(ordsets:from_list(L)); +t_widen_to_number(?nominal(N, S)) -> ?nominal(N, t_widen_to_number(S)); +t_widen_to_number(?nominal_set(N, S)) -> + normalize_nominal_set([t_widen_to_number(Nom) || Nom <- N], + t_widen_to_number(S), + []); t_widen_to_number(?product(Types)) -> ?product(list_widen_to_number(Types)); t_widen_to_number(?tuple(?any, _, _) = T) -> T; @@ -1678,12 +1339,7 @@ map_pairs_are_none([_|Ps]) -> map_pairs_are_none(Ps). -spec t_is_map(erl_type()) -> boolean(). t_is_map(Type) -> - t_is_map(Type, 'universe'). - --spec t_is_map(erl_type(), opaques()) -> boolean(). - -t_is_map(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_map1/1). + structural(Type, fun is_map1/1). is_map1(?map(_, _, _)) -> true; is_map1(_) -> false. @@ -1691,12 +1347,7 @@ is_map1(_) -> false. -spec t_map_entries(erl_type()) -> t_map_dict(). t_map_entries(M) -> - t_map_entries(M, 'universe'). - --spec t_map_entries(erl_type(), opaques()) -> t_map_dict(). - -t_map_entries(M, Opaques) -> - do_opaque(M, Opaques, fun map_entries/1). + structural(M, fun map_entries/1). map_entries(?map(Pairs,_,_)) -> Pairs. @@ -1704,12 +1355,7 @@ map_entries(?map(Pairs,_,_)) -> -spec t_map_def_key(erl_type()) -> erl_type(). t_map_def_key(M) -> - t_map_def_key(M, 'universe'). - --spec t_map_def_key(erl_type(), opaques()) -> erl_type(). - -t_map_def_key(M, Opaques) -> - do_opaque(M, Opaques, fun map_def_key/1). + structural(M, fun map_def_key/1). map_def_key(?map(_,DefK,_)) -> DefK. @@ -1717,12 +1363,7 @@ map_def_key(?map(_,DefK,_)) -> -spec t_map_def_val(erl_type()) -> erl_type(). t_map_def_val(M) -> - t_map_def_val(M, 'universe'). - --spec t_map_def_val(erl_type(), opaques()) -> erl_type(). - -t_map_def_val(M, Opaques) -> - do_opaque(M, Opaques, fun map_def_val/1). + structural(M, fun map_def_val/1). map_def_val(?map(_,_,DefV)) -> DefV. @@ -1746,12 +1387,12 @@ mapdict_insert(E={_,_,_}, T) -> [E|T]. t_map_mandatoriness(), erl_type()) -> t_map_pair() | false). --spec t_map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type(), - opaques()) -> t_map_dict(). -t_map_pairwise_merge(F, MapA, MapB, Opaques) -> - do_opaque(MapA, Opaques, +-spec t_map_pairwise_merge(map_pairwise_merge_fun(), erl_type(), erl_type()) -> + t_map_dict(). +t_map_pairwise_merge(F, MapA, MapB) -> + structural(MapA, fun(UMapA) -> - do_opaque(MapB, Opaques, + structural(MapB, fun(UMapB) -> map_pairwise_merge(F, UMapA, UMapB) end) @@ -1825,17 +1466,12 @@ mapmerge_otherv(K, ODefK, ODefV) -> -spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type(). t_map_put(KV, Map) -> - t_map_put(KV, Map, 'universe'). - --spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). - -t_map_put(KV, Map, Opaques) -> - do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end). + structural(Map, fun(UM) -> map_put(KV, UM) end). %% Key and Value are *not* unopaqued, but the map is -map_put(_, ?none, _) -> ?none; -map_put(_, ?unit, _) -> ?none; -map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> +map_put(_, ?none) -> ?none; +map_put(_, ?unit) -> ?none; +map_put({Key, Value}, ?map(Pairs,DefK,DefV)) -> case t_is_impossible(Key) orelse t_is_impossible(Value) of true -> ?none; false -> @@ -1843,7 +1479,7 @@ map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> true -> t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV); false -> - t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of + t_map([{K, MNess, case t_is_none(t_inf(K, Key)) of true -> V; false -> t_sup(V, Value) end} || {K, MNess, V} <- Pairs], @@ -1852,10 +1488,10 @@ map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> end end. --spec t_map_remove(erl_type(), erl_type(), opaques()) -> erl_type(). +-spec t_map_remove(erl_type(), erl_type()) -> erl_type(). -t_map_remove(Key, Map, Opaques) -> - do_opaque(Map, Opaques, fun(UM) -> map_remove(Key, UM) end). +t_map_remove(Key, Map) -> + structural(Map, fun(UM) -> map_remove(Key, UM) end). map_remove(_, ?none) -> ?none; map_remove(_, ?unit) -> ?none; @@ -1875,30 +1511,20 @@ map_remove(Key, Map) -> -spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). -t_map_update(KV, Map) -> - t_map_update(KV, Map, 'universe'). - --spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). - -t_map_update(_, ?none, _) -> ?none; -t_map_update(_, ?unit, _) -> ?none; -t_map_update(KV={Key, _}, M, Opaques) -> - case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of +t_map_update(_, ?none) -> ?none; +t_map_update(_, ?unit) -> ?none; +t_map_update(KV={Key, _}, M) -> + case t_is_subtype(t_atom('true'), t_map_is_key(Key, M)) of false -> ?none; - true -> t_map_put(KV, M, Opaques) + true -> t_map_put(KV, M) end. -spec t_map_get(erl_type(), erl_type()) -> erl_type(). t_map_get(Key, Map) -> - t_map_get(Key, Map, 'universe'). - --spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type(). - -t_map_get(Key, Map, Opaques) -> - do_opaque(Map, Opaques, + structural(Map, fun(UM) -> - do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end) + structural(Key, fun(UK) -> map_get(UK, UM) end) end). map_get(_, ?none) -> ?none; @@ -1927,14 +1553,9 @@ map_get(Key, ?map(Pairs, DefK, DefV)) -> -spec t_map_is_key(erl_type(), erl_type()) -> erl_type(). t_map_is_key(Key, Map) -> - t_map_is_key(Key, Map, 'universe'). - --spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type(). - -t_map_is_key(Key, Map, Opaques) -> - do_opaque(Map, Opaques, + structural(Map, fun(UM) -> - do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end) + structural(Key, fun(UK) -> map_is_key(UK, UM) end) end). map_is_key(_, ?none) -> ?none; @@ -1995,7 +1616,7 @@ t_tuple(List) -> -spec get_tuple_tags([erl_type()]) -> [erl_type(),...]. get_tuple_tags([Tag|_]) -> - do_opaque(Tag, 'universe', fun tuple_tags/1); + structural(Tag, fun tuple_tags/1); get_tuple_tags(_) -> [?any]. tuple_tags(?atom(?any)) -> [?any]; @@ -2010,13 +1631,7 @@ tuple_tags(_) -> [?any]. -spec t_tuple_args(erl_type()) -> [erl_type()]. t_tuple_args(Type) -> - t_tuple_args(Type, 'universe'). - -%% to be used for a tuple with known types for its arguments (not ?any) --spec t_tuple_args(erl_type(), opaques()) -> [erl_type()]. - -t_tuple_args(Type, Opaques) -> - do_opaque(Type, Opaques, fun tuple_args/1). + structural(Type, fun tuple_args/1). tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args. @@ -2024,61 +1639,32 @@ tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args. -spec t_tuple_size(erl_type()) -> non_neg_integer(). t_tuple_size(Type) -> - t_tuple_size(Type, 'universe'). - -%% to be used for a tuple with a known size (not ?any) --spec t_tuple_size(erl_type(), opaques()) -> non_neg_integer(). - -t_tuple_size(Type, Opaques) -> - do_opaque(Type, Opaques, fun tuple_size1/1). + structural(Type, fun tuple_size1/1). tuple_size1(?tuple(_, Size, _)) when is_integer(Size) -> Size. -spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...]. t_tuple_sizes(Type) -> - do_opaque(Type, 'universe', fun tuple_sizes/1). + structural(Type, 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(),...]. +t_tuple_subtypes(Type) -> + structural(Type, fun tuple_subtypes/1). -%% 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)) -> +tuple_subtypes(?tuple(?any, ?any, ?any)) -> unknown; +tuple_subtypes(?tuple(_, _, _) = T) -> [T]; +tuple_subtypes(?tuple_set(List)) -> lists:append([Tuples || {_Size, Tuples} <- List]). -spec t_is_tuple(erl_type()) -> boolean(). t_is_tuple(Type) -> - t_is_tuple(Type, 'universe'). - --spec t_is_tuple(erl_type(), opaques()) -> boolean(). - -t_is_tuple(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_tuple1/1). + structural(Type, fun is_tuple1/1). is_tuple1(?tuple(_, _, _)) -> true; is_tuple1(?tuple_set(_)) -> true; @@ -2216,6 +1802,10 @@ t_has_var(?list(Contents, ?nil, _)) -> t_has_var(Contents); t_has_var(?list(Contents, Termination, _)) -> t_has_var(Contents) orelse t_has_var(Termination); +t_has_var(?nominal(_, S)) -> + t_has_var(S); +t_has_var(?nominal_set(N, S)) -> + t_has_var(S) andalso lists:any(fun t_has_var/1, N); t_has_var(?product(Types)) -> t_has_var_list(Types); t_has_var(?tuple(?any, ?any, ?any)) -> false; t_has_var(?tuple(Elements, _, _)) -> @@ -2225,8 +1815,6 @@ t_has_var(?tuple_set(_) = T) -> t_has_var(?map(_, DefK, _)= Map) -> t_has_var_list(map_all_values(Map)) orelse t_has_var(DefK); -t_has_var(?opaque(Set)) -> - t_has_var_list([O#opaque.struct || O <- Set]); t_has_var(?union(List)) -> t_has_var_list(List); t_has_var(_) -> false. @@ -2264,8 +1852,10 @@ t_collect_var_names(?tuple_set(_) = TS, Acc) -> t_collect_var_names(?map(_, DefK, _) = Map, Acc0) -> Acc = t_collect_vars_list(map_all_values(Map), Acc0), t_collect_var_names(DefK, Acc); -t_collect_var_names(?opaque(Set), Acc) -> - t_collect_vars_list([O#opaque.struct || O <- Set], Acc); +t_collect_var_names(?nominal(_, S), Acc) -> + t_collect_var_names(S, Acc); +t_collect_var_names(?nominal_set(N, S), Acc) -> + t_collect_vars_list(N, t_collect_var_names(S, Acc)); t_collect_var_names(?union(List), Acc) -> t_collect_vars_list(List, Acc); t_collect_var_names(_, Acc) -> @@ -2362,12 +1952,7 @@ t_from_range(pos_inf, neg_inf) -> t_none(). -spec number_min(erl_type()) -> rng_elem(). number_min(Type) -> - number_min(Type, 'universe'). - --spec number_min(erl_type(), opaques()) -> rng_elem(). - -number_min(Type, Opaques) -> - do_opaque(Type, Opaques, fun number_min2/1). + structural(Type, fun number_min2/1). number_min2(?int_range(From, _)) -> From; number_min2(?int_set(Set)) -> set_min(Set); @@ -2376,12 +1961,7 @@ number_min2(?number(?any, _Tag)) -> neg_inf. -spec number_max(erl_type()) -> rng_elem(). number_max(Type) -> - number_max(Type, 'universe'). - --spec number_max(erl_type(), opaques()) -> rng_elem(). - -number_max(Type, Opaques) -> - do_opaque(Type, Opaques, fun number_max2/1). + structural(Type, fun number_max2/1). number_max2(?int_range(_, To)) -> To; number_max2(?int_set(Set)) -> set_max(Set); @@ -2454,40 +2034,43 @@ any_any([]) -> false. t_sup1([H|T], Type) -> t_sup1(T, t_sup(H, Type)); t_sup1([], Type) -> - do_not_subst_all_vars_to_any(Type). + Type. -spec t_sup(erl_type(), erl_type()) -> erl_type(). -t_sup(?any, _) -> ?any; -t_sup(_, ?any) -> ?any; -t_sup(?none, T) -> T; -t_sup(T, ?none) -> T; -t_sup(?unit, T) -> T; -t_sup(T, ?unit) -> T; -t_sup(T, T) -> do_not_subst_all_vars_to_any(T); -t_sup(?var(_), _) -> ?any; -t_sup(_, ?var(_)) -> ?any; -t_sup(?atom(Set1), ?atom(Set2)) -> +t_sup(T1, T2) -> + Res = t_sup_aux(T1, T2), + %% `Res` must be at least as general as both `T1` and `T2`. + ?debug(t_is_subtype(subst_all_vars_to_any(T1), Res) andalso + t_is_subtype(subst_all_vars_to_any(T2), Res), + {T1, T2, Res}), + Res. + +t_sup_aux(?any, _) -> ?any; +t_sup_aux(_, ?any) -> ?any; +t_sup_aux(?none, T) -> T; +t_sup_aux(T, ?none) -> T; +t_sup_aux(?unit, T) -> T; +t_sup_aux(T, ?unit) -> T; +t_sup_aux(T, T) -> T; +t_sup_aux(?opaque, T) -> T; +t_sup_aux(T, ?opaque) -> T; +t_sup_aux(?var(_), _) -> ?any; +t_sup_aux(_, ?var(_)) -> ?any; +t_sup_aux(?atom(Set1), ?atom(Set2)) -> ?atom(set_union(Set1, Set2)); -t_sup(?bitstr(U1, B1), ?bitstr(U2, B2)) -> +t_sup_aux(?bitstr(U1, B1), ?bitstr(U2, B2)) -> t_bitstr(gcd(gcd(U1, U2), abs(B1-B2)), lists:min([B1, B2])); -t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) -> +t_sup_aux(?function(Domain1, Range1), ?function(Domain2, Range2)) -> %% The domain is either a product or any. - ?function(t_sup(Domain1, Domain2), t_sup(Range1, Range2)); -t_sup(?identifier(Set1), ?identifier(Set2)) -> + ?function(t_sup_aux(Domain1, Domain2), t_sup_aux(Range1, Range2)); +t_sup_aux(?identifier(Set1), ?identifier(Set2)) -> ?identifier(set_union(Set1, Set2)); -t_sup(?opaque(Set1), ?opaque(Set2)) -> - sup_opaque(ordsets:union(Set1, Set2)); -%%Disallow unions with opaque types -%%t_sup(T1=?opaque(_,_,_), T2) -> -%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; -%%t_sup(T1, T2=?opaque(_,_,_)) -> -%% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; -t_sup(?nil, ?list(Contents, Termination, _)) -> - ?list(Contents, t_sup(?nil, Termination), ?unknown_qual); -t_sup(?list(Contents, Termination, _), ?nil) -> - ?list(Contents, t_sup(?nil, Termination), ?unknown_qual); -t_sup(?list(Contents1, Termination1, Size1), +t_sup_aux(?nil, ?list(Contents, Termination, _)) -> + ?list(Contents, t_sup_aux(?nil, Termination), ?unknown_qual); +t_sup_aux(?list(Contents, Termination, _), ?nil) -> + ?list(Contents, t_sup_aux(?nil, Termination), ?unknown_qual); +t_sup_aux(?list(Contents1, Termination1, Size1), ?list(Contents2, Termination2, Size2)) -> NewSize = case {Size1, Size2} of @@ -2496,43 +2079,43 @@ t_sup(?list(Contents1, Termination1, Size1), {?nonempty_qual, ?unknown_qual} -> ?unknown_qual; {?nonempty_qual, ?nonempty_qual} -> ?nonempty_qual end, - NewContents = t_sup(Contents1, Contents2), - NewTermination = t_sup(Termination1, Termination2), + NewContents = t_sup_aux(Contents1, Contents2), + NewTermination = t_sup_aux(Termination1, Termination2), ?list(NewContents, NewTermination, NewSize); -t_sup(?number(_, _), ?number(?any, ?unknown_qual) = T) -> T; -t_sup(?number(?any, ?unknown_qual) = T, ?number(_, _)) -> T; -t_sup(?float, ?integer(_)) -> t_number(); -t_sup(?integer(_), ?float) -> t_number(); -t_sup(?integer(?any) = T, ?integer(_)) -> T; -t_sup(?integer(_), ?integer(?any) = T) -> T; -t_sup(?int_set(Set1), ?int_set(Set2)) -> +t_sup_aux(?number(_, _), ?number(?any, ?unknown_qual) = T) -> T; +t_sup_aux(?number(?any, ?unknown_qual) = T, ?number(_, _)) -> T; +t_sup_aux(?float, ?integer(_)) -> t_number(); +t_sup_aux(?integer(_), ?float) -> t_number(); +t_sup_aux(?integer(?any) = T, ?integer(_)) -> T; +t_sup_aux(?integer(_), ?integer(?any) = T) -> T; +t_sup_aux(?int_set(Set1), ?int_set(Set2)) -> case set_union(Set1, Set2) of ?any -> t_from_range(min(set_min(Set1), set_min(Set2)), max(set_max(Set1), set_max(Set2))); Set -> ?int_set(Set) end; -t_sup(?int_range(From1, To1), ?int_range(From2, To2)) -> +t_sup_aux(?int_range(From1, To1), ?int_range(From2, To2)) -> t_from_range(min(From1, From2), max(To1, To2)); -t_sup(Range = ?int_range(_, _), ?int_set(Set)) -> +t_sup_aux(Range = ?int_range(_, _), ?int_set(Set)) -> expand_range_from_set(Range, Set); -t_sup(?int_set(Set), Range = ?int_range(_, _)) -> +t_sup_aux(?int_set(Set), Range = ?int_range(_, _)) -> expand_range_from_set(Range, Set); -t_sup(?product(Types1), ?product(Types2)) -> +t_sup_aux(?product(Types1), ?product(Types2)) -> L1 = length(Types1), L2 = length(Types2), if L1 =:= L2 -> ?product(t_sup_lists(Types1, Types2)); true -> ?any end; -t_sup(?product(_), _) -> +t_sup_aux(?product(_), _) -> ?any; -t_sup(_, ?product(_)) -> +t_sup_aux(_, ?product(_)) -> ?any; -t_sup(?tuple(?any, ?any, ?any) = T, ?tuple(_, _, _)) -> T; -t_sup(?tuple(_, _, _), ?tuple(?any, ?any, ?any) = T) -> T; -t_sup(?tuple(?any, ?any, ?any) = T, ?tuple_set(_)) -> T; -t_sup(?tuple_set(_), ?tuple(?any, ?any, ?any) = T) -> T; -t_sup(?tuple(Elements1, Arity, Tag1) = T1, +t_sup_aux(?tuple(?any, ?any, ?any) = T, ?tuple(_, _, _)) -> T; +t_sup_aux(?tuple(_, _, _), ?tuple(?any, ?any, ?any) = T) -> T; +t_sup_aux(?tuple(?any, ?any, ?any) = T, ?tuple_set(_)) -> T; +t_sup_aux(?tuple_set(_), ?tuple(?any, ?any, ?any) = T) -> T; +t_sup_aux(?tuple(Elements1, Arity, Tag1) = T1, ?tuple(Elements2, Arity, Tag2) = T2) -> if Tag1 == Tag2 -> t_tuple(t_sup_lists(Elements1, Elements2)); Tag1 == ?any -> t_tuple(t_sup_lists(Elements1, Elements2)); @@ -2540,47 +2123,108 @@ t_sup(?tuple(Elements1, Arity, Tag1) = T1, Tag1 < Tag2 -> ?tuple_set([{Arity, [T1, T2]}]); Tag1 > Tag2 -> ?tuple_set([{Arity, [T2, T1]}]) end; -t_sup(?tuple(_, Arity1, _) = T1, ?tuple(_, Arity2, _) = T2) -> +t_sup_aux(?tuple(_, Arity1, _) = T1, ?tuple(_, Arity2, _) = T2) -> sup_tuple_sets([{Arity1, [T1]}], [{Arity2, [T2]}]); -t_sup(?tuple_set(List1), ?tuple_set(List2)) -> +t_sup_aux(?tuple_set(List1), ?tuple_set(List2)) -> sup_tuple_sets(List1, List2); -t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> +t_sup_aux(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> sup_tuple_sets(List1, [{Arity, [T2]}]); -t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> +t_sup_aux(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> sup_tuple_sets([{Arity, [T1]}], List2); -t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> +t_sup_aux(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> Pairs = map_pairwise_merge( - fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)}; - (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)} + fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup_aux(V1, V2)}; + (K, _, V1, _, V2) -> {K, ?opt, t_sup_aux(V1, V2)} end, A, B), - t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)); -t_sup(T1, T2) -> + t_map(Pairs, t_sup_aux(ADefK, BDefK), t_sup_aux(ADefV, BDefV)); +%% Union of 1 or more nominal types/nominal sets +t_sup_aux(?nominal(Name, S1), ?nominal(Name, S2)) -> + ?nominal(Name, t_sup_aux(S1, S2)); +t_sup_aux(?nominal(LHS_Name, ?nominal(LHS_InnerName, _)=LHS_Inner)=LHS, + ?nominal(RHS_Name, ?nominal(RHS_InnerName, _)=RHS_Inner)=RHS) -> + case t_sup_aux(LHS_Inner, RHS_Inner) of + ?nominal(LHS_InnerName = RHS_Name, _)=Sup -> + ?nominal(RHS_Name, Sup); + ?nominal(RHS_InnerName = LHS_Name, _)=Sup -> + ?nominal(LHS_Name, Sup); + ?nominal_set(_, ?none) when LHS_Name < RHS_Name -> + ?nominal_set([LHS, RHS], ?none); + ?nominal_set(_, ?none) -> + ?nominal_set([RHS, LHS], ?none) + end; +t_sup_aux(?nominal(LHS_Name, ?nominal(_, _)=LHS_Inner), + ?nominal(_, ?nominal_set(_, _))=RHS) -> + t_sup_aux(?nominal(LHS_Name, ?nominal_set([LHS_Inner], ?none)), RHS); +t_sup_aux(?nominal(_, ?nominal_set(_, _))=LHS, + ?nominal(_, ?nominal(_, _))=RHS) -> + t_sup_aux(RHS, LHS); +t_sup_aux(?nominal(LHS_Name, ?nominal(LHS_InnerName, _)=LHS_Inner)=LHS, + ?nominal(RHS_Name, _)=RHS) -> + case t_sup_aux(LHS_Inner, RHS) of + ?nominal_set(_, ?none) when LHS_Name < RHS_Name -> + ?nominal_set([LHS, RHS], ?none); + ?nominal_set(_, ?none) -> + ?nominal_set([RHS, LHS], ?none); + ?nominal(RHS_Name, _)=Sup -> + Sup; + ?nominal(LHS_InnerName, _)=Sup -> + ?nominal(LHS_Name, Sup) + end; +t_sup_aux(?nominal(_, _)=LHS, ?nominal(_, ?nominal(_,_))=RHS) -> + t_sup_aux(RHS, LHS); +t_sup_aux(?nominal(LHS_Name, ?nominal_set(L_Ns, L_S)), + ?nominal(RHS_Name, ?nominal_set(R_Ns, R_S))) -> + Sup0 = t_sup_aux(?nominal(LHS_Name, L_S), + ?nominal(RHS_Name, R_S)), + LHS_Expanded = [?nominal(LHS_Name, N) || N <- L_Ns], + RHS_Expanded = [?nominal(RHS_Name, N) || N <- R_Ns], + Sup = lists:foldl(fun t_sup_aux/2, Sup0, LHS_Expanded), + lists:foldl(fun t_sup_aux/2, Sup, RHS_Expanded); +t_sup_aux(?nominal(LHS_Name, ?nominal_set(L_Ns, L_S)), + ?nominal(_, _)=RHS) -> + LHS_Expanded = [?nominal(LHS_Name, N) || N <- L_Ns], + Sup = nominal_set_absorb(LHS_Expanded, RHS, []), + t_sup_aux(Sup, ?nominal(LHS_Name, L_S)); +t_sup_aux(?nominal(_, _)=LHS, ?nominal(_, ?nominal_set(_,_))=RHS) -> + t_sup_aux(RHS, LHS); +t_sup_aux(?nominal(LHS_Name, _)=LHS, ?nominal(RHS_Name, _)=RHS) -> + case LHS_Name < RHS_Name of + true -> ?nominal_set([LHS, RHS], ?none); + false -> ?nominal_set([RHS, LHS], ?none) + end; +t_sup_aux(?nominal_set(LHS_Ns, LHS_S), ?nominal_set(RHS_Ns, RHS_S)) -> + Sup0 = t_sup_aux(LHS_S, RHS_S), + ?debug(not t_is_nominal(Sup0), {LHS_S, RHS_S}), + Sup = lists:foldl(fun t_sup_aux/2, Sup0, LHS_Ns), + lists:foldl(fun t_sup_aux/2, Sup, RHS_Ns); +t_sup_aux(?nominal_set(LHS_Ns, ?none), ?nominal(_, _)=RHS) -> + nominal_set_absorb(LHS_Ns, RHS, []); +t_sup_aux(?nominal_set(LHS_Ns, Other), ?nominal(_, _)=RHS) -> + t_sup_aux(t_sup_aux(?nominal_set(LHS_Ns, ?none), RHS), Other); +t_sup_aux(?nominal(_, _)=LHS, ?nominal_set(_, _)=RHS) -> + t_sup_aux(RHS, LHS); +t_sup_aux(?nominal(_,LHS_S)=LHS, RHS) -> + ?debug(not t_is_nominal(RHS), RHS), + Inf = t_inf_aux(LHS_S, RHS), + case t_is_impossible(Inf) of + true -> ?nominal_set([LHS], RHS); + false -> t_sup_aux(LHS_S, RHS) + end; +t_sup_aux(LHS, ?nominal(_, _)=RHS) -> + ?debug(not t_is_nominal(LHS), LHS), + t_sup_aux(RHS, LHS); +t_sup_aux(?nominal_set(LHS_Ns, LHS_S), RHS) -> + ?debug(not t_is_nominal(RHS), RHS), + normalize_nominal_set(LHS_Ns, t_sup_aux(LHS_S, RHS), []); +t_sup_aux(LHS, ?nominal_set(_, _)=RHS) -> + ?debug(not t_is_nominal(LHS), LHS), + t_sup_aux(RHS, LHS); +t_sup_aux(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), sup_union(U1, U2). -sup_opaque([]) -> ?none; -sup_opaque(List) -> - L = sup_opaq(List), - ?opaque(ordsets:from_list(L)). - -sup_opaq(L0) -> - L1 = [{{Mod,Name,Arity}, T} || - #opaque{mod = Mod, name = Name, arity = Arity}=T <- L0], - F = dialyzer_utils: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]) -> @@ -2588,6 +2232,73 @@ t_sup_lists([T1|Left1], [T2|Left2]) -> t_sup_lists([], []) -> []. +%% Adds the new nominal `Sup` into the set of nominals `Ns0`. Note that it does +%% not handle structurals; the caller is expected to normalize the result +%% afterwards. +nominal_set_absorb([?nominal(_, _)=N | Ns0], Sup, Acc) -> + ?debug(t_is_nominal(Sup), Sup), + case t_inf_aux(N, Sup) of + ?nominal(_, _) -> + %% The types overlap, abort and start over with the widened type. + t_sup_aux(?nominal_set(lists:reverse(Acc, Ns0), ?none), + t_sup_aux(N, Sup)); + ?none -> + nominal_set_absorb(Ns0, Sup, [N | Acc]) + end; +nominal_set_absorb([], Sup, Acc) -> + ?debug(t_is_nominal(Sup), Sup), + Ns = nominal_set_absorb_merge(Acc, Sup, []), + ?debug(begin + Names = [Name || ?nominal(Name, _) <- Ns], + Names =:= lists:usort(Names) + end, {Sup, Acc, Ns}), + ?nominal_set(Ns, ?none). + +nominal_set_absorb_merge([?nominal(Same, LHS_S) | Rest], + ?nominal(Same, RHS_S), Acc) -> + lists:reverse([?nominal(Same, t_sup_aux(LHS_S, RHS_S)) | Rest], Acc); +nominal_set_absorb_merge([?nominal(LHS_Name, _)=LHS | Rest], + ?nominal(RHS_Name, _)=RHS, Acc) + when LHS_Name > RHS_Name -> + %% Note that the list is reversed, so '>' puts this in ascending order. + nominal_set_absorb_merge(Rest, RHS, [LHS | Acc]); +nominal_set_absorb_merge(Rest, RHS, Acc) -> + lists:reverse([RHS | Rest], Acc). + +normalize_nominal_set(_, ?any, _) -> + ?any; +normalize_nominal_set([], Other, []) -> + ?debug(not t_is_nominal(Other), Other), + Other; +normalize_nominal_set([], ?none, [?nominal(_, _) = N]) -> + N; +normalize_nominal_set([], Other, Nominals0) -> + %% Names must be unique and in the correct order. + Nominals = lists:reverse(Nominals0), + ?debug(begin + Names = [Name || ?nominal(Name, _) <- Nominals], + Names =:= lists:usort(Names) + end, Nominals), + ?nominal_set(Nominals, Other); +normalize_nominal_set([?nominal(_, _)=Type | Types], ?none, Nominals) -> + normalize_nominal_set(Types, ?none, [Type | Nominals]); +normalize_nominal_set([?none | Types], Other, Nominals) -> + normalize_nominal_set(Types, Other, Nominals); +normalize_nominal_set([Type | Types], Other, Nominals) -> + case t_inf_aux(Type, Other) of + ?none -> + %% The `Other` type does not overlap with the nominal type, include it + %% in the new nominal list. + ?nominal(_, _) = Type, %Assertion. + normalize_nominal_set(Types, Other, [Type | Nominals]); + _ -> + %% `Type` is structural (can happen during limiting) or overlaps with + %% `Other0`, start over since the new `Other` type could overlap with + %% previously-handled nominals. + t_sup_aux(?nominal_set(lists:reverse(Nominals, Types), ?none), + t_sup_aux(Type, Other)) + end. + sup_tuple_sets(L1, L2) -> TotalArities = ordsets:union([Arity || {Arity, _} <- L1], [Arity || {Arity, _} <- L2]), @@ -2651,6 +2362,8 @@ sup_tuples_in_set([], L2, Acc) -> lists:reverse(Acc, L2); sup_tuples_in_set(L1, [], Acc) -> lists:reverse(Acc, L1). sup_union(U1, U2) -> + true = length(U1) =:= length(U2), %Assertion. + true = ?num_types_in_union =:= length(U1), %Assertion sup_union(U1, U2, 0, []). sup_union([?none|Left1], [?none|Left2], N, Acc) -> @@ -2665,7 +2378,10 @@ sup_union([], [], N, Acc) -> [Type] = [T || T <- Acc, T =/= ?none], Type; N =:= ?num_types_in_union -> - ?any; + case Acc =:= [t_tuple(), t_map(), ?any, t_number(), t_list(), t_identifier(), t_fun(), t_bitstr(), t_atom()] of + true -> ?any; + false -> ?union(lists:reverse(Acc)) + end; true -> ?union(lists:reverse(Acc)) end. @@ -2677,7 +2393,6 @@ force_union(T = ?identifier(_)) -> ?identifier_union(T); force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); -force_union(T = ?opaque(_)) -> ?opaque_union(T); force_union(T = ?map(_,_,_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); @@ -2687,25 +2402,23 @@ force_union(T = ?union(_)) -> T. %% An attempt to write the inverse operation of t_sup/1 -- XXX: INCOMPLETE !! %% -spec t_elements(erl_type()) -> [erl_type()]. -t_elements(T) -> - t_elements(T, 'universe'). - --spec t_elements(erl_type(), opaques()) -> [erl_type()]. - -t_elements(?none, _Opaques) -> []; -t_elements(?unit, _Opaques) -> []; -t_elements(?any = T, _Opaques) -> [T]; -t_elements(?nil = T, _Opaques) -> [T]; -t_elements(?atom(?any) = T, _Opaques) -> [T]; -t_elements(?atom(Atoms), _Opaques) -> +t_elements(?none) -> []; +t_elements(?unit) -> []; +t_elements(?any = T) -> [T]; +t_elements(?nil = T) -> [T]; +t_elements(?atom(?any) = T) -> [T]; +t_elements(?atom(Atoms)) -> [t_atom(A) || A <- Atoms]; -t_elements(?bitstr(_, _) = T, _Opaques) -> [T]; -t_elements(?function(_, _) = T, _Opaques) -> [T]; -t_elements(?identifier(?any) = T, _Opaques) -> [T]; -t_elements(?identifier(IDs), _Opaques) -> +t_elements(?bitstr(_, _) = T) -> [T]; +t_elements(?function(_, _) = T) -> [T]; +t_elements(?identifier(?any) = T) -> [T]; +t_elements(?identifier(IDs)) -> [?identifier([T]) || T <- IDs]; -t_elements(?list(_, _, _) = T, _Opaques) -> [T]; -t_elements(?number(_, _) = T, _Opaques) -> +t_elements(?nominal(_, _) = T) -> [T]; +t_elements(?nominal_set(Ns, S)) -> + t_elements(S) ++ Ns; +t_elements(?list(_, _, _) = T) -> [T]; +t_elements(?number(_, _) = T) -> case T of ?number(?any, ?unknown_qual) -> [?float, ?integer(?any)]; @@ -2715,30 +2428,26 @@ t_elements(?number(_, _) = T, _Opaques) -> ?int_set(Set) -> [t_integer(I) || I <- Set] end; -t_elements(?opaque(_) = T, Opaques) -> - do_elements(T, Opaques); -t_elements(?map(_,_,_) = T, _Opaques) -> [T]; -t_elements(?tuple(_, _, _) = T, _Opaques) -> [T]; -t_elements(?tuple_set(_) = TS, _Opaques) -> +t_elements(?map(_,_,_) = T) -> [T]; +t_elements(?product(_) = T) -> [T]; +t_elements(?tuple(_, _, _) = T) -> [T]; +t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of unknown -> []; Elems -> Elems end; -t_elements(?union(_) = T, Opaques) -> - do_elements(T, Opaques); -t_elements(?var(_), _Opaques) -> [?any]. %% yes, vars exist -- what else to do here? +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, Opaques) -> - case do_opaque(Type0, Opaques, fun(T) -> T end) of +do_elements(Type0) -> + case structural(Type0, fun(T) -> T end) of ?union(List) -> - lists:append([t_elements(T, Opaques) || T <- List]); - ?opaque(_)=Type -> - %% We lack insight into this opaque type, return it as-is. - [Type]; + lists:append([t_elements(T) || T <- List]); Type -> - t_elements(Type, Opaques) + t_elements(Type) end. %%----------------------------------------------------------------------------- @@ -2758,53 +2467,55 @@ t_inf([]) -> ?none. -spec t_inf(erl_type(), erl_type()) -> erl_type(). t_inf(T1, T2) -> - t_inf(T1, T2, 'universe'). - -%% 'match' should be used from t_find_unknown_opaque() only --type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. - --spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). - -t_inf(?var(_), ?var(_), _Opaques) -> ?any; -t_inf(?var(_), T, _Opaques) -> do_not_subst_all_vars_to_any(T); -t_inf(T, ?var(_), _Opaques) -> do_not_subst_all_vars_to_any(T); -t_inf(?any, T, _Opaques) -> do_not_subst_all_vars_to_any(T); -t_inf(T, ?any, _Opaques) -> do_not_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) -> do_not_subst_all_vars_to_any(T); -t_inf(?atom(Set1), ?atom(Set2), _) -> + Res = t_inf_aux(T1, T2), + %% `Res` must be at least as specific as `T1` and `T2` + ?debug(t_is_subtype(subst_all_vars_to_any(Res), + subst_all_vars_to_any(T1)) andalso + t_is_subtype(subst_all_vars_to_any(Res), + subst_all_vars_to_any(T2)), + {T1, T2, Res}), + Res. + +t_inf_aux(?var(_), ?var(_)) -> ?any; +t_inf_aux(?var(_), T) -> T; +t_inf_aux(T, ?var(_)) -> T; +t_inf_aux(?any, T) -> T; +t_inf_aux(T, ?any) -> T; +t_inf_aux(?none, _) -> ?none; +t_inf_aux(_, ?none) -> ?none; +t_inf_aux(?unit, _) -> ?unit; % ?unit cases should appear below ?none +t_inf_aux(_, ?unit) -> ?unit; +t_inf_aux(T, T) -> T; +t_inf_aux(?atom(Set1), ?atom(Set2)) -> case set_intersection(Set1, Set2) of ?none -> ?none; NewSet -> ?atom(NewSet) end; -t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Opaques) -> +t_inf_aux(?bitstr(U1, B1), ?bitstr(0, B2)) -> if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2); true -> ?none end; -t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Opaques) -> +t_inf_aux(?bitstr(0, B1), ?bitstr(U2, B2)) -> if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1); true -> ?none end; -t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Opaques) -> +t_inf_aux(?bitstr(U1, B1), ?bitstr(U1, B1)) -> t_bitstr(U1, B1); -t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) when U2 > U1 -> +t_inf_aux(?bitstr(U1, B1), ?bitstr(U2, B2)) when U2 > U1 -> inf_bitstr(U2, B2, U1, B1); -t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) -> +t_inf_aux(?bitstr(U1, B1), ?bitstr(U2, B2)) -> inf_bitstr(U1, B1, U2, B2); -t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Opaques) -> - case t_inf(Domain1, Domain2, Opaques) of +t_inf_aux(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + case t_inf_aux(Domain1, Domain2) of ?none -> ?none; - Domain -> ?function(Domain, t_inf(Range1, Range2, Opaques)) + Domain -> ?function(Domain, t_inf_aux(Range1, Range2)) end; -t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> +t_inf_aux(?identifier(Set1), ?identifier(Set2)) -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; -t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> +t_inf_aux(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> %% Because it simplifies the anonymous function, we allow Pairs to temporarily %% contain mandatory pairs with none values, since all such cases should %% result in a none result. @@ -2812,27 +2523,109 @@ t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> map_pairwise_merge( %% For optional keys in both maps, when the infimum is none, we have %% essentially concluded that K must not be a key in the map. - fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)}; + fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf_aux(V1, V2)}; %% When a key is optional in one map, but mandatory in another, it %% becomes mandatory in the infinumum - (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)} + (K, _, V1, _, V2) -> {K, ?mand, t_inf_aux(V1, V2)} end, A, B), - t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV)); -t_inf(?nil, ?nil, _Opaques) -> ?nil; -t_inf(?nil, ?nonempty_list(_, _), _Opaques) -> + t_map(Pairs, + t_inf_aux(ADefK, BDefK), + t_inf_aux(ADefV, BDefV)); +%% Intersection of 1 or more nominal types +t_inf_aux(?nominal(Same, LHS_S), ?nominal(Same, RHS_S)) -> + t_nominal(Same, t_inf_aux(LHS_S, RHS_S)); +t_inf_aux(?nominal(LHS_Name, ?nominal(LHS_InnerName, _)=LHS_Inner), + ?nominal(RHS_Name, ?nominal(RHS_InnerName, _)=RHS_Inner)) -> + %% As the names of these nominals differ, they can only intersect if LHS is + %% a nominal subtype of RHS_Inner or if RHS is a nominal subtype of LHS + %% inner, for example: + %% + %% t_nominal(alpha, t_nominal(beta, t_nominal(gamma, any()))) = LHS + %% t_nominal(beta, t_nominal(gamma, t_atom())) = RHS + %% => + %% t_nominal(alpha, t_nominal(beta, t_nominal(gamma, t_atom()))) = Res + %% + %% Note that nested nominals only intersect with nominals that share the + %% same nesting: in a sense, you can say that the effective name of a nominal + %% is the sum of its nesting. Thus, the following do not intersect despite + %% being `alpha`s that are subtype of `gamma`s: + %% + %% t_nominal(alpha, t_nominal(beta, t_nominal(gamma, any()))) = LHS + %% t_nominal(alpha, t_nominal(gamma, t_atom())) = RHS + %% + %% These rules are described in "Nominal Types for Erlang" by Huang et al, + %% https://doi.org/10.1145/3677995.3678191 + case t_inf_aux(LHS_Inner, RHS_Inner) of + ?nominal(LHS_InnerName = RHS_Name, _)=Inf -> ?nominal(LHS_Name, Inf); + ?nominal(RHS_InnerName = LHS_Name, _)=Inf -> ?nominal(RHS_Name, Inf); + _ -> ?none + end; +t_inf_aux(?nominal(LHS_Name, ?nominal_set(L_Ns, L_S)), + ?nominal(RHS_Name, ?nominal_set(R_Ns, R_S))) -> + %% As inf_nominal_sets/2 can handle non-normalized sets, we can simplify + %% crossing the lists by wrapping each nominal in the respective sets with + %% their outer name and letting the regular nested nominal clause handle it. + [_|_] = L_Ns, %Assertion. + LHS_Expanded = + [?nominal(LHS_Name, L_S) | [?nominal(LHS_Name, N) || N <- L_Ns]], + [_|_] = R_Ns, %Assertion. + RHS_Expanded = + [?nominal(RHS_Name, R_S) | [?nominal(RHS_Name, N) || N <- R_Ns]], + case inf_nominal_sets(LHS_Expanded, RHS_Expanded) of + ?nominal(LHS_Name, _)=Inf -> Inf; + ?nominal(RHS_Name, _)=Inf -> Inf; + ?none -> ?none + end; +t_inf_aux(?nominal(LHS_Name, ?nominal(_, _)=LHS_Inner), + ?nominal(_, ?nominal_set(_, _))=RHS) -> + t_inf_aux(?nominal(LHS_Name, ?nominal_set([LHS_Inner], ?none)), RHS); +t_inf_aux(?nominal(_, ?nominal_set(_, _))=LHS, + ?nominal(RHS_Name, ?nominal(_, _)=RHS_Inner)) -> + t_inf_aux(LHS, ?nominal(RHS_Name, ?nominal_set([RHS_Inner], ?none))); +t_inf_aux(?nominal(LHS_Name, ?nominal_set(_, _))=LHS, + ?nominal(_, _)=RHS) -> + t_inf_aux(LHS, ?nominal(LHS_Name, RHS)); +t_inf_aux(?nominal(_, _)=LHS, + ?nominal(_, ?nominal_set(_, _))=RHS) -> + t_inf_aux(RHS, LHS); +t_inf_aux(?nominal(LHS_Name, ?nominal(_, _))=LHS, + ?nominal(_, _)=RHS) -> + t_inf_aux(LHS, ?nominal(LHS_Name, RHS)); +t_inf_aux(?nominal(_, _)=LHS, + ?nominal(_, ?nominal(_, _))=RHS) -> + t_inf_aux(RHS, LHS); +t_inf_aux(?nominal_set(LHS_Ns, LHS_S), + ?nominal_set(RHS_Ns, RHS_S)) -> + inf_nominal_sets([LHS_S | LHS_Ns], [RHS_S | RHS_Ns]); +t_inf_aux(?nominal_set(LHS_Ns, LHS_S), ?nominal(_, _)=RHS) -> + inf_nominal_sets([LHS_S | LHS_Ns], [RHS]); +t_inf_aux(?nominal(_, _)=LHS, ?nominal_set(RHS_Ns, RHS_S)) -> + inf_nominal_sets([LHS], [RHS_S | RHS_Ns]); +t_inf_aux(?nominal_set(LHS_Ns, LHS_S), RHS) -> + inf_nominal_sets([LHS_S | LHS_Ns], [RHS]); +t_inf_aux(LHS, ?nominal_set(_, _)=RHS) -> + t_inf_aux(RHS, LHS); +t_inf_aux(?nominal(_, _), ?nominal(_, _)) -> + ?none; +t_inf_aux(?nominal(LHS_Name, LHS_S), RHS_S) -> + t_nominal(LHS_Name, t_inf_aux(LHS_S, RHS_S)); +t_inf_aux(LHS, ?nominal(_, _)=RHS) -> + t_inf_aux(RHS, LHS); +t_inf_aux(?nil, ?nil) -> ?nil; +t_inf_aux(?nil, ?nonempty_list(_, _)) -> ?none; -t_inf(?nonempty_list(_, _), ?nil, _Opaques) -> +t_inf_aux(?nonempty_list(_, _), ?nil) -> ?none; -t_inf(?nil, ?list(_Contents, Termination, _), Opaques) -> - t_inf(?nil, t_unopaque(Termination), Opaques); -t_inf(?list(_Contents, Termination, _), ?nil, Opaques) -> - t_inf(?nil, t_unopaque(Termination), Opaques); -t_inf(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2), Opaques) -> - case t_inf(Termination1, Termination2, Opaques) of +t_inf_aux(?nil, ?list(_Contents, Termination, _)) -> + t_inf_aux(?nil, t_structural(Termination)); +t_inf_aux(?list(_Contents, Termination, _), ?nil) -> + t_inf_aux(?nil, t_structural(Termination)); +t_inf_aux(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> + case t_inf_aux(Termination1, Termination2) of ?none -> ?none; Termination -> - case t_inf(Contents1, Contents2, Opaques) of + case t_inf_aux(Contents1, Contents2) of ?none -> %% If none of the lists are nonempty, then the infimum is nil. case (Size1 =:= ?unknown_qual) andalso (Size2 =:= ?unknown_qual) of @@ -2850,7 +2643,7 @@ t_inf(?list(Contents1, Termination1, Size1), ?list(Contents, Termination, Size) end end; -t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> +t_inf_aux(?number(_, _) = T1, ?number(_, _) = T2) -> case {T1, T2} of {T, T} -> T; {_, ?number(?any, ?unknown_qual)} -> T1; @@ -2867,13 +2660,11 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> {?int_range(From1, To1), ?int_range(From2, To2)} -> t_from_range(max(From1, From2), min(To1, To2)); {Range = ?int_range(_, _), ?int_set(Set)} -> - %% io:format("t_inf range, set args ~p ~p ~n", [T1, T2]), Ans2 = case set_filter(fun(X) -> in_range(X, Range) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) end, - %% io:format("Ans2 ~p ~n", [Ans2]), Ans2; {?int_set(Set), ?int_range(_, _) = Range} -> case set_filter(fun(X) -> in_range(X, Range) end, Set) of @@ -2881,276 +2672,189 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> NewSet -> ?int_set(NewSet) end end; -t_inf(?product(Types1), ?product(Types2), Opaques) -> - L1 = length(Types1), - L2 = length(Types2), - if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Opaques)); - true -> ?none +t_inf_aux(?product(Types1), ?product(Types2)) -> + case {length(Types1), length(Types2)} of + {Same, Same} -> ?product(t_inf_lists(Types1, Types2)); + _ -> ?none end; -t_inf(?product(_), _, _Opaques) -> +t_inf_aux(?product(_), _) -> ?none; -t_inf(_, ?product(_), _Opaques) -> +t_inf_aux(_, ?product(_)) -> ?none; -t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Opaques) -> - do_not_subst_all_vars_to_any(T); -t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Opaques) -> - do_not_subst_all_vars_to_any(T); -t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Opaques) -> - do_not_subst_all_vars_to_any(T); -t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Opaques) -> - do_not_subst_all_vars_to_any(T); -t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Opaques) -> - case t_inf_lists_strict(Elements1, Elements2, Opaques) of +t_inf_aux(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T) -> + T; +t_inf_aux(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any)) -> + T; +t_inf_aux(?tuple(?any, ?any, ?any), ?tuple_set(_) = T) -> + T; +t_inf_aux(?tuple_set(_) = T, ?tuple(?any, ?any, ?any)) -> + T; +t_inf_aux(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2)) -> + case t_inf_lists_strict(Elements1, Elements2) of bottom -> ?none; NewElements -> t_tuple(NewElements) end; -t_inf(?tuple_set(List1), ?tuple_set(List2), Opaques) -> - inf_tuple_sets(List1, List2, Opaques); -t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> - inf_tuple_sets(List, [{Arity, [T]}], Opaques); -t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Opaques) -> - inf_tuple_sets(List, [{Arity, [T]}], Opaques); -%% be careful: here and in the next clause T can be ?opaque -t_inf(?union(U1), T, Opaques) -> +t_inf_aux(?tuple_set(List1), ?tuple_set(List2)) -> + inf_tuple_sets(List1, List2); +t_inf_aux(?tuple_set(List), ?tuple(_, Arity, _) = T) -> + inf_tuple_sets(List, [{Arity, [T]}]); +t_inf_aux(?tuple(_, Arity, _) = T, ?tuple_set(List)) -> + inf_tuple_sets(List, [{Arity, [T]}]); +t_inf_aux(?opaque, _) -> + ?none; +t_inf_aux(_, ?opaque) -> + ?none; +t_inf_aux(?union(U1), T) -> ?union(U2) = force_union(T), - inf_union(U1, U2, Opaques); -t_inf(T, ?union(U2), Opaques) -> + inf_union(U1, U2); +t_inf_aux(T, ?union(U2)) -> ?union(U1) = force_union(T), - inf_union(U1, U2, Opaques); -t_inf(?opaque(Set1), ?opaque(Set2), Opaques) -> - inf_opaque(Set1, Set2, Opaques); -t_inf(?opaque(_) = T1, T2, Opaques) -> - inf_opaque1(T2, T1, 1, Opaques); -t_inf(T1, ?opaque(_) = T2, Opaques) -> - inf_opaque1(T1, T2, 2, Opaques); -%% and as a result, the cases for ?opaque should appear *after* ?union -t_inf(#c{}, #c{}, _) -> + inf_union(U1, U2); +t_inf_aux(#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 -> - case inf_collect(T1, Set2, Opaques, []) of - [] -> ?none; - OpL -> ?opaque(ordsets:from_list(OpL)) - end - end. - -inf_is_opaque_type(T, Pos, {match, Opaques}) -> - is_opaque_type(T, Opaques) orelse throw({pos, [Pos]}); -inf_is_opaque_type(T, _Pos, Opaques) -> - is_opaque_type(T, Opaques). - -inf_collect(T1, [T2|List2], Opaques, OpL) -> - #opaque{struct = S2} = T2, - case t_inf(T1, S2, Opaques) of - ?none -> inf_collect(T1, List2, Opaques, OpL); - Inf -> - Op = T2#opaque{struct = Inf}, - inf_collect(T1, List2, Opaques, [Op|OpL]) - end; -inf_collect(_T1, [], _Opaques, OpL) -> - OpL. - -combine(S, T1, T2) -> - case is_compat_opaque_names(T1, T2) of - true -> combine(S, [T1]); - false -> combine(S, [T1, T2]) - end. - -combine(?opaque(Set), Ts) -> - [comb2(O, T) || O <- Set, T <- Ts]; -combine(S, Ts) -> - [T#opaque{struct = S} || T <- Ts]. - -comb2(O, T) -> - case is_compat_opaque_names(O, T) of - true -> O; - false -> T#opaque{struct = ?opaque(set_singleton(O))} - end. - -%% Combining two lists this way can be very time consuming... -%% Note: two parameterized opaque types are not the same if their -%% actual parameters differ -inf_opaque(Set1, Set2, Opaques) -> - List1 = inf_look_up(Set1, Opaques), - List2 = inf_look_up(Set2, Opaques), - List0 = [combine(Inf, T1, T2) || - {Is1, T1} <- List1, - {Is2, T2} <- List2, - not t_is_none(Inf = inf_opaque_types(Is1, T1, Is2, T2, Opaques))], - List = lists:append(List0), - sup_opaque(List). - -%% Optimization: do just one lookup. -inf_look_up(Set, Opaques) -> - [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Opaques), T} || - T <- Set]. - -inf_is_opaque_type2(T, {match, Opaques}) -> - is_opaque_type2(T, Opaques); -inf_is_opaque_type2(T, Opaques) -> - is_opaque_type2(T, Opaques). - -inf_opaque_types(IsOpaque1, T1, IsOpaque2, T2, Opaques) -> - #opaque{struct = S1}=T1, - #opaque{struct = S2}=T2, - case - Opaques =:= 'universe' orelse is_compat_opaque_names(T1, T2) - of - true -> t_inf(S1, S2, Opaques); - false -> - case {IsOpaque1, IsOpaque2} of - {true, true} -> t_inf(S1, S2, Opaques); - {true, false} -> t_inf(S1, ?opaque(set_singleton(T2)), Opaques); - {false, true} -> t_inf(?opaque(set_singleton(T1)), S2, Opaques); - {false, false} when element(1, Opaques) =:= match -> - throw({pos, [1, 2]}); - {false, false} -> t_none() - end - end. - -compatible_opaque_types(?opaque(Es1), ?opaque(Es2)) -> - [{O1, O2} || O1 <- Es1, O2 <- Es2, is_compat_opaque_names(O1, O2)]. - -is_compat_opaque_names(Opaque1, Opaque2) -> - #opaque{mod = Mod1, name = Name1, arity = Arity1} = Opaque1, - #opaque{mod = Mod2, name = Name2, arity = Arity2} = Opaque2, - case {{Mod1, Name1, Arity1}, {Mod2, Name2, Arity2}} of - {ModNameArity, ModNameArity} -> true; - _ -> false - end. - -spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()]. -t_inf_lists(L1, L2) -> - t_inf_lists(L1, L2, 'universe'). - --spec t_inf_lists([erl_type()], [erl_type()], t_inf_opaques()) -> [erl_type()]. - -t_inf_lists(L1, L2, Opaques) -> - t_inf_lists(L1, L2, [], Opaques). - --spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> [erl_type()]. - -t_inf_lists([T1|Left1], [T2|Left2], Acc, Opaques) -> - t_inf_lists(Left1, Left2, [t_inf(T1, T2, Opaques)|Acc], Opaques); -t_inf_lists([], [], Acc, _Opaques) -> - lists:reverse(Acc). +t_inf_lists([T1 | Left1], [T2 | Left2]) -> + [t_inf(T1, T2) | t_inf_lists(Left1, Left2)]; +t_inf_lists([], []) -> + []. %% Infimum of lists with strictness. %% If any element is the ?none type, the value 'bottom' is returned. --spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. +-spec t_inf_lists_strict([erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. -t_inf_lists_strict(L1, L2, Opaques) -> - t_inf_lists_strict(L1, L2, [], Opaques). +t_inf_lists_strict(L1, L2) -> + t_inf_lists_strict(L1, L2, []). --spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. - -t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Opaques) -> - case t_inf(T1, T2, Opaques) of +t_inf_lists_strict([T1|Left1], [T2|Left2], Acc) -> + case t_inf(T1, T2) of ?none -> bottom; - T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Opaques) + T -> t_inf_lists_strict(Left1, Left2, [T|Acc]) end; -t_inf_lists_strict([], [], Acc, _Opaques) -> +t_inf_lists_strict([], [], Acc) -> lists:reverse(Acc). -inf_tuple_sets(L1, L2, Opaques) -> - case inf_tuple_sets(L1, L2, [], Opaques) of +inf_nominal_sets([_|_]=LHS, [_|_]=RHS) -> + %% Because a nominal in LHS_Ns can be a subtype of another in RHS_Ns or of + %% the structure in RHS_S (and vice versa), we have to t_inf/2 the cartesian + %% product of both sets. + %% + %% This is quadratic but generally fast enough given the small sizes of the + %% sets. + ins_cartesian(LHS, RHS). + +ins_cartesian([A | As], Bs) -> + case ins_cartesian_1(A, Bs) of + ?none -> ins_cartesian(As, Bs); + T -> t_sup_aux(T, ins_cartesian(As, Bs)) + end; +ins_cartesian([], _Bs) -> + ?none. + +ins_cartesian_1(A, [B | Bs]) -> + case t_inf_aux(A, B) of + ?none -> ins_cartesian_1(A, Bs); + T -> t_sup_aux(T, ins_cartesian_1(A, Bs)) + end; +ins_cartesian_1(_A, []) -> + ?none. + +inf_tuple_sets(L1, L2) -> + case inf_tuple_sets(L1, L2, []) of [] -> ?none; [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple; List -> ?tuple_set(List) end. -inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc, Opaques) -> - case inf_tuples_in_sets(Tuples1, Tuples2, Opaques) of - [] -> inf_tuple_sets(Ts1, Ts2, Acc, Opaques); +inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc) -> + case inf_tuples_in_sets(Tuples1, Tuples2) of + [] -> inf_tuple_sets(Ts1, Ts2, Acc); [?tuple_set([{Arity, NewTuples}])] -> - inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques); - NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques) + inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc]); + NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc]) end; -inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc, Opaques) -> - if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Opaques); - Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Opaques) +inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc) -> + if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc); + Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc) end; -inf_tuple_sets([], _, Acc, _Opaques) -> lists:reverse(Acc); -inf_tuple_sets(_, [], Acc, _Opaques) -> lists:reverse(Acc). +inf_tuple_sets([], _, Acc) -> lists:reverse(Acc); +inf_tuple_sets(_, [], Acc) -> lists:reverse(Acc). -inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Opaques) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) +inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2) -> + NewList = [t_inf_lists_strict(Elements1, Elements2) || ?tuple(Elements2, _, _) <- L2], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; -inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Opaques) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) +inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)]) -> + NewList = [t_inf_lists_strict(Elements1, Elements2) || ?tuple(Elements1, _, _) <- L1], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; -inf_tuples_in_sets(L1, L2, Opaques) -> - inf_tuples_in_sets2(L1, L2, [], Opaques). +inf_tuples_in_sets(L1, L2) -> + inf_tuples_in_sets2(L1, L2, []). 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); + [?tuple(Elements2, Arity, Tag)|Ts2], Acc) -> + case t_inf_lists_strict(Elements1, Elements2) of + bottom -> inf_tuples_in_sets2(Ts1, Ts2, Acc); NewElements -> - inf_tuples_in_sets2(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc], - Opaques) + inf_tuples_in_sets2(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc]) 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) + [?tuple(_, _, Tag2)|Ts2] = L2, Acc) -> + if Tag1 < Tag2 -> inf_tuples_in_sets2(Ts1, L2, Acc); + Tag1 > Tag2 -> inf_tuples_in_sets2(L1, Ts2, Acc) end; -inf_tuples_in_sets2([], _, Acc, _Opaques) -> lists:reverse(Acc); -inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). +inf_tuples_in_sets2([], _, Acc) -> lists:reverse(Acc); +inf_tuples_in_sets2(_, [], Acc) -> lists:reverse(Acc). -inf_union(U1, U2, Opaques) -> +inf_union(U1, U2) -> OpaqueFun = fun(Union1, Union2, InfFun) -> - ?untagged_union(_,_,_,_,_,_,_,Opaque,_) = Union1, - ?untagged_union(A,B,F,I,L,N,T,_,Map) = Union2, + ?untagged_union(_,_,_,_,_,_,_,_) = Union1, + ?untagged_union(A,B,F,I,L,N,T,Map) = Union2, List = [A,B,F,I,L,N,T,Map], - inf_union_collect(List, Opaque, InfFun, [], []) + %% FIXME: Faking ?none opaque -- remove argument. + inf_union_collect(List, InfFun, [], []) end, {O1, ThrowList1} = - OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), + OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E) end), {O2, ThrowList2} = - OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), - {Union, ThrowList3} = inf_union(U1, U2, ?none, [], [], Opaques), + OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque) end), + {Union, ThrowList3} = inf_union(U1, U2, ?none, [], []), ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3), case t_sup([O1, O2, Union]) of ?none when ThrowList =/= [] -> throw({pos, lists:usort(ThrowList)}); Sup -> Sup end. -inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> +inf_union_collect([], _InfFun, InfList, ThrowList) -> {t_sup(InfList), lists:usort(ThrowList)}; -inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) -> - inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList); -inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> - try InfFun(E, Opaque)of +inf_union_collect([?none|L], InfFun, InfList, ThrowList) -> + inf_union_collect(L, InfFun, [?none|InfList], ThrowList); +inf_union_collect([E|L], InfFun, InfList, ThrowList) -> + try InfFun(E, ?none)of Inf -> - inf_union_collect(L, Opaque, InfFun, [Inf|InfList], ThrowList) + inf_union_collect(L, InfFun, [Inf|InfList], ThrowList) catch throw:{pos, Ns} -> - inf_union_collect(L, Opaque, InfFun, InfList, Ns ++ ThrowList) + inf_union_collect(L, InfFun, InfList, Ns ++ ThrowList) end. -inf_union([?none|Left1], [?none|Left2], Type, Acc, ThrowList, Opaques) -> - inf_union(Left1, Left2, Type, [?none|Acc], ThrowList, Opaques); -inf_union([T1|Left1], [T2|Left2], Type, Acc, ThrowList, Opaques) -> - try t_inf(T1, T2, Opaques) of +inf_union([?none|Left1], [?none|Left2], Type, Acc, ThrowList) -> + inf_union(Left1, Left2, Type, [?none|Acc], ThrowList); +inf_union([T1|Left1], [T2|Left2], Type, Acc, ThrowList) -> + try t_inf(T1, T2) of ?none -> - inf_union(Left1, Left2, Type, [?none|Acc], ThrowList, Opaques); + inf_union(Left1, Left2, Type, [?none|Acc], ThrowList); T when Type =:= ?none -> - inf_union(Left1, Left2, T, [T|Acc], ThrowList, Opaques); + inf_union(Left1, Left2, T, [T|Acc], ThrowList); T -> - inf_union(Left1, Left2, ?union_tag, [T|Acc], ThrowList, Opaques) + inf_union(Left1, Left2, ?union_tag, [T|Acc], ThrowList) catch throw:{pos, Ns} -> - inf_union(Left1, Left2, Type, [?none|Acc], Ns ++ ThrowList, Opaques) + inf_union(Left1, Left2, Type, [?none|Acc], Ns ++ ThrowList) end; -inf_union([], [], Type, Acc, ThrowList, _Opaques) -> +inf_union([], [], Type, Acc, ThrowList) -> case Type of ?union_tag -> {?union(lists:reverse(Acc)), ThrowList}; @@ -3182,13 +2886,6 @@ findfirst(N1, N2, U1, B1, U2, B2) -> findfirst(N1_1, N2, U1, B1, U2, B2) end. -%% Optimization. Before Erlang/OTP 25, subst_all_vars_to_any() was -%% called. It turned out that variables are not to be substituted for -%% any() since either there are no variables, or variables are -%% substituted for any() afterwards. -do_not_subst_all_vars_to_any(T) -> - T. - %%----------------------------------------------------------------------------- %% Substitution of variables %% @@ -3229,6 +2926,12 @@ t_subst_aux(?list(Contents, Termination, Size), Map) -> end; t_subst_aux(?function(Domain, Range), Map) -> ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map)); +t_subst_aux(?nominal(N, S), Map) -> + ?nominal(N, t_subst_aux(S, Map)); +t_subst_aux(?nominal_set(N, S), Map) -> + normalize_nominal_set([t_subst_aux(X, Map) || X <- N], + t_subst_aux(S, Map), + []); t_subst_aux(?product(Types), Map) -> ?product([t_subst_aux(T, Map) || T <- Types]); t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) -> @@ -3240,10 +2943,6 @@ t_subst_aux(?tuple_set(_) = TS, Map) -> t_subst_aux(?map(Pairs, DefK, DefV), Map) -> t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs], t_subst_aux(DefK, Map), t_subst_aux(DefV, Map)); -t_subst_aux(?opaque(Es), Map) -> - List = [Opaque#opaque{struct = t_subst_aux(S, Map)} || - Opaque = #opaque{struct = S} <- Es], - ?opaque(ordsets:from_list(List)); t_subst_aux(?union(List), Map) -> ?union([t_subst_aux(E, Map) || E <- List]); t_subst_aux(T, _Map) -> @@ -3273,7 +2972,7 @@ t_unify_table_only(?var(Id1) = LHS, ?var(Id2) = RHS, VarMap) -> #{ Id2 := Type } -> t_unify_table_only(LHS, Type, VarMap); #{} -> - VarMap#{ Id1 => LHS, Id2 => RHS } + VarMap#{ Id1 => LHS, Id2 => LHS } end; t_unify_table_only(?var(Id), Type, VarMap) -> case VarMap of @@ -3292,6 +2991,39 @@ t_unify_table_only(Type, ?var(Id), VarMap) -> t_unify_table_only(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) -> VarMap1 = t_unify_table_only(Domain1, Domain2, VarMap), t_unify_table_only(Range1, Range2, VarMap1); +%% Nominals +t_unify_table_only(?nominal(N1, S1)=T1, ?nominal(N2, S2)=T2, VarMap) -> + case N1 =:= N2 of + true -> t_unify_table_only(S1, S2, VarMap); + false -> throw({mismatch, T1, T2}) + end; +%% +t_unify_table_only(?nominal_set([H1], S1), ?nominal_set([H2], S2), VarMap) -> + VarMap1 = t_unify_table_only(H1, H2, VarMap), + t_unify_table_only(S1, S2, VarMap1); +t_unify_table_only(?nominal_set([H1 | T1], Str1), + ?nominal_set([H2 | T2], Str2), VarMap) -> + VarMap1 = t_unify_table_only(H1, H2, VarMap), + t_unify_table_only(?nominal_set(T1, Str1), ?nominal_set(T2, Str2), VarMap1); +%% +t_unify_table_only(?nominal(_, _) = T1, ?nominal_set(_, _) = T2, VarMap) -> + t_unify_table_only(T2, T1, VarMap); +t_unify_table_only(?nominal_set(_, _) = T1, ?nominal(_, _) = T2, VarMap) -> + t_unify_table_only(T1, ?nominal_set(T2, ?none), VarMap); +%% +t_unify_table_only(?nominal_set([?nominal(_, NomS)], Other), T2, VarMap) -> + t_unify_table_only(t_sup(NomS, Other), T2, VarMap); +t_unify_table_only(?nominal_set([?nominal(_, NomS) | T], Other), T2, VarMap) -> + VarMap1 = t_unify_table_only(t_sup(NomS, Other), T2, VarMap), + t_unify_table_only(?nominal_set(T, Other), T2, VarMap1); +t_unify_table_only(T1, ?nominal_set(_, _) = T2, VarMap) -> + t_unify_table_only(T2, T1, VarMap); +%% +t_unify_table_only(?nominal(_, S1), T2, VarMap) -> + t_unify_table_only(S1, T2, VarMap); +t_unify_table_only(T1, ?nominal(_, _)=T2, VarMap) -> + t_unify_table_only(T2, T1, VarMap); +%% t_unify_table_only(?list(Contents1, Termination1, Size), ?list(Contents2, Termination2, Size), VarMap) -> VarMap1 = t_unify_table_only(Contents1, Contents2, VarMap), @@ -3332,21 +3064,8 @@ t_unify_table_only(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0 {Pairs0, VarMap4} end, {[], VarMap2}, A, B), VarMap; -t_unify_table_only(?opaque(_) = T1, ?opaque(_) = T2, VarMap) -> - t_unify_table_only(t_opaque_structure(T1), t_opaque_structure(T2), VarMap); -t_unify_table_only(T1, ?opaque(_) = T2, VarMap) -> - t_unify_table_only(T1, t_opaque_structure(T2), VarMap); -t_unify_table_only(?opaque(_) = T1, T2, VarMap) -> - t_unify_table_only(t_opaque_structure(T1), T2, VarMap); t_unify_table_only(T, T, VarMap) -> VarMap; -t_unify_table_only(?union(_)=T1, ?union(_)=T2, VarMap) -> - {Type1, Type2} = unify_union2(T1, T2), - t_unify_table_only(Type1, Type2, VarMap); -t_unify_table_only(?union(_)=T1, T2, VarMap) -> - t_unify_table_only(unify_union1(T1, T1, T2), T2, VarMap); -t_unify_table_only(T1, ?union(_)=T2, VarMap) -> - t_unify_table_only(T1, unify_union1(T2, T1, T2), VarMap); t_unify_table_only(T1, T2, _) -> throw({mismatch, T1, T2}). @@ -3367,50 +3086,6 @@ unify_lists_table_only([T1|Left1], [T2|Left2], VarMap) -> unify_lists_table_only([], [], VarMap) -> VarMap. -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) -> - ?untagged_union(A,B,F,I,L,N,T,O,Map) = List, - if O =:= ?none -> no; - true -> - S = t_opaque_structure(O), - {yes, t_sup([A,B,F,I,L,N,T,S,Map])} - end. - --spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). - -%% An opaque type is a union of types. Returns true iff any of the type -%% names (Module and Name) of the first argument (the opaque type to -%% check) occurs in any of the opaque types of the second argument. -is_opaque_type(?opaque(Elements), Opaques) -> - lists:any(fun(Opaque) -> is_opaque_type2(Opaque, Opaques) end, Elements). - -is_opaque_type2(#opaque{mod = Mod1, name = Name1, arity = Arity1}, Opaques) -> - F1 = fun(?opaque(Es)) -> - F2 = fun(#opaque{mod = Mod, name = Name, arity = Arity}) -> - is_type_name(Mod1, Name1, Arity1, Mod, Name, Arity) - end, - lists:any(F2, Es) - end, - lists:any(F1, Opaques). - -is_type_name(Mod, Name, Arity, Mod, Name, Arity) -> - true; -is_type_name(_Mod1, _Name1, _Arity1, _Mod2, _Name2, _Arity2) -> - false. - %%----------------------------------------------------------------------------- %% Subtraction. %% @@ -3437,49 +3112,53 @@ t_subtract_list(T, []) -> -spec t_subtract(erl_type(), erl_type()) -> erl_type(). -t_subtract(_, ?any) -> ?none; -t_subtract(T, ?var(_)) -> T; -t_subtract(?any, _) -> ?any; -t_subtract(?var(_) = T, _) -> T; -t_subtract(T, ?unit) -> T; -t_subtract(?unit, _) -> ?unit; -t_subtract(?none, _) -> ?none; -t_subtract(T, ?none) -> T; -t_subtract(?atom(Set1), ?atom(Set2)) -> +t_subtract(LHS, RHS) -> + Res = t_subtract_aux(LHS, RHS), + %% `Res` must be at least as specific as `LHS`, and the latter must overlap + %% with `RHS` if the result differs from `LHS`. + ?debug(t_is_subtype(subst_all_vars_to_any(Res), + subst_all_vars_to_any(LHS)) andalso + (Res =:= LHS) orelse (not t_is_impossible(t_inf(LHS, RHS))), + {LHS, RHS, Res}), + Res. + +t_subtract_aux(_, ?any) -> ?none; +t_subtract_aux(T, ?var(_)) -> T; +t_subtract_aux(?any, _) -> ?any; +t_subtract_aux(?var(_) = T, _) -> T; +t_subtract_aux(T, ?unit) -> T; +t_subtract_aux(?unit, _) -> ?unit; +t_subtract_aux(?none, _) -> ?none; +t_subtract_aux(T, ?none) -> T; +t_subtract_aux(?atom(Set1), ?atom(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?atom(Set) end; -t_subtract(?bitstr(U1, B1), ?bitstr(U2, B2)) -> +t_subtract_aux(?bitstr(U1, B1), ?bitstr(U2, B2)) -> subtract_bin(t_bitstr(U1, B1), t_inf(t_bitstr(U1, B1), t_bitstr(U2, B2))); -t_subtract(?function(_, _) = T1, ?function(_, _) = T2) -> +t_subtract_aux(?function(_, _) = T1, ?function(_, _) = T2) -> case t_is_subtype(T1, T2) of true -> ?none; false -> T1 end; -t_subtract(?identifier(Set1), ?identifier(Set2)) -> +t_subtract_aux(?identifier(Set1), ?identifier(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; -t_subtract(?opaque(_)=T1, ?opaque(_)=T2) -> - opaque_subtract(T1, t_opaque_structure(T2)); -t_subtract(?opaque(_)=T1, T2) -> - opaque_subtract(T1, T2); -t_subtract(T1, ?opaque(_)=T2) -> - t_subtract(T1, t_opaque_structure(T2)); -t_subtract(?nil, ?nil) -> +t_subtract_aux(?nil, ?nil) -> ?none; -t_subtract(?nil, ?nonempty_list(_, _)) -> +t_subtract_aux(?nil, ?nonempty_list(_, _)) -> ?nil; -t_subtract(?nil, ?list(_, _, _)) -> +t_subtract_aux(?nil, ?list(_, _, _)) -> ?none; -t_subtract(?list(Contents, Termination, _Size) = T, ?nil) -> +t_subtract_aux(?list(Contents, Termination, _Size) = T, ?nil) -> case Termination =:= ?nil of true -> ?nonempty_list(Contents, Termination); false -> T end; -t_subtract(?list(Contents1, Termination1, Size1) = T, +t_subtract_aux(?list(Contents1, Termination1, Size1) = T, ?list(Contents2, Termination2, Size2)) -> case t_is_subtype(Contents1, Contents2) of true -> @@ -3500,21 +3179,45 @@ t_subtract(?list(Contents1, Termination1, Size1) = T, %% change to the list. T end; -t_subtract(?float, ?float) -> ?none; -t_subtract(?number(_, _) = T1, ?float) -> t_inf(T1, t_integer()); -t_subtract(?float, ?number(_Set, Tag)) -> +t_subtract_aux(?float, ?float) -> ?none; +t_subtract_aux(?number(_, _) = T1, ?float) -> t_inf(T1, t_integer()); +t_subtract_aux(?float, ?number(_Set, Tag)) -> case Tag of ?unknown_qual -> ?none; _ -> ?float end; -t_subtract(?number(_, _), ?number(?any, ?unknown_qual)) -> ?none; -t_subtract(?number(_, _) = T1, ?integer(?any)) -> t_inf(?float, T1); -t_subtract(?int_set(Set1), ?int_set(Set2)) -> +t_subtract_aux(?nominal_set(_, _)=LHS, ?nominal_set(_, _)=RHS) -> + subtract_nominal_sets(LHS, RHS); +t_subtract_aux(?nominal_set(_, _)=LHS, ?nominal(_, _) = RHS) -> + t_subtract_aux(LHS, ?nominal_set([RHS], ?none)); +t_subtract_aux(?nominal_set(LHS_Ns, LHS_S)=LHS, RHS) -> + case t_inf(LHS, RHS) of + ?nominal_set(_, _)=Overlap -> + t_subtract_aux(LHS, Overlap); + ?nominal(_, _)=Overlap -> + t_subtract_aux(LHS, Overlap); + Overlap -> + normalize_nominal_set(LHS_Ns, t_subtract_aux(LHS_S, Overlap), []) + end; +t_subtract_aux(S1, ?nominal_set(_, S2)) -> + t_subtract_aux(S1, S2); +t_subtract_aux(?nominal(Name, LHS_S), ?nominal(Name, RHS_S)) -> + t_nominal(Name, t_subtract_aux(LHS_S, RHS_S)); +t_subtract_aux(?nominal(LHS_Name, _)=LHS, RHS) -> + case t_inf(LHS, RHS) of + ?nominal(LHS_Name, _)=Overlap -> t_subtract_aux(LHS, Overlap); + _ -> LHS + end; +t_subtract_aux(S1, ?nominal(_, _)) -> + S1; +t_subtract_aux(?number(_, _), ?number(?any, ?unknown_qual)) -> ?none; +t_subtract_aux(?number(_, _) = T1, ?integer(?any)) -> t_inf(?float, T1); +t_subtract_aux(?int_set(Set1), ?int_set(Set2)) -> case set_subtract(Set1, Set2) of ?none -> ?none; Set -> ?int_set(Set) end; -t_subtract(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) -> +t_subtract_aux(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) -> case t_inf(T1, T2) of ?none -> T1; ?int_range(From1, To1) -> ?none; @@ -3523,7 +3226,7 @@ t_subtract(?int_range(From1, To1) = T1, ?int_range(_, _) = T2) -> ?int_range(From, To) -> t_sup(t_from_range(From1, From - 1), t_from_range(To + 1, To)) end; -t_subtract(?int_range(From, To) = T1, ?int_set(Set)) -> +t_subtract_aux(?int_range(From, To) = T1, ?int_set(Set)) -> NewFrom = case set_is_element(From, Set) of true -> From + 1; false -> From @@ -3535,17 +3238,17 @@ t_subtract(?int_range(From, To) = T1, ?int_set(Set)) -> if (NewFrom =:= From) and (NewTo =:= To) -> T1; true -> t_from_range(NewFrom, NewTo) end; -t_subtract(?int_set(Set), ?int_range(From, To)) -> +t_subtract_aux(?int_set(Set), ?int_range(From, To)) -> case set_filter(fun(X) -> not ((X =< From) orelse (X >= To)) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) end; -t_subtract(?integer(?any) = T1, ?integer(_)) -> T1; -t_subtract(?number(_, _) = T1, ?number(_, _)) -> T1; -t_subtract(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> ?none; -t_subtract(?tuple_set(_), ?tuple(?any, ?any, ?any)) -> ?none; -t_subtract(?tuple(?any, ?any, ?any) = T1, ?tuple_set(_)) -> T1; -t_subtract(?tuple(Elements1, Arity1, _Tag1) = T1, +t_subtract_aux(?integer(?any) = T1, ?integer(_)) -> T1; +t_subtract_aux(?number(_, _) = T1, ?number(_, _)) -> T1; +t_subtract_aux(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> ?none; +t_subtract_aux(?tuple_set(_), ?tuple(?any, ?any, ?any)) -> ?none; +t_subtract_aux(?tuple(?any, ?any, ?any) = T1, ?tuple_set(_)) -> T1; +t_subtract_aux(?tuple(Elements1, Arity1, _Tag1) = T1, ?tuple(Elements2, Arity2, _Tag2)) -> if Arity1 =/= Arity2 -> T1; Arity1 =:= Arity2 -> @@ -3556,22 +3259,22 @@ t_subtract(?tuple(Elements1, Arity1, _Tag1) = T1, _ -> T1 end end; -t_subtract(?tuple_set(List1) = T1, ?tuple(_, Arity, _) = T2) -> +t_subtract_aux(?tuple_set(List1) = T1, ?tuple(_, Arity, _) = T2) -> case orddict:find(Arity, List1) of error -> T1; {ok, List2} -> TuplesLeft0 = [Tuple || {_Arity, Tuple} <- orddict:erase(Arity, List1)], TuplesLeft1 = lists:append(TuplesLeft0), - t_sup([t_subtract(L, T2) || L <- List2] ++ TuplesLeft1) + t_sup([t_subtract_aux(L, T2) || L <- List2] ++ TuplesLeft1) end; -t_subtract(?tuple(_, Arity, _) = T1, ?tuple_set(List1)) -> +t_subtract_aux(?tuple(_, Arity, _) = T1, ?tuple_set(List1)) -> case orddict:find(Arity, List1) of error -> T1; - {ok, List2} -> t_inf([t_subtract(T1, L) || L <- List2]) + {ok, List2} -> t_inf([t_subtract_aux(T1, L) || L <- List2]) end; -t_subtract(?tuple_set(_) = T1, ?tuple_set(_) = T2) -> - t_sup([t_subtract(T, T2) || T <- t_tuple_subtypes(T1)]); -t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> +t_subtract_aux(?tuple_set(_) = T1, ?tuple_set(_) = T2) -> + t_sup([t_subtract_aux(T, T2) || T <- t_tuple_subtypes(T1)]); +t_subtract_aux(?product(Elements1) = T1, ?product(Elements2)) -> Arity1 = length(Elements1), Arity2 = length(Elements2), if Arity1 =/= Arity2 -> T1; @@ -3583,7 +3286,7 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> _ -> T1 end end; -t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> +t_subtract_aux(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of false -> A; true -> @@ -3609,10 +3312,10 @@ t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> map_pairwise_merge( %% If V1 is a subtype of V2, the case that K does not exist in A %% remain. - fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)}; + fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract_aux(V1, V2)}; (K, _, V1, _, V2) -> %% If we subtract an optional key, that leaves a mandatory key - case t_subtract(V1, V2) of + case t_subtract_aux(V1, V2) of ?none -> false; Partial -> {K, ?mand, Partial} end @@ -3627,28 +3330,17 @@ t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> _ -> A end end; -t_subtract(?product(P1), _) -> +t_subtract_aux(?product(P1), _) -> ?product(P1); -t_subtract(T, ?product(_)) -> +t_subtract_aux(T, ?product(_)) -> T; -t_subtract(?union(U1), ?union(U2)) -> +t_subtract_aux(?union(U1), ?union(U2)) -> subtract_union(U1, U2); -t_subtract(T1, T2) -> +t_subtract_aux(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), subtract_union(U1, U2). --spec opaque_subtract(erl_type(), erl_type()) -> erl_type(). - -opaque_subtract(?opaque(Set1), T2) -> - List = [T1#opaque{struct = Sub} || - #opaque{struct = S1}=T1 <- 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) -> @@ -3664,18 +3356,11 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - ?untagged_union(A1,B1,F1,I1,L1,N1,T1,O1,Map1) = U1, - ?untagged_union(A2,B2,F2,I2,L2,N2,T2,O2,Map2) = U2, - List1 = ?untagged_union(A1,B1,F1,I1,L1,N1,T1,?none,Map1), - List2 = ?untagged_union(A2,B2,F2,I2,L2,N2,T2,?none,Map2), - Sub1 = subtract_union(List1, List2, ?none, []), - 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). + ?untagged_union(A1,B1,F1,I1,L1,N1,T1,Map1) = U1, + ?untagged_union(A2,B2,F2,I2,L2,N2,T2,Map2) = U2, + List1 = ?untagged_union(A1,B1,F1,I1,L1,N1,T1,Map1), + List2 = ?untagged_union(A2,B2,F2,I2,L2,N2,T2,Map2), + subtract_union(List1, List2, ?none, []). subtract_union([T1|Left1], [T2|Left2], Type, Acc) -> case t_subtract(T1, T2) of @@ -3691,6 +3376,24 @@ subtract_union([], [], Type, Acc) -> Type end. +subtract_nominal_sets(?nominal_set(LHS_Ns, LHS_S), + ?nominal_set(RHS_Ns, RHS_S)) -> + %% See inf_nominal_sets/3 + sns_cartesian([LHS_S | LHS_Ns], [RHS_S | RHS_Ns]). + +sns_cartesian([A | As], Bs) -> + case sns_cartesian_1(A, Bs) of + ?none -> sns_cartesian(As, Bs); + T -> t_sup_aux(T, sns_cartesian(As, Bs)) + end; +sns_cartesian([], _Bs) -> + ?none. + +sns_cartesian_1(A, [B | Bs]) -> + sns_cartesian_1(t_subtract(A, B), Bs); +sns_cartesian_1(A, []) -> + A. + %% Helper for tuple and product subtraction. The second list %% should contain a single element that is not none. That element %% will replace the element in the corresponding position in the @@ -3735,74 +3438,48 @@ t_is_equal(_, _) -> false. -spec t_is_subtype(erl_type(), erl_type()) -> boolean(). t_is_subtype(T1, T2) -> - Inf = t_inf(T1, T2), - subtype_is_equal(T1, Inf). - -%% The subtype relation has to behave correctly irrespective of opaque -%% types. -subtype_is_equal(T, T) -> true; -subtype_is_equal(T1, T2) -> - t_is_equal(case t_contains_opaque(T1) of - true -> t_unopaque(T1); - false -> T1 - end, - case t_contains_opaque(T2) of - true -> t_unopaque(T2); - false -> T2 - end). - --spec t_is_instance(erl_type(), erl_type()) -> boolean(). - -%% XXX. To be removed. -t_is_instance(ConcreteType, Type) -> - t_is_subtype(ConcreteType, t_unopaque(Type)). + Inf = t_inf_aux(T1, T2), + t_is_equal(T1, Inf). -spec t_do_overlap(erl_type(), erl_type()) -> boolean(). t_do_overlap(TypeA, TypeB) -> not (t_is_impossible(t_inf(TypeA, TypeB))). --spec t_unopaque(erl_type()) -> erl_type(). - -t_unopaque(T) -> - t_unopaque(T, 'universe'). - --spec t_unopaque(erl_type(), opaques()) -> erl_type(). - -t_unopaque(?opaque(_) = T, Opaques) -> - case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of - true -> t_unopaque(t_opaque_structure(T), Opaques); - false -> T - end; -t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> - ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); -t_unopaque(?tuple(?any, _, _) = T, _) -> T; -t_unopaque(?tuple(ArgTs, Sz, Tag), Opaques) when is_list(ArgTs) -> - NewArgTs = [t_unopaque(A, Opaques) || A <- ArgTs], +-spec t_structural(erl_type()) -> erl_type(). + +t_structural(?nominal(_, S)) -> + t_structural(S); +t_structural(?nominal_set([], S)) -> + t_structural(S); +t_structural(?nominal_set([?nominal(_, S1)|T], S)) -> + t_structural(?nominal_set(T, t_sup(S, S1))); +t_structural(?list(ElemT, Termination, Sz)) -> + ?list(t_structural(ElemT), t_structural(Termination), Sz); +t_structural(?tuple(?any, _, _) = T) -> T; +t_structural(?tuple(ArgTs, Sz, Tag)) when is_list(ArgTs) -> + NewArgTs = [t_structural(A) || A <- ArgTs], ?tuple(NewArgTs, Sz, Tag); -t_unopaque(?tuple_set(Set), Opaques) -> - NewSet = [{Sz, [t_unopaque(T, Opaques) || T <- Tuples]} +t_structural(?tuple_set(Set)) -> + NewSet = [{Sz, [t_structural(T) || 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(?untagged_union(A,B,F,I,L,N,T,O,Map)), Opaques) -> - UL = t_unopaque(L, Opaques), - UT = t_unopaque(T, Opaques), - UF = t_unopaque(F, Opaques), - UMap = t_unopaque(Map, Opaques), - {OF,UO} = case t_unopaque(O, Opaques) of - ?opaque(_) = O1 -> {O1, []}; - Type -> {?none, [Type]} - end, - t_sup([?union([A,B,UF,I,UL,N,UT,OF,UMap])|UO]); -t_unopaque(?map(Pairs,DefK,DefV), Opaques) -> - t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs], - t_unopaque(DefK, Opaques), - t_unopaque(DefV, Opaques)); -t_unopaque(T, _) -> +t_structural(?product(Types)) -> + ?product([t_structural(T) || T <- Types]); +t_structural(?function(Domain, Range)) -> + ?function(t_structural(Domain), t_structural(Range)); +t_structural(?union(?untagged_union(A,B,F,I,L,N,T,Map))) -> + UL = t_structural(L), + UT = t_structural(T), + UF = t_structural(F), + UMap = t_structural(Map), + t_sup([A,B,UF,I,UL,N,UT,UMap]); +t_structural(?map(Pairs,DefK,DefV)) -> + t_map([{t_structural(K), MNess, t_structural(V)} + || {K, MNess, V} <- Pairs], + t_structural(DefK), + t_structural(DefV)); +t_structural(T) -> T. %%----------------------------------------------------------------------------- @@ -3815,54 +3492,78 @@ t_unopaque(T, _) -> -spec t_limit(erl_type(), integer()) -> erl_type(). t_limit(Term, K) when is_integer(K) -> - case is_limited(Term, K) of - true -> Term; - false -> t_limit_k(Term, K) + IsLimited = is_limited(Term, K), + %% `is_limited/2` must mirror `t_limit_k/2` + ?debug(IsLimited =:= (Term =:= t_limit_k(Term, K)), + {IsLimited, Term, K}), + case IsLimited of + true -> + Term; + false -> + Res = t_limit_k(Term, K), + %% `Res` must be strictly more general than `Term` + ?debug(t_is_subtype(subst_all_vars_to_any(Term), + subst_all_vars_to_any(Res)), + {Term, Res}), + Res end. -is_limited(?any, _) -> true; -is_limited(_, K) when K =< 0 -> false; -is_limited(?tuple(?any, ?any, ?any), _K) -> true; -is_limited(?tuple(Elements, _Arity, _), K) -> - if K =:= 1 -> false; - true -> - are_all_limited(Elements, K - 1) +%% Optimized mirror of t_limit_k/2 that merely checks whether the latter will +%% change the input term in any way. Needless to say this _must_ mirror +%% t_limit_k/2. +is_limited(?any, _) -> + true; +is_limited(_, K) when K =< 0 -> + false; +is_limited(?tuple(?any, ?any, ?any), _K) -> + true; +is_limited(?tuple(Elements, _Arity, Qual), K) -> + ?debug(length(Elements) =:= _Arity, _Arity), + if + K =:= 1 -> t_is_any(Qual) andalso are_all_limited(Elements, K - 1); + true -> are_all_limited(Elements, K - 1) end; is_limited(?tuple_set(_) = T, K) -> are_all_limited(t_tuple_subtypes(T), K); is_limited(?list(Elements, ?nil, _Size), K) -> is_limited(Elements, K - 1); is_limited(?list(Elements, Termination, _Size), K) -> - if K =:= 1 -> is_limited(Termination, K); - true -> is_limited(Termination, K - 1) - end - andalso is_limited(Elements, K - 1); + %% We do not want to lose the termination information, always pass a K of at + %% least 1 for that + is_limited(Elements, K - 1) andalso is_limited(Termination, max(1, K - 1)); is_limited(?function(Domain, Range), K) -> is_limited(Domain, K) andalso is_limited(Range, K-1); is_limited(?product(Elements), K) -> are_all_limited(Elements, K - 1); is_limited(?union(Elements), K) -> are_all_limited(Elements, K); -is_limited(?opaque(Es), K) -> - lists:all(fun(#opaque{struct = S}) -> is_limited(S, K) end, Es); +is_limited(?nominal_set(Elements, S), K) -> + is_limited(S, K) andalso are_all_limited(Elements, K); +is_limited(?nominal(_, S), K) -> + %% To simplify checking opacity violations, nominals aren't counted in the + %% term depth. + is_limited(S, K); is_limited(?map(Pairs, DefK, DefV), K) -> %% Use the fact that t_sup() does not increase the depth. K1 = K - 1, lists:all(fun({Key, _, Value}) -> - is_limited(Key, K1) andalso is_limited(Value, K1) + is_limited(Key, K1) andalso is_limited(Value, K1) end, Pairs) andalso is_limited(DefK, K1) andalso is_limited(DefV, K1); is_limited(_, _K) -> true. -are_all_limited([E|Es], K) -> +are_all_limited([E | Es], K) -> is_limited(E, K) andalso are_all_limited(Es, K); are_all_limited([], _) -> true. -t_limit_k(_, K) when K =< 0 -> ?any; -t_limit_k(?tuple(?any, ?any, ?any) = T, _K) -> T; +t_limit_k(_, K) when K =< 0 -> + ?any; +t_limit_k(?tuple(?any, ?any, ?any) = T, _K) -> + T; t_limit_k(?tuple(Elements, Arity, _), K) -> - if K =:= 1 -> t_tuple(Arity); + if + K =:= 1 -> t_tuple(Arity); true -> t_tuple([t_limit_k(E, K-1) || E <- Elements]) end; t_limit_k(?tuple_set(_) = T, K) -> @@ -3871,14 +3572,11 @@ t_limit_k(?list(Elements, ?nil, Size), K) -> NewElements = t_limit_k(Elements, K - 1), ?list(NewElements, ?nil, Size); t_limit_k(?list(Elements, Termination, Size), K) -> - NewTermination = - if K =:= 1 -> - %% We do not want to lose the termination information. - t_limit_k(Termination, K); - true -> t_limit_k(Termination, K - 1) - end, - NewElements = t_limit_k(Elements, K - 1), - ?list(NewElements, NewTermination, Size); + %% We do not want to lose the termination information, always pass a K of at + %% least 1 for that. + ?list(t_limit_k(Elements, K - 1), + t_limit_k(Termination, max(1, K - 1)), + Size); t_limit_k(?function(Domain, Range), K) -> %% The domain is either a product or any() so we do not decrease the K. ?function(t_limit_k(Domain, K), t_limit_k(Range, K-1)); @@ -3886,23 +3584,26 @@ 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 <- Es], - ?opaque(ordsets:from_list(List)); +t_limit_k(?nominal(Name, Inner), K) -> + %% To simplify checking opacity violations, nominals aren't counted in the + %% term depth. + ?nominal(Name, t_limit_k(Inner, K)); +t_limit_k(?nominal_set(Elements, S), K) -> + normalize_nominal_set([t_limit_k(X, K) || X <- Elements], + t_limit_k(S, K), + []); t_limit_k(?map(Pairs0, DefK0, DefV0), K) -> Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) -> - LV = t_limit_k(EV, K - 1), - case t_limit_k(EK, K - 1) of - EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1}; - LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} - end - end, + LV = t_limit_k(EV, K - 1), + case t_limit_k(EK, K - 1) of + EK -> {[{EK, MNess, LV}|Exact], DefK1, DefV1}; + LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} + end + end, {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0), t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1)); -t_limit_k(T, _K) -> T. +t_limit_k(T, _K) -> + T. %%============================================================================ %% @@ -3930,6 +3631,23 @@ t_abstract_records(?function(Domain, Range), RecDict) -> t_abstract_records(Range, RecDict)); t_abstract_records(?product(Types), RecDict) -> ?product([t_abstract_records(T, RecDict) || T <- Types]); +t_abstract_records(?nominal(N, ?nominal(_, _)=S0), RecDict) -> + case t_abstract_records(S0, RecDict) of + ?nominal(_, _)=S -> ?nominal(N, S); + _ -> ?any + end; +t_abstract_records(?nominal(N, ?nominal_set(_, _)=S0), RecDict) -> + case t_abstract_records(S0, RecDict) of + ?nominal_set(_, _)=S -> ?nominal(N, S); + ?nominal(_, _)=S -> ?nominal(N, S); + _ -> ?any + end; +t_abstract_records(?nominal(N, S), RecDict) -> + ?nominal(N, t_abstract_records(S, RecDict)); +t_abstract_records(?nominal_set(Elements, S), RecDict) -> + normalize_nominal_set([t_abstract_records(X, RecDict) || X <- Elements], + t_abstract_records(S, RecDict), + []); t_abstract_records(?union(Types), RecDict) -> t_sup([t_abstract_records(T, RecDict) || T <- Types]); t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) -> @@ -3944,8 +3662,6 @@ 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. @@ -4009,11 +3725,6 @@ t_to_string(?identifier(Set), _RecDict) -> _ -> flat_join([flat_format("~w()", [T]) || T <- Set], " | ") end; -t_to_string(?opaque(Set), RecDict) -> - flat_join([opaque_type(Mod, Name, Arity, S, RecDict) || - #opaque{mod = Mod, name = Name, struct = S, arity = Arity} - <- Set], - " | "); t_to_string(?nil, _RecDict) -> "[]"; t_to_string(?nonempty_list(Contents, Termination), RecDict) -> @@ -4085,6 +3796,20 @@ t_to_string(?int_range(From, To), _RecDict) -> flat_format("~w..~w", [From, To]); t_to_string(?integer(?any), _RecDict) -> "integer()"; t_to_string(?float, _RecDict) -> "float()"; +t_to_string(?nominal({Module, Name, Arity, _}, ?opaque), _RecDict) -> + Modname = flat_format("~w:~tw", [Module, Name]), + Args = lists:join($,, lists:duplicate(Arity, $_)), + flat_format("~ts(~ts)", [Modname, Args]); +t_to_string(?nominal({_Module, _Name, _Arity, opaque}, _) = N, _RecDict) -> + t_to_string(oc_mark(N, ?opaque, "erl_types")); +t_to_string(?nominal({Module, Name, Arity, _}, Structure), RecDict) -> + Modname = flat_format("~w:~tw", [Module, Name]), + Args = lists:join($,, lists:duplicate(Arity, $_)), + Namearity = flat_format("~ts(~ts)", [Modname, Args]), + StructureString = t_to_string(Structure, RecDict), + flat_format("(~ts :: ~ts)", [Namearity, StructureString]); +t_to_string(?nominal_set(T, S), RecDict) -> + union_sequence([N || N <- [S|T], N =/= ?none], RecDict); t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; @@ -4180,23 +3905,6 @@ union_sequence(Types, RecDict) -> List = [t_to_string(T, RecDict) || T <- Types], flat_join(List, " | "). --ifdef(DEBUG). -opaque_type(Mod, Name, Arity, S, RecDict) -> - String = t_to_string(S, RecDict), - opaque_name(Mod, Name, Arity) ++ "[" ++ String ++ "]". --else. -opaque_type(Mod, Name, Arity, _S, _RecDict) -> - opaque_name(Mod, Name, Arity). --endif. - -opaque_name(Mod, Name, Arity) -> - S = mod_name(Mod, Name), - Args = lists:join($,, lists:duplicate(Arity, $_)), - flat_format("~ts(~ts)", [S, Args]). - -mod_name(Mod, Name) -> - flat_format("~w:~tw", [Mod, Name]). - %%============================================================================= %% %% Build a type from parse forms. @@ -4537,13 +4245,7 @@ from_form({type, _Anno, union, Args}, S, D, L, C) -> {Lst, L1, C1} = list_from_form(Args, S, D, L, C), {t_sup(Lst), L1, C1}; from_form({user_type, _Anno, Name, Args}, S, D, L, C) -> - type_from_form(Name, Args, S, D, L, C); -from_form({type, _Anno, Name, Args}, S, D, L, C) -> - %% Compatibility: modules compiled before Erlang/OTP 18.0. - type_from_form(Name, Args, S, D, L, C); -from_form({opaque, _Anno, Name, {Mod, Args, Rep}}, _S, _D, L, C) -> - %% XXX. To be removed. - {t_opaque(Mod, Name, Args, Rep), L, C}. + type_from_form(Name, Args, S, D, L, C). builtin_type(Name, Type, S, D, L, C) -> #from_form{site = Site, mrecs = MR} = S, @@ -4567,7 +4269,7 @@ type_from_form(Name, Args, S, D, L, C) -> TypeName = {type, {Module, Name, ArgsLen}}, case can_unfold_more(TypeName, TypeNames) of true -> - {R, C1} = lookup_module_types(Module, MR, C), + {R, C1} = case lookup_module_types(Module, MR, C) of error -> error({Name, Args}); KK -> KK end, type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site, S, D, L, C1); false -> @@ -4580,7 +4282,7 @@ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site, {_, {_, _}} when element(1, Site) =:= check -> {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C), {t_any(), L1, C1}; - {Tag, {{Module, {File,_Location}, Form, ArgNames}, Type}} -> + {Tag, {{Module, {File,_Location}, Form, ArgNames}, _Type}} -> NewTypeNames = [TypeName|TypeNames], S1 = S#from_form{tnames = NewTypeNames}, {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), @@ -4597,18 +4299,14 @@ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, Site, Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, {NewType, L3, C3} = case Tag of - type -> - recur_limit(Fun, D, L1, TypeName, TypeNames); + nominal -> + {Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames), + {t_nominal({Module, Name, ArgsLen, transparent}, Rep), L2, C2}; opaque -> {Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames), - Rep1 = choose_opaque_type(Rep, Type), - Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of - true -> Rep; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Module, Name, ArgTypes2, Rep1) - end, - {Rep2, L2, C2} + {t_nominal({Module, Name, ArgsLen, opaque}, Rep), L2, C2}; + type -> + recur_limit(Fun, D, L1, TypeName, TypeNames) end, C4 = cache_put(CKey, NewType, L1 - L3, C3), {NewType, L3, C4} @@ -4658,7 +4356,7 @@ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, {_, {_, _}} when element(1, Site) =:= check -> {_ArgTypes, L1, C1} = list_from_form(Args, S, D, L, C), {t_any(), L1, C1}; - {Tag, {{Mod, {File,_Location}, Form, ArgNames}, Type}} -> + {Tag, {{Mod, {File,_Location}, Form, ArgNames}, _Type}} -> NewTypeNames = [RemType|TypeNames], S1 = S#from_form{tnames = NewTypeNames}, {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), @@ -4675,19 +4373,14 @@ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, {NewType, L3, C3} = case Tag of - type -> - recur_limit(Fun, D, L1, RemType, TypeNames); + nominal -> + {NewRep, L2, C2} = recur_limit(Fun, D, L1, RemType, TypeNames), + {t_nominal({Mod, Name, ArgsLen, transparent}, NewRep), L2, C2}; opaque -> {NewRep, L2, C2} = recur_limit(Fun, D, L1, RemType, TypeNames), - NewRep1 = choose_opaque_type(NewRep, Type), - NewRep2 = - case cannot_have_opaque(NewRep1, RemType, TypeNames) of - true -> NewRep; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Mod, Name, ArgTypes2, NewRep1) - end, - {NewRep2, L2, C2} + {t_nominal({Mod, Name, ArgsLen, opaque}, NewRep), L2, C2}; + type -> + recur_limit(Fun, D, L1, RemType, TypeNames) end, C4 = cache_put(CKey, NewType, L1 - L3, C3), {NewType, L3, C4} @@ -4698,27 +4391,7 @@ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, throw({error, Msg}) end. -subst_all_vars_to_any_list(Types) -> - [subst_all_vars_to_any(Type) || Type <- Types]. -%% Opaque types (both local and remote) are problematic when it comes -%% to the limits (TypeNames, D, and L). The reason is that if any() is -%% substituted for a more specialized subtype of an opaque type, the -%% property stated along with decorate_with_opaque() (the type has to -%% be a subtype of the declared type) no longer holds. -%% -%% The less than perfect remedy: if the opaque type created from a -%% form is not a subset of the declared type, the declared type is -%% used instead, effectively bypassing the limits, and potentially -%% resulting in huge types. -choose_opaque_type(Type, DeclType) -> - case - t_is_subtype(subst_all_vars_to_any(Type), - subst_all_vars_to_any(DeclType)) - of - true -> Type; - false -> DeclType - end. record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) -> #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, @@ -4836,7 +4509,8 @@ separate_key(?number(_, _) = T) -> t_elements(T); separate_key(?union(List)) -> lists:append([separate_key(K) || K <- List, not t_is_none(K)]); -separate_key(Key) -> [Key]. +separate_key(Key) -> + [Key]. %% Sorts, combines non-singleton pairs, and applies precedence and %% mandatoriness rules. @@ -5239,25 +4913,25 @@ lookup_record(Tag, Arity, Table) when is_atom(Tag) -> error end. --spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. +-spec lookup_type(_, _, _) -> {'type' | 'opaque' | 'nominal', type_value()} | 'error'. lookup_type(Name, Arity, Table) -> case Table of #{{type, Name, Arity} := Found} -> {type, Found}; #{{opaque, Name, Arity} := Found} -> {opaque, Found}; + #{{nominal, Name, Arity} := Found} -> + {nominal, Found}; #{} -> error end. --spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> +-spec type_is_defined('type' | 'opaque' | 'nominal', atom(), arity(), type_table()) -> boolean(). type_is_defined(TypeOrOpaque, Name, Arity, Table) -> maps:is_key({TypeOrOpaque, Name, Arity}, Table). -cannot_have_opaque(Type, TypeName, TypeNames) -> - t_is_none(Type) orelse is_recursive(TypeName, TypeNames). is_recursive(TypeName, TypeNames) -> lists:member(TypeName, TypeNames). @@ -5266,56 +4940,40 @@ 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. +-spec structural(erl_type(), fun((_) -> T)) -> T. -%% Probably a little faster than calling t_unopaque/2. +%% Probably a little faster than calling t_structural/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) -> - ?untagged_union(A,B,F,I,L,N,T,O,Map) = List, - if O =:= ?none -> Pred(Type); - true -> - case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of - true -> - S = t_opaque_structure(O), - do_opaque(t_sup(?untagged_union(A,B,F,I,L,N,T,S,Map)), Opaques, Pred); - false -> Pred(Type) - end - end; -do_opaque(Type, _Opaques, Pred) -> +structural(?nominal_set([], S), Pred) -> + structural(S, Pred); +structural(?nominal_set([?nominal(_, S1) | T], Str), Pred) -> + structural(?nominal_set(T, t_sup(Str, S1)), Pred); +structural(?nominal(_, S), Pred) -> + structural(S, Pred); +structural(Type, Pred) -> Pred(Type). map_all_values(?map(Pairs,_,DefV)) -> - [DefV|[V || {V, _, _} <- Pairs]]. - -map_all_keys(?map(Pairs,DefK,_)) -> - [DefK|[K || {_, _, K} <- Pairs]]. - -map_all_types(M) -> - map_all_keys(M) ++ map_all_values(M). + [DefV | [V || {V, _, _} <- Pairs]]. %% Tests if a type has exactly one possible value. -spec t_is_singleton(erl_type()) -> boolean(). t_is_singleton(Type) -> - t_is_singleton(Type, 'universe'). - --spec t_is_singleton(erl_type(), opaques()) -> boolean(). - -t_is_singleton(Type, Opaques) -> - do_opaque(Type, Opaques, fun is_singleton_type/1). + structural(Type, fun is_singleton_type/1). %% To be in sync with separate_key/1. %% Used to also recognize maps and tuples. -is_singleton_type(?nil) -> true; -is_singleton_type(?atom(?any)) -> false; -is_singleton_type(?atom([_])) -> true; -is_singleton_type(?int_range(V, V)) -> true; % cannot happen -is_singleton_type(?int_set([_])) -> true; +is_singleton_type(?nil) -> + true; +is_singleton_type(?atom(?any)) -> + false; +is_singleton_type(?atom([_])) -> + true; +is_singleton_type(?int_range(V, V)) -> + true; % cannot happen +is_singleton_type(?int_set([_])) -> + true; is_singleton_type(_) -> false. @@ -5479,6 +5137,9 @@ module_type_deps_of_type_defs(TypeTable) -> module_type_deps_of_entry({{'type', _TypeName, _A}, {{_FromM, _FileLine, AbstractType, _ArgNames}, _}}) -> type_form_to_remote_modules(AbstractType); +module_type_deps_of_entry({{'nominal', _TypeName, _A}, {{_FromM, _FileLine, AbstractType, _ArgNames}, _}}) -> + type_form_to_remote_modules(AbstractType); + module_type_deps_of_entry({{'opaque', _TypeName, _A}, {{_FromM, _FileLine, AbstractType, _ArgNames}, _}}) -> type_form_to_remote_modules(AbstractType); diff --git a/lib/dialyzer/src/typer_core.erl b/lib/dialyzer/src/typer_core.erl index 131308b32b0c..a0f97ced7f86 100644 --- a/lib/dialyzer/src/typer_core.erl +++ b/lib/dialyzer/src/typer_core.erl @@ -433,7 +433,7 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records, Analysis) -> {{F, A}, {Range, Arg}}; {ok, {_FileLine, Contract, _Xtra}} -> Sig = erl_types:t_fun(Arg, Range), - case dialyzer_contracts:check_contract(Contract, Sig) of + case dialyzer_contracts:check_contract(Contract, Sig, M) of ok -> {{F, A}, {contract, Contract}}; {range_warnings, _} -> {{F, A}, {contract, Contract}}; diff --git a/lib/dialyzer/test/cplt_SUITE.erl b/lib/dialyzer/test/cplt_SUITE.erl index 725ed455a689..b839f507fd13 100644 --- a/lib/dialyzer/test/cplt_SUITE.erl +++ b/lib/dialyzer/test/cplt_SUITE.erl @@ -288,8 +288,7 @@ local_fun_same_as_callback(Config) when is_list(Config) -> ErlangBeam = case code:where_is_file("erlang.beam") of non_existing -> filename:join([code:root_dir(), - "erts", "preloaded", "ebin", - "erlang.beam"]); + "erts", "ebin", "erlang.beam"]); EBeam -> EBeam end, @@ -900,8 +899,7 @@ erlang_beam() -> case code:where_is_file("erlang.beam") of non_existing -> filename:join([code:root_dir(), - "erts", "preloaded", "ebin", - "erlang.beam"]); + "erts", "ebin", "erlang.beam"]); EBeam -> EBeam end. diff --git a/lib/dialyzer/test/dialyzer_common.erl b/lib/dialyzer/test/dialyzer_common.erl index 764d2c06e0c3..0d7a6827cb22 100644 --- a/lib/dialyzer/test/dialyzer_common.erl +++ b/lib/dialyzer/test/dialyzer_common.erl @@ -163,11 +163,13 @@ check(TestCase, Opts, Dir, OutDir) -> Other -> erlang:error(Other) end end, - case file_utils:diff(NewResFile, OldResFile) of - 'same' -> file:delete(NewResFile), - 'same'; - {'differ', List} -> escape_strings({'differ', TestCase, List}) - end + case compare_results(TestCase, NewResFile, OldResFile) of + same -> + file:delete(NewResFile), + same; + {differ, _, _}=Diff -> + Diff + end catch Kind:Error:Stacktrace -> {'dialyzer crashed', Kind, Error, Stacktrace} end. @@ -208,9 +210,18 @@ create_all_suites() -> Suites = get_suites(Cwd), lists:foreach(fun create_suite/1, Suites). -escape_strings({differ, TestCase, List}) -> - Escaped = [{T, L, xmerl_lib:export_text(S)} || {T, L, S} <- List], - {differ, TestCase, lists:keysort(2, Escaped)}. +compare_results(TestCase, NewResFile, OldResFile) -> + maybe + {'differ', List} ?= file_utils:diff(NewResFile, OldResFile), + [_|_] ?= Escaped = [{T, L, xmerl_lib:export_text(S)} + || {T, L, S} <- List, + not lists:prefix("%", S), + S =/= "\n"], + {differ, TestCase, lists:keysort(2, Escaped)} + else + same -> same; + [] -> same + end. -spec get_suites(file:filename()) -> [string()]. diff --git a/lib/dialyzer/test/incremental_SUITE.erl b/lib/dialyzer/test/incremental_SUITE.erl index 1bf5731db8fa..b342eb57c31a 100644 --- a/lib/dialyzer/test/incremental_SUITE.erl +++ b/lib/dialyzer/test/incremental_SUITE.erl @@ -64,8 +64,7 @@ erlang_module() -> case code:where_is_file("erlang.beam") of non_existing -> filename:join([code:root_dir(), - "erts", "preloaded", "ebin", - "erlang.beam"]); + "erts", "ebin", "erlang.beam"]); EBeam -> EBeam end. diff --git a/lib/dialyzer/test/indent_SUITE_data/results/dict_use b/lib/dialyzer/test/indent_SUITE_data/results/dict_use index 4039223eec09..bd529077c4a7 100644 --- a/lib/dialyzer/test/indent_SUITE_data/results/dict_use +++ b/lib/dialyzer/test/indent_SUITE_data/results/dict_use @@ -1,42 +1,82 @@ -dict_use.erl:41:3: The attempt to match a term of type - dict:dict(_, _) against the pattern - 'gazonk' breaks the opacity of the term -dict_use.erl:45:5: The attempt to match a term of type - dict:dict(_, _) against the pattern - [] breaks the opacity of the term -dict_use.erl:46:5: The attempt to match a term of type - dict:dict(_, _) against the pattern - 42 breaks the opacity of the term -dict_use.erl:51:5: The attempt to match a term of type - dict:dict(_, _) against the pattern - [] breaks the opacity of the term -dict_use.erl:52:5: The attempt to match a term of type - dict:dict(_, _) against the pattern - 42 breaks the opacity of the term +dict_use.erl:41:3: The pattern + 'gazonk' can never match the type + dict:dict(_, _) +dict_use.erl:45:5: The pattern + [] can never match the type + dict:dict(_, _) +dict_use.erl:46:5: The pattern + 42 can never match the type + dict:dict(_, _) +dict_use.erl:51:5: The pattern + [] can never match the type + dict:dict(_, _) +dict_use.erl:52:5: The pattern + 42 can never match the type + dict:dict(_, _) dict_use.erl:58:3: Attempt to test for equality between a term of type maybe_improper_list() and a term of opaque type dict:dict(_, _) +dict_use.erl:58:3: The test + maybe_improper_list() =:= + dict:dict(_, _) can never evaluate to 'true' dict_use.erl:60:3: Attempt to test for inequality between a term of type atom() and a term of opaque type dict:dict(_, _) -dict_use.erl:64:19: Guard test length - (D :: dict:dict(_, _)) breaks the opacity of its argument -dict_use.erl:65:20: Guard test is_atom - (D :: dict:dict(_, _)) breaks the opacity of its argument -dict_use.erl:66:20: Guard test is_list - (D :: dict:dict(_, _)) breaks the opacity of its argument -dict_use.erl:70:3: The type test is_list - (dict:dict(_, _)) breaks the opacity of the term - dict:dict(_, _) +dict_use.erl:60:3: The test + atom() =/= + dict:dict(_, _) can never evaluate to 'false' +dict_use.erl:64:12: Guard test length + (D :: dict:dict(_, _)) can never succeed +dict_use.erl:65:12: Guard test is_atom + (D :: dict:dict(_, _)) can never succeed +dict_use.erl:66:12: Guard test is_list + (D :: dict:dict(_, _)) can never succeed dict_use.erl:73:19: The call dict:fetch ('foo', [1, 2, 3]) does not have an opaque term of type dict:dict(_, _) as 2nd argument +dict_use.erl:73:19: The call dict:fetch + ('foo', + [1, 2, 3]) will never return since the success typing is + (any(), + {'dict', + non_neg_integer(), + non_neg_integer(), + pos_integer(), + non_neg_integer(), + non_neg_integer(), + non_neg_integer(), + tuple(), + tuple()}) -> + any() and the contract is + (Key, Dict) -> Value when Dict :: dict(Key, Value) dict_use.erl:76:19: The call dict:merge (Fun :: any(), 42, [1, 2]) does not have opaque terms as 2nd and 3rd arguments +dict_use.erl:76:19: The call dict:merge + (Fun :: any(), + 42, + [1, 2]) will never return since the success typing is + (any(), + any(), + {'dict', + non_neg_integer(), + non_neg_integer(), + non_neg_integer(), + non_neg_integer(), + non_neg_integer(), + non_neg_integer(), + tuple(), + tuple()}) -> + any() and the contract is + (Fun, Dict1, Dict2) -> Dict3 + when + Fun :: fun((Key, Value1, Value2) -> Value), + Dict1 :: dict(Key, Value1), + Dict2 :: dict(Key, Value2), + Dict3 :: dict(Key, Value) dict_use.erl:80:7: The call dict:store (42, 'elli', diff --git a/lib/dialyzer/test/indent_SUITE_data/results/map_galore b/lib/dialyzer/test/indent_SUITE_data/results/map_galore index 13a39d80cd48..2e82edd2c862 100644 --- a/lib/dialyzer/test/indent_SUITE_data/results/map_galore +++ b/lib/dialyzer/test/indent_SUITE_data/results/map_galore @@ -705,6 +705,18 @@ map_galore.erl:2281:50: The call maps:from_list map_galore.erl:2282:50: The call maps:from_list (42) will never return since it differs in the 1st argument from the success typing arguments: ([{_, _}]) +map_galore.erl:982:12: The test + #{1 := 'a', + 2 := 'b', + 4 := 'd', + 5 := 'e', + float() => 'c' | 'new'} =/= + #{1 := 'a', + 2 := 'b', + 3 := 'right', + 4 := 'd', + 5 := 'e', + float() => 'c' | 'new'} can never evaluate to 'false' map_galore.erl:997:55: A key of type 'nonexisting' cannot exist in a map of type #{} diff --git a/lib/dialyzer/test/indent_SUITE_data/results/queue_use b/lib/dialyzer/test/indent_SUITE_data/results/queue_use index 77afde07c48c..facc21cb2a93 100644 --- a/lib/dialyzer/test/indent_SUITE_data/results/queue_use +++ b/lib/dialyzer/test/indent_SUITE_data/results/queue_use @@ -18,17 +18,26 @@ queue_use.erl:36:5: The attempt to match a term of type queue_use.erl:40:35: The call queue:out ({"*", []}) does not have an opaque term of type queue:queue(_) as 1st argument -queue_use.erl:51:25: The call queue_use:is_in_queue - (E :: 42, - DB :: #db{p :: [], q :: queue:queue(_)}) contains an opaque term as 2nd argument when terms of different types are expected in these positions -queue_use.erl:56:1: The attempt to match a term of type - #db{p :: [], q :: queue:queue(_)} against the pattern - {'db', _, {L1, L2}} breaks the opacity of - queue:queue(_) +queue_use.erl:52:2: The pattern + 'true' can never match the type + 'false' +queue_use.erl:56:24: The attempt to match a term of type + queue:queue(_) against the pattern + {L1, L2} breaks the opacity of the term queue_use.erl:62:17: The call queue_use:tuple_queue ({42, 'gazonk'}) does not have a term of type {_, queue:queue(_)} (with opaque subterms) as 1st argument +queue_use.erl:62:17: The call queue_use:tuple_queue + ({42, 'gazonk'}) will never return since it differs in the 1st argument from the success typing arguments: + ({_, queue:queue(_)}) queue_use.erl:65:17: The call queue:in (F :: 42, Q :: 'gazonk') does not have an opaque term of type queue:queue(_) as 2nd argument +queue_use.erl:65:17: The call queue:in + (F :: 42, + Q :: 'gazonk') will never return since the success typing is + (any(), + {maybe_improper_list(), maybe_improper_list()}) -> + {nonempty_maybe_improper_list(), maybe_improper_list()} and the contract is + (Item, Q1 :: queue(Item)) -> Q2 :: queue(Item) diff --git a/lib/dialyzer/test/indent_SUITE_data/results/rec b/lib/dialyzer/test/indent_SUITE_data/results/rec index 7bd512073d55..5dbd931eec37 100644 --- a/lib/dialyzer/test/indent_SUITE_data/results/rec +++ b/lib/dialyzer/test/indent_SUITE_data/results/rec @@ -2,7 +2,7 @@ rec_use.erl:17:2: The attempt to match a term of type rec_adt:rec() against the pattern {'rec', _, 42} breaks the opacity of the term -rec_use.erl:18:20: Guard test tuple_size +rec_use.erl:18:9: Guard test tuple_size (R :: rec_adt:rec()) breaks the opacity of its argument rec_use.erl:23:19: The call rec_adt:get_a (R :: tuple()) does not have an opaque term of type @@ -10,6 +10,3 @@ rec_use.erl:23:19: The call rec_adt:get_a rec_use.erl:27:5: Attempt to test for equality between a term of type {'rec', 'gazonk', 42} and a term of opaque type rec_adt:rec() -rec_use.erl:30:16: The call erlang:tuple_size - (rec_adt:rec()) contains an opaque term as 1st argument when a structured term of type - tuple() is expected diff --git a/lib/dialyzer/test/indent_SUITE_data/results/simple b/lib/dialyzer/test/indent_SUITE_data/results/simple index 7fea96c5021c..0c4e50ae36a5 100644 --- a/lib/dialyzer/test/indent_SUITE_data/results/simple +++ b/lib/dialyzer/test/indent_SUITE_data/results/simple @@ -19,124 +19,104 @@ exact_api.erl:55:5: The attempt to match a term of type exact_api.erl:59:39: 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:5: 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: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:18: Guard test is_record +is_rec.erl:19:8: Guard test is_record (A :: simple1_adt:d1(), 'r', - 2) breaks the opacity of its argument -is_rec.erl:23:18: Guard test is_record + 2) can never succeed +is_rec.erl:23:8: Guard test is_record ({simple1_adt:d1(), 1}, 'r', - 2) breaks the opacity of its argument -is_rec.erl:41:15: 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:18: 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:15: 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:18: 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:18: Guard test is_record + 2) can never succeed +is_rec.erl:57:8: Guard test is_record (A :: simple1_adt:d1(), 'r', - 2) breaks the opacity of its argument + 2) can never succeed is_rec.erl:61:8: The record #r{f1 :: simple1_adt:d1()} violates the declared type for #r{} -is_rec.erl:65:5: 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:104:5: Matching of pattern {'r2', 10} tagged with a record name violates the declared type of #r2{f1 :: 10} -rec_api.erl:113:5: The attempt to match a term of type - #r3{f1 :: queue:queue(_)} against the pattern - {'r3', 'a'} breaks the opacity of - queue:queue(_) +rec_api.erl:113:5: The pattern + {'r3', 'a'} can never match the type + #r3{f1 :: queue:queue(_)} rec_api.erl:118:18: Record construction #r3{f1 :: 10} violates the declared type of field f1 :: queue:queue(_) -rec_api.erl:123:5: The attempt to match a term of type - #r3{f1 :: 10} against the pattern - {'r3', 10} breaks the opacity of - queue:queue(_) +rec_api.erl:123:5: Matching of pattern + {'r3', 10} tagged with a record name violates the declared type of + #r3{f1 :: 10} rec_api.erl:24:18: Record construction #r1{f1 :: 10} violates the declared type of field f1 :: rec_api:a() rec_api.erl:29:5: Matching of pattern {'r1', 10} tagged with a record name violates the declared type of #r1{f1 :: 10} +rec_api.erl:33:10: The attempt to match a term of type + rec_adt:a() against the pattern + 'a' breaks the opacity of the term rec_api.erl:33:5: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opacity of the term -rec_api.erl:35:2: Invalid type specification for function rec_api:adt_t1/1. - The success typing is rec_api:adt_t1 +rec_api.erl:35:2: The specification for rec_api:adt_t1/1 has an opaque subtype + rec_adt:r1() which is violated by the success typing (#r1{f1 :: 'a'}) -> #r1{f1 :: 'a'} - But the spec is rec_api:adt_t1 - (rec_adt:r1()) -> rec_adt:r1() - They do not overlap in the 1st argument, and the return types do not overlap rec_api.erl:40:2: The specification for rec_api:adt_r1/0 has an opaque subtype rec_adt:r1() which is violated by the success typing - () -> #r1{f1 :: 'a'} -rec_api.erl:85:13: The attempt to match a term of type - rec_adt:f() against the record field 'f' declared to be of type - rec_api:f() breaks the opacity of the term + () -> #r1{f1 :: rec_api:a()} +rec_api.erl:85:13: Record construction + #r{f :: rec_adt:f(), o :: 2} violates the declared type of field f :: + rec_api:f() rec_api.erl:99:18: Record construction #r2{f1 :: 10} violates the declared type of field f1 :: rec_api:a() +simple1_api.erl:102:5: Guard test + simple1_api:o2() =:= + A :: simple1_api:o1() can never succeed +simple1_api.erl:108:5: The test + simple1_api:o1() =:= + simple1_api:o2() can never evaluate to 'true' simple1_api.erl:113:5: The test simple1_api:d1() =:= simple1_api:d2() can never evaluate to 'true' simple1_api.erl:118:5: Guard test simple1_api:d2() =:= A :: simple1_api:d1() can never succeed -simple1_api.erl:142:5: 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:123:5: The test + simple1_api:d1() =/= + simple1_api:d2() can never evaluate to 'false' +simple1_api.erl:128:5: The test + simple1_api:d1() /= + simple1_api:d2() can never evaluate to 'false' +simple1_api.erl:142:5: The test + simple1_adt:o1() =:= + simple1_adt:o2() can never evaluate to 'true' simple1_api.erl:148:5: Guard test simple1_adt:o2() =:= - A :: simple1_adt:o1() contains opaque terms as 1st and 2nd arguments -simple1_api.erl:154:5: 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:5: 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:5: Attempt to test for equality between a term of type - simple1_adt:c2() and a term of opaque type - simple1_adt:c1() + A :: simple1_adt:o1() can never succeed +simple1_api.erl:154:5: The test + simple1_adt:o1() =/= + simple1_adt:o2() can never evaluate to 'false' +simple1_api.erl:160:5: The test + simple1_adt:o1() /= + simple1_adt:o2() can never evaluate to 'false' +simple1_api.erl:165:5: The test + simple1_adt:c1() =:= + simple1_adt:c2() can never evaluate to 'true' simple1_api.erl:181:8: Guard test A :: simple1_adt:d1() =< B :: simple1_adt:d2() contains opaque terms as 1st and 2nd arguments -simple1_api.erl:185:13: Guard test +simple1_api.erl:185:8: Guard test 'a' =< B :: simple1_adt:d2() contains an opaque term as 2nd argument simple1_api.erl:189:8: Guard test A :: simple1_adt:d1() =< 'd' contains an opaque term as 1st argument -simple1_api.erl:197:5: The type test is_integer - (A :: simple1_adt:d1()) breaks the opacity of the term A:: - simple1_adt:d1() simple1_api.erl:221:8: Guard test A :: simple1_api:i1() > 3 can never succeed simple1_api.erl:225:8: Guard test A :: simple1_adt:i1() > - 3 contains an opaque term as 1st argument + 3 can never succeed simple1_api.erl:233:8: Guard test A :: simple1_adt:i1() < 3 contains an opaque term as 1st argument @@ -148,28 +128,14 @@ simple1_api.erl:243:8: Guard test 3 can never succeed simple1_api.erl:257:8: Guard test is_function (T :: simple1_api:o1()) can never succeed -simple1_api.erl:265:20: Guard test is_function - (T :: simple1_adt:o1()) breaks the opacity of its argument -simple1_api.erl:269:5: The type test is_function - (T :: simple1_adt:o1()) breaks the opacity of the term T:: - simple1_adt:o1() +simple1_api.erl:265:8: Guard test is_function + (T :: simple1_adt:o1()) can never succeed simple1_api.erl:274:8: Guard test is_function (T :: simple1_api:o1(), A :: simple1_api:i1()) can never succeed -simple1_api.erl:284:20: Guard test is_function - (T :: simple1_adt:o1(), - A :: simple1_adt:i1()) breaks the opacity of its argument -simple1_api.erl:289:5: The type test is_function +simple1_api.erl:284:8: Guard test is_function (T :: simple1_adt:o1(), - A :: simple1_adt:i1()) breaks the opacity of the term T:: - simple1_adt:o1() -simple1_api.erl:294:20: 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:5: The type test is_function - (T :: simple1_adt:o1(), - A :: simple1_api:i1()) breaks the opacity of the term T:: - simple1_adt:o1() + A :: simple1_adt:i1()) can never succeed simple1_api.erl:306:8: Guard test B :: simple1_api:b2() =:= 'true' can never succeed @@ -179,56 +145,38 @@ simple1_api.erl:315:8: Guard test simple1_api.erl:319:16: Guard test not(and ('true', 'true')) can never succeed +simple1_api.erl:333:2: Invalid type specification for function simple1_api:bool_t7/0. + The success typing is simple1_api:bool_t7 + () -> none() + But the spec is simple1_api:bool_t7 + () -> integer() + The return types do not overlap simple1_api.erl:337:8: Clause guard cannot succeed. simple1_api.erl:342:8: Guard test B :: simple1_adt:b2() =:= - 'true' contains an opaque term as 1st argument -simple1_api.erl:347:8: Guard test - A :: simple1_adt:b1() =:= - 'true' contains an opaque term as 1st argument -simple1_api.erl:355:2: Invalid type specification for function simple1_api:bool_adt_t6/1. - The success typing is simple1_api:bool_adt_t6 - ('true') -> 1 - But the spec is simple1_api:bool_adt_t6 - (simple1_adt:b1()) -> integer() - They do not overlap in the 1st argument + 'true' can never succeed +simple1_api.erl:361:2: Invalid type specification for function simple1_api:bool_t8/0. + The success typing is simple1_api:bool_t8 + () -> none() + But the spec is simple1_api:bool_t8 + () -> integer() + The return types do not overlap simple1_api.erl:365:8: Clause guard cannot succeed. -simple1_api.erl:368:2: Invalid type specification for function simple1_api:bool_adt_t8/2. - The success typing is simple1_api:bool_adt_t8 - (boolean(), boolean()) -> 1 - But the spec is simple1_api:bool_adt_t8 - (simple1_adt:b1(), simple1_adt:b2()) -> integer() - They do not overlap in the 1st and 2nd arguments +simple1_api.erl:374:2: Invalid type specification for function simple1_api:bool_t9/0. + The success typing is simple1_api:bool_t9 + () -> none() + But the spec is simple1_api:bool_t9 + () -> integer() + The return types do not overlap simple1_api.erl:378:8: Clause guard cannot succeed. -simple1_api.erl:381:2: Invalid type specification for function simple1_api:bool_adt_t9/2. - The success typing is simple1_api:bool_adt_t9 - ('false', 'false') -> 1 - But the spec is simple1_api:bool_adt_t9 - (simple1_adt:b1(), simple1_adt:b2()) -> integer() - They do not overlap in the 1st and 2nd arguments simple1_api.erl:407:12: The size simple1_adt:i1() breaks the opacity of A -simple1_api.erl:418:9: The attempt to match a term of type - non_neg_integer() against the variable A breaks the opacity of - simple1_adt:i1() -simple1_api.erl:425:9: The attempt to match a term of type - non_neg_integer() against the variable B breaks the opacity of - simple1_adt:i1() simple1_api.erl:432:9: The pattern <<_:B>> can never match the type any() -simple1_api.erl:448:9: The attempt to match a term of type - non_neg_integer() against the variable Sz breaks the opacity of - simple1_adt:i1() simple1_api.erl:460:9: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary>> breaks the opacity of the term -simple1_api.erl:478:9: The call 'foo':A - (A :: simple1_adt:a()) breaks the opacity of the term A :: - simple1_adt:a() -simple1_api.erl:486:5: The call A:'foo' - (A :: simple1_adt:a()) breaks the opacity of the term A :: - simple1_adt:a() simple1_api.erl:499:9: The call 'foo':A (A :: simple1_api:i()) requires that A is of type atom() not @@ -247,57 +195,51 @@ simple1_api.erl:511:5: The call A:'foo' simple1_adt:i() simple1_api.erl:519:9: Guard test A :: simple1_adt:d2() == - B :: simple1_adt:d1() contains opaque terms as 1st and 2nd arguments + B :: simple1_adt:d1() can never succeed +simple1_api.erl:521:9: Guard test + A :: simple1_adt:d2() == + A :: simple1_adt:d2() contains opaque terms as 1st and 2nd arguments simple1_api.erl:534:9: Guard test A :: simple1_adt:d1() >= 3 contains an opaque term as 1st argument simple1_api.erl:536:9: Guard test A :: simple1_adt:d1() == - 3 contains an opaque term as 1st argument + 3 can never succeed simple1_api.erl:538:9: Guard test A :: simple1_adt:d1() =:= - 3 contains an opaque term as 1st argument -simple1_api.erl:548:5: 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:5: The call erlang:'=<' - (A :: simple1_adt:d1(), - B :: simple1_adt:d2()) contains opaque terms as 1st and 2nd arguments when terms of different types are expected in these positions -simple1_api.erl:565:17: Guard test - {digraph:graph(), 3} > - {digraph:graph(), atom() | ets:tid()} contains an opaque term as 2nd argument + 3 can never succeed +simple1_api.erl:540:9: Guard test + A :: simple1_adt:d1() == + A :: simple1_adt:d1() contains opaque terms as 1st and 2nd arguments simple1_api.erl:91:2: The specification for simple1_api:tup/0 has an opaque subtype simple1_adt:tuple1() which is violated by the success typing () -> {'a', 'b'} simple2_api.erl:100:19: 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:100:19: The call lists:flatten + (A :: simple1_adt:tuple1()) will never return since it differs in the 1st argument from the success typing arguments: + ([any()]) simple2_api.erl:116:19: 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:16: Guard test - {simple1_adt:d1(), 3} > - {simple1_adt:d1(), simple1_adt:tuple1()} contains an opaque term as 2nd argument -simple2_api.erl:125:19: 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:5: 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:17: 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:5: 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:24: 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 + []) will never return since it differs in the 2nd argument from the success typing arguments: + (any(), + pos_integer(), + maybe_improper_list()) simple2_api.erl:67:29: 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 + A :: simple1_adt:tuple1()) will never return since it differs in the 3rd argument from the success typing arguments: + (any(), + pos_integer(), + maybe_improper_list()) simple2_api.erl:96:37: The call lists:keyreplace ('a', 1, diff --git a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl index f01cc5e51908..ff991a201a4b 100644 --- a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl +++ b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_adt.erl @@ -1,6 +1,6 @@ -module(rec_adt). --export([new/0, get_a/1, get_b/1, set_a/2, set_b/2]). +-export([new/0, new/1, get_a/1, get_b/1, set_a/2, set_b/2]). -record(rec, {a :: atom(), b = 0 :: integer()}). @@ -9,6 +9,9 @@ -spec new() -> rec(). new() -> #rec{a = gazonk, b = 42}. +-spec new(integer()) -> rec(). +new(B) -> #rec{a = gazonk, b = B}. + -spec get_a(rec()) -> atom(). get_a(#rec{a = A}) -> A. diff --git a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl index 358e9f918ca4..24597e85d4db 100644 --- a/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl +++ b/lib/dialyzer/test/indent_SUITE_data/src/rec/rec_use.erl @@ -1,6 +1,6 @@ -module(rec_use). --export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0, wrong4/0]). +-export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0]). ok1() -> rec_adt:set_a(rec_adt:new(), foo). @@ -13,7 +13,7 @@ ok2() -> B1 =:= B2. wrong1() -> - case rec_adt:new() of + case rec_adt:new(42) of {rec, _, 42} -> weird1; R when tuple_size(R) =:= 3 -> weird2 end. @@ -25,6 +25,3 @@ wrong2() -> wrong3() -> R = rec_adt:new(), R =:= {rec, gazonk, 42}. - -wrong4() -> - tuple_size(rec_adt:new()). diff --git a/lib/dialyzer/test/map_SUITE_data/results/loop b/lib/dialyzer/test/map_SUITE_data/results/loop index aaa8a676e868..32df0cd49c77 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/loop +++ b/lib/dialyzer/test/map_SUITE_data/results/loop @@ -1,4 +1,13 @@ loop.erl:63:27: The call loop:start_timer(#loop{state::'idle' | 'waiting',queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1':=10, 2:=10}}) does not have a term of type #loop{state::'idle' | 'waiting',timer::timer:tref(),queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}} (with opaque subterms) as 1st argument +loop.erl:63:27: The call loop:start_timer(#loop{state::'idle' | 'waiting',queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1':=10, 2:=10}}) will never return since it differs in the 1st argument from the success typing arguments: (#loop{state::'idle' | 'waiting',timer::timer:tref(),queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}}) +loop.erl:66:2: Invalid type specification for function loop:wait/1. + The success typing is loop:wait(_) -> none() + But the spec is loop:wait(#loop{}) -> {'noreply',#loop{}} + The return types do not overlap loop.erl:67:1: Function wait/1 has no local return +loop.erl:80:2: Invalid type specification for function loop:start_timer/1. + The success typing is loop:start_timer(#loop{state::'idle' | 'waiting',timer::timer:tref(),queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}}) -> no_return() + But the spec is loop:start_timer(MV::#loop{}) -> #loop{} + The return types do not overlap loop.erl:85:24: Record construction #loop{state::'idle' | 'waiting',timer::{'error',_} | {'ok',timer:tref()},queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}} violates the declared type of field timer::'undefined' | timer:tref() diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_galore b/lib/dialyzer/test/map_SUITE_data/results/map_galore index 25cfe920d8c2..c13ddc97e395 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/map_galore +++ b/lib/dialyzer/test/map_SUITE_data/results/map_galore @@ -24,5 +24,6 @@ map_galore.erl:2280:50: Cons will produce an improper list since its 2nd argumen map_galore.erl:2280:50: The call maps:from_list([{'a', 'b'} | {'b', 'a'}]) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:2281:50: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:2282:50: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:982:12: The test #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c' | 'new'} =/= #{1:='a', 2:='b', 3:='right', 4:='d', 5:='e', float()=>'c' | 'new'} can never evaluate to 'false' map_galore.erl:997:55: A key of type 'nonexisting' cannot exist in a map of type #{} map_galore.erl:998:52: A key of type 'nonexisting' cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c'} diff --git a/lib/dialyzer/test/map_SUITE_data/results/opaque_key b/lib/dialyzer/test/map_SUITE_data/results/opaque_key index c3df7a5560fc..965404a4edb0 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/opaque_key +++ b/lib/dialyzer/test/map_SUITE_data/results/opaque_key @@ -20,12 +20,10 @@ opaque_key_adt.erl:59:2: Invalid type specification for function opaque_key_adt: But the spec is opaque_key_adt:smt2() -> smt(1) The return types do not overlap opaque_key_use.erl:13:5: The test opaque_key_use:t() =:= opaque_key_use:t(_) can never evaluate to 'true' -opaque_key_use.erl:24:5: Attempt to test for equality between a term of type opaque_key_adt:t(_) and a term of opaque type opaque_key_adt:t() -opaque_key_use.erl:37:1: Function adt_mm1/0 has no local return +opaque_key_use.erl:24:5: The test opaque_key_adt:t() =:= opaque_key_adt:t(_) can never evaluate to 'true' opaque_key_use.erl:40:5: The attempt to match a term of type opaque_key_adt:m() against the pattern #{A:=R} breaks the opacity of the term -opaque_key_use.erl:48:1: Function adt_mu1/0 has no local return opaque_key_use.erl:51:5: Guard test is_map(M::opaque_key_adt:m()) breaks the opacity of its argument -opaque_key_use.erl:53:1: Function adt_mu2/0 has no local return +opaque_key_use.erl:51:5: The attempt to match the term against the variable M breaks the opacity of the term opaque_key_use.erl:56:5: Guard test is_map(M::opaque_key_adt:m()) breaks the opacity of its argument -opaque_key_use.erl:58:1: Function adt_mu3/0 has no local return +opaque_key_use.erl:56:5: The attempt to match the term against the variable M breaks the opacity of the term opaque_key_use.erl:60:5: Guard test is_map(M::opaque_key_adt:m()) breaks the opacity of its argument diff --git a/lib/dialyzer/test/nowarn_function_SUITE_data/results/warn_function b/lib/dialyzer/test/nowarn_function_SUITE_data/results/warn_function index da14df557648..b2ec5a368fbf 100644 --- a/lib/dialyzer/test/nowarn_function_SUITE_data/results/warn_function +++ b/lib/dialyzer/test/nowarn_function_SUITE_data/results/warn_function @@ -1,5 +1,9 @@ warn_function.erl:12:17: Guard test 1 =:= B::fun((none()) -> no_return()) can never succeed +warn_function.erl:16:2: Invalid type specification for function warn_function:b/1. + The success typing is warn_function:b(_) -> none() + But the spec is warn_function:b(_) -> integer() + The return types do not overlap warn_function.erl:18:1: Function b/1 has no local return warn_function.erl:22:5: Guard test 2 =:= A::fun((none()) -> no_return()) can never succeed warn_function.erl:26:1: Function c/0 has no local return diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/array b/lib/dialyzer/test/opaque_SUITE_data/results/array index d7f41014b212..08bf74c85399 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/array +++ b/lib/dialyzer/test/opaque_SUITE_data/results/array @@ -1,3 +1,3 @@ -array_use.erl:12:8: The type test is_tuple(array:array(_)) breaks the opacity of the term array:array(_) +array_use.erl:14:5: The pattern 'false' can never match the type 'true' array_use.erl:9:3: The attempt to match a term of type array:array(_) against the pattern {'array', _, _, 'undefined', _} breaks the opacity of the term diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/crash b/lib/dialyzer/test/opaque_SUITE_data/results/crash index 90279341d529..0be4282e8c04 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/crash +++ b/lib/dialyzer/test/opaque_SUITE_data/results/crash @@ -1,7 +1,11 @@ +crash_1.erl:42:2: Invalid type specification for function crash_1:empty/0. + The success typing is crash_1:empty() -> none() + But the spec is crash_1:empty() -> targetlist() + The return types do not overlap crash_1.erl:45:24: Record construction #targetlist{list::[]} violates the declared type of field list::crash_1:target() crash_1.erl:48:31: The call crash_1:get_using_branch2(Branch::maybe_improper_list(),L::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:1: The pattern <_Branch, []> can never match the type crash_1.erl:52:1: The pattern can never match the type crash_1.erl:54:1: The pattern can never match the type -crash_2.erl:4:2: The specification for crash_2:crash/0 has an opaque subtype queue:queue(_) which is violated by the success typing () -> {tuple(),queue:queue(_)} +crash_2.erl:4:2: The specification for crash_2:crash/0 has an opaque subtype {tuple(),integer()} which is violated by the success typing () -> {tuple(),queue:queue(_)} diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/dict b/lib/dialyzer/test/opaque_SUITE_data/results/dict index 461b30d3767c..3ba316f95fa7 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/dict +++ b/lib/dialyzer/test/opaque_SUITE_data/results/dict @@ -1,15 +1,18 @@ -dict_use.erl:41:3: The attempt to match a term of type dict:dict(_,_) against the pattern 'gazonk' breaks the opacity of the term -dict_use.erl:45:5: The attempt to match a term of type dict:dict(_,_) against the pattern [] breaks the opacity of the term -dict_use.erl:46:5: The attempt to match a term of type dict:dict(_,_) against the pattern 42 breaks the opacity of the term -dict_use.erl:51:5: The attempt to match a term of type dict:dict(_,_) against the pattern [] breaks the opacity of the term -dict_use.erl:52:5: The attempt to match a term of type dict:dict(_,_) against the pattern 42 breaks the opacity of the term +dict_use.erl:41:3: The pattern 'gazonk' can never match the type dict:dict(_,_) +dict_use.erl:45:5: The pattern [] can never match the type dict:dict(_,_) +dict_use.erl:46:5: The pattern 42 can never match the type dict:dict(_,_) +dict_use.erl:51:5: The pattern [] can never match the type dict:dict(_,_) +dict_use.erl:52:5: The pattern 42 can never match the type dict:dict(_,_) dict_use.erl:58:3: Attempt to test for equality between a term of type maybe_improper_list() and a term of opaque type dict:dict(_,_) +dict_use.erl:58:3: The test maybe_improper_list() =:= dict:dict(_,_) can never evaluate to 'true' dict_use.erl:60:3: Attempt to test for inequality between a term of type atom() and a term of opaque type dict:dict(_,_) -dict_use.erl:64:19: Guard test length(D::dict:dict(_,_)) breaks the opacity of its argument -dict_use.erl:65:20: Guard test is_atom(D::dict:dict(_,_)) breaks the opacity of its argument -dict_use.erl:66:20: Guard test is_list(D::dict:dict(_,_)) breaks the opacity of its argument -dict_use.erl:70:3: The type test is_list(dict:dict(_,_)) breaks the opacity of the term dict:dict(_,_) +dict_use.erl:60:3: The test atom() =/= dict:dict(_,_) can never evaluate to 'false' +dict_use.erl:64:12: Guard test length(D::dict:dict(_,_)) can never succeed +dict_use.erl:65:12: Guard test is_atom(D::dict:dict(_,_)) can never succeed +dict_use.erl:66:12: Guard test is_list(D::dict:dict(_,_)) can never succeed dict_use.erl:73:19: The call dict:fetch('foo',[1, 2, 3]) does not have an opaque term of type dict:dict(_,_) as 2nd argument +dict_use.erl:73:19: The call dict:fetch('foo',[1, 2, 3]) will never return since the success typing is (any(),{'dict',non_neg_integer(),non_neg_integer(),pos_integer(),non_neg_integer(),non_neg_integer(),non_neg_integer(),tuple(),tuple()}) -> any() and the contract is (Key,Dict) -> Value when Dict :: dict(Key,Value) dict_use.erl:76:19: The call dict:merge(Fun::any(),42,[1, 2]) does not have opaque terms as 2nd and 3rd arguments +dict_use.erl:76:19: The call dict:merge(Fun::any(),42,[1, 2]) will never return since the success typing is (any(),any(),{'dict',non_neg_integer(),non_neg_integer(),non_neg_integer(),non_neg_integer(),non_neg_integer(),non_neg_integer(),tuple(),tuple()}) -> any() and the contract is (Fun,Dict1,Dict2) -> Dict3 when Fun :: fun((Key,Value1,Value2) -> Value), Dict1 :: dict(Key,Value1), Dict2 :: dict(Key,Value2), Dict3 :: dict(Key,Value) dict_use.erl:80:7: The call dict:store(42,'elli',{'dict', 0, 16, 16, 8, 80, 48, {[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []}, {{[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []}}}) does not have an opaque term of type dict:dict(_,_) as 3rd argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/ets b/lib/dialyzer/test/opaque_SUITE_data/results/ets index aba95ca9f4f2..f6011e7b63e2 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/ets +++ b/lib/dialyzer/test/opaque_SUITE_data/results/ets @@ -1,4 +1,3 @@ -ets_use.erl:12:20: Guard test is_integer(T::atom() | ets:tid()) breaks the opacity of its argument -ets_use.erl:20:5: The type test is_integer(atom() | ets:tid()) breaks the opacity of the term atom() | ets:tid() -ets_use.erl:7:20: Guard test is_integer(T::ets:tid()) breaks the opacity of its argument +ets_use.erl:12:9: Guard test is_integer(T::atom() | ets:tid()) can never succeed +ets_use.erl:7:9: Guard test is_integer(T::ets:tid()) can never succeed diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop1 index 26dfbb6923c5..f1ec461f17ce 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:1: The pattern [{_, LNorms}] can never match the type [] inf_loop1.erl:121:1: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type [] inf_loop1.erl:129:15: The pattern [{_, Norm} | _] can never match the type [] -inf_loop1.erl:71:74: The call gb_trees:get(Edge::any(),Etab::array:array(_)) does not have an opaque term of type gb_trees:tree(_,_) as 2nd argument +inf_loop1.erl:71:74: The call gb_trees:get(Edge::any(),Etab::array:array(_)) will never return since the success typing is (any(),{_,{_,_,_,_}}) -> any() and the contract is (Key,Tree) -> Value when Tree :: tree(Key,Value) diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 index 7b35563d4344..62948906e5ae 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 +++ b/lib/dialyzer/test/opaque_SUITE_data/results/inf_loop2 @@ -2,4 +2,4 @@ inf_loop2.erl:122:1: The pattern [{_, LNorms}] can never match the type [] inf_loop2.erl:124:1: The pattern [{LinksA, LNormA}, {LinksB, LNormB}] can never match the type [] inf_loop2.erl:132:15: The pattern [{_, Norm} | _] can never match the type [] -inf_loop2.erl:74:74: The call gb_trees:get(Edge::any(),Etab::array:array(_)) does not have an opaque term of type gb_trees:tree(_,_) as 2nd argument +inf_loop2.erl:74:74: The call gb_trees:get(Edge::any(),Etab::array:array(_)) will never return since the success typing is (any(),{_,{_,_,_,_}}) -> any() and the contract is (Key,Tree) -> Value when Tree :: tree(Key,Value) diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/int b/lib/dialyzer/test/opaque_SUITE_data/results/int index 504013883fa9..f4204b17f7be 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/int +++ b/lib/dialyzer/test/opaque_SUITE_data/results/int @@ -1,9 +1,9 @@ int_adt.erl:28:2: Invalid type specification for function int_adt:add_f/2. - The success typing is int_adt:add_f(number() | int_adt:int(),float()) -> number() | int_adt:int() + The success typing is int_adt:add_f(number(),float()) -> number() But the spec is int_adt:add_f(int(),int()) -> int() They do not overlap in the 2nd argument int_adt.erl:32:2: Invalid type specification for function int_adt:div_f/2. - The success typing is int_adt:div_f(number() | int_adt:int(),number() | int_adt:int()) -> float() + The success typing is int_adt:div_f(number(),number()) -> float() But the spec is int_adt:div_f(int(),int()) -> int() The return types do not overlap diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque index 77f45b1f2009..d708349c545c 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque +++ b/lib/dialyzer/test/opaque_SUITE_data/results/mixed_opaque @@ -1,2 +1,4 @@ -mixed_opaque_use.erl:31:16: 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 +mixed_opaque_use.erl:15:2: Body yields the opaque type mixed_opaque_queue_adt:my_queue() whose opacity is broken by the other clauses. +mixed_opaque_use.erl:16:2: Body yields the opaque type mixed_opaque_rec_adt:rec() whose opacity is broken by the other clauses. +mixed_opaque_use.erl:31:16: The call mixed_opaque_rec_adt:get_a(Q::mixed_opaque_queue_adt:my_queue()) will never return since the success typing is ({'rec',atom(),integer()}) -> atom() and the contract is (rec()) -> atom() diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue index 8364d8e9a502..6b2ed03e7d47 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/my_queue +++ b/lib/dialyzer/test/opaque_SUITE_data/results/my_queue @@ -3,5 +3,5 @@ my_queue_use.erl:15:27: The call my_queue_adt:is_empty([]) does not have an opaq my_queue_use.erl:19:26: The call my_queue_adt:add(42,Q0::[]) does not have an opaque term of type my_queue_adt:my_queue() as 2nd argument my_queue_use.erl:24:5: The attempt to match a term of type my_queue_adt:my_queue() against the pattern [42 | Q2] breaks the opacity of the term my_queue_use.erl:30:5: 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:37: Cons will produce an improper list since its 2nd argument is my_queue_adt:my_queue() -my_queue_use.erl:34:37: 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 +my_queue_use.erl:30:5: The test my_queue_adt:my_queue() =:= [] can never evaluate to 'true' +my_queue_use.erl:34:37: 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 diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/opaque b/lib/dialyzer/test/opaque_SUITE_data/results/opaque index cc793a71c7e0..626a528047c0 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/opaque +++ b/lib/dialyzer/test/opaque_SUITE_data/results/opaque @@ -1,3 +1,3 @@ opaque_bug3.erl:19:1: The pattern 'a' can never match the type #c{} -opaque_bug4.erl:20:1: The attempt to match a term of type opaque_adt:abc() against the pattern 'a' breaks the opacity of the term +opaque_bug4.erl:20:5: The attempt to match a term of type opaque_adt:abc() against the pattern 'a' breaks the opacity of the term diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/para b/lib/dialyzer/test/opaque_SUITE_data/results/para index 77106c6afa6a..222813df68fa 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/para +++ b/lib/dialyzer/test/opaque_SUITE_data/results/para @@ -3,13 +3,15 @@ para1.erl:18:5: The test para1:t(_) =:= para1:t(_) can never evaluate to 'true' para1.erl:23:5: The test para1:t(_) =:= para1:t() can never evaluate to 'true' para1.erl:28:5: The test para1:t() =:= para1:t(_) can never evaluate to 'true' para1.erl:33:5: The test {3,2} =:= {'a','b'} can never evaluate to 'true' +para1.erl:38:5: Attempt to test for equality between a term of type para1_adt:t(_) and a term of opaque type para1_adt:t(_) para1.erl:38:5: The test para1_adt:t(_) =:= para1_adt:t(_) can never evaluate to 'true' -para1.erl:43:5: Attempt to test for equality between a term of type para1_adt:t() and a term of opaque type para1_adt:t(_) -para1.erl:48:5: Attempt to test for equality between a term of type para1_adt:t(_) and a term of opaque type para1_adt:t() +para1.erl:43:5: The test para1_adt:t(_) =:= para1_adt:t() can never evaluate to 'true' +para1.erl:48:5: The test para1_adt:t() =:= para1_adt:t(_) can never evaluate to 'true' para1.erl:53:5: The test {3,2} =:= {'a','b'} can never evaluate to 'true' -para2.erl:103:5: Attempt to test for equality between a term of type para2_adt:circ(_,_) and a term of opaque type para2_adt:circ(_) +para2.erl:103:5: The test para2_adt:circ(_) =:= para2_adt:circ(_,_) can never evaluate to 'true' +para2.erl:26:5: The test para2:c1() =:= para2:c2() can never evaluate to 'true' para2.erl:31:5: The test 'a' =:= 'b' can never evaluate to 'true' -para2.erl:61:5: Attempt to test for equality between a term of type para2_adt:c2() and a term of opaque type para2_adt:c1() +para2.erl:61:5: The test para2_adt:c1() =:= para2_adt:c2() can never evaluate to 'true' para2.erl:66:5: The test 'a' =:= 'b' can never evaluate to 'true' para2.erl:88:5: The test para2:circ(_) =:= para2:circ(_,_) can never evaluate to 'true' para3.erl:28:2: Invalid type specification for function para3:ot2/0. @@ -21,13 +23,23 @@ para3.erl:55:2: Invalid type specification for function para3:t2/0. The success typing is para3:t2() -> 'foo' But the spec is para3:t2() -> t1() The return types do not overlap -para3.erl:65:5: The attempt to match a term of type {{{{{para3_adt:ot1(_,_,_,_,_)}}}}} against the pattern {{{{{17}}}}} breaks the opacity of para3_adt:ot1(_,_,_,_,_) +para3.erl:65:5: The pattern {{{{{17}}}}} can never match the type {{{{{para3_adt:ot1(_,_,_,_,_)}}}}} para3.erl:68:5: The pattern {{{{17}}}} can never match the type {{{{{para3_adt:ot1(_,_,_,_,_)}}}}} para3.erl:74:2: The specification for para3:exp_adt/0 has an opaque subtype para3_adt:exp1(_) which is violated by the success typing () -> 3 +para4.erl:21:2: Invalid type specification for function para4:a/1. + The success typing is para4:a(para4:d_all()) -> [{atom() | integer(),atom() | integer()}] + But the spec is para4:a(d_atom()) -> [{atom(),atom()}] + They do not overlap in the 1st argument +para4.erl:26:2: Invalid type specification for function para4:i/1. + The success typing is para4:i(para4:d_all()) -> [{atom() | integer(),atom() | integer()}] + But the spec is para4:i(d_integer()) -> [{integer(),integer()}] + They do not overlap in the 1st argument para4.erl:31:2: Invalid type specification for function para4:t/1. - The success typing is para4:t(para4:d_all() | para4:d_tuple()) -> [{atom() | integer(),atom() | integer()}] + The success typing is para4:t(para4:d_all()) -> [{atom() | integer(),atom() | integer()}] But the spec is para4:t(d_tuple()) -> [{tuple(),tuple()}] - The return types do not overlap + They do not overlap in the 1st argument +para4.erl:79:5: Attempt to test for equality between a term of type para4_adt:int(_) and a term of opaque type para4_adt:int(_) para4.erl:79:5: The test para4_adt:int(_) =:= para4_adt:int(_) can never evaluate to 'true' -para5.erl:13:5: Attempt to test for inequality between a term of type para5_adt:dd(_) and a term of opaque type para5_adt:d() +para5.erl:13:5: The test para5_adt:d() =/= para5_adt:dd(_) can never evaluate to 'false' +para5.erl:8:5: Attempt to test for equality between a term of type para5_adt:d() and a term of opaque type para5_adt:d() para5.erl:8:5: The test para5_adt:d() =:= para5_adt:d() can never evaluate to 'true' diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/queue b/lib/dialyzer/test/opaque_SUITE_data/results/queue index b66ffcb648ce..81477c9852c0 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/queue +++ b/lib/dialyzer/test/opaque_SUITE_data/results/queue @@ -5,7 +5,9 @@ queue_use.erl:27:5: The attempt to match a term of type queue:queue(_) against t queue_use.erl:33:5: Attempt to test for equality between a term of type {[42,...],[]} and a term of opaque type queue:queue(_) queue_use.erl:36:5: The attempt to match a term of type queue:queue(_) against the pattern {F, _R} breaks the opacity of the term queue_use.erl:40:35: The call queue:out({"*", []}) does not have an opaque term of type queue:queue(_) as 1st argument -queue_use.erl:51:25: The call queue_use:is_in_queue(E::42,DB::#db{p::[],q::queue:queue(_)}) contains an opaque term as 2nd argument when terms of different types are expected in these positions -queue_use.erl:56:1: The attempt to match a term of type #db{p::[],q::queue:queue(_)} against the pattern {'db', _, {L1, L2}} breaks the opacity of queue:queue(_) +queue_use.erl:52:2: The pattern 'true' can never match the type 'false' +queue_use.erl:56:24: The attempt to match a term of type queue:queue(_) against the pattern {L1, L2} breaks the opacity of the term queue_use.erl:62:17: The call queue_use:tuple_queue({42, 'gazonk'}) does not have a term of type {_,queue:queue(_)} (with opaque subterms) as 1st argument +queue_use.erl:62:17: The call queue_use:tuple_queue({42, 'gazonk'}) will never return since it differs in the 1st argument from the success typing arguments: ({_,queue:queue(_)}) queue_use.erl:65:17: The call queue:in(F::42,Q::'gazonk') does not have an opaque term of type queue:queue(_) as 2nd argument +queue_use.erl:65:17: The call queue:in(F::42,Q::'gazonk') will never return since the success typing is (any(),{maybe_improper_list(),maybe_improper_list()}) -> {nonempty_maybe_improper_list(),maybe_improper_list()} and the contract is (Item,Q1::queue(Item)) -> Q2::queue(Item) diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/rec b/lib/dialyzer/test/opaque_SUITE_data/results/rec index 60943ea0ce16..220905aa5e65 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/rec +++ b/lib/dialyzer/test/opaque_SUITE_data/results/rec @@ -1,6 +1,5 @@ rec_use.erl:17:2: The attempt to match a term of type rec_adt:rec() against the pattern {'rec', _, 42} breaks the opacity of the term -rec_use.erl:18:20: Guard test tuple_size(R::rec_adt:rec()) breaks the opacity of its argument +rec_use.erl:18:9: Guard test tuple_size(R::rec_adt:rec()) breaks the opacity of its argument rec_use.erl:23:19: The call rec_adt:get_a(R::tuple()) does not have an opaque term of type rec_adt:rec() as 1st argument rec_use.erl:27:5: Attempt to test for equality between a term of type {'rec','gazonk',42} and a term of opaque type rec_adt:rec() -rec_use.erl:30:16: The call erlang:tuple_size(rec_adt:rec()) contains an opaque term as 1st argument when a structured term of type tuple() is expected diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/recrec b/lib/dialyzer/test/opaque_SUITE_data/results/recrec new file mode 100644 index 000000000000..41c16b678b35 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/results/recrec @@ -0,0 +1,51 @@ + +dialyzer_races.erl:1571:5: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:1572:5: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:1973:17: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:1974:17: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2000:17: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2002:21: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2006:25: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2010:25: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2015:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2018:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2021:21: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2023:17: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2025:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2028:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2031:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2034:21: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2036:17: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2038:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2043:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2046:21: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2049:21: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2051:17: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2060:17: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2069:17: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2173:5: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2174:5: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2176:9: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. +dialyzer_races.erl:2177:9: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2179:13: Body yields the type 'undefined' | dict:dict(_,_) which violates the opacity of the other clauses. +dialyzer_races.erl:2183:13: Body yields the opaque type dict:dict(_,_) whose opacity is broken by the other clauses. + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% \ No newline at end of file diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 4c211a442566..5d62ce628e4d 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -3,102 +3,82 @@ exact_api.erl:17:14: The call exact_api:set_type(A::#digraph{vtab::'notable',eta exact_api.erl:23:20: The call digraph:delete(G::#digraph{vtab::'notable',etab::'notable',ntab::'notable',cyclic::'true'}) does not have an opaque term of type digraph:graph() as 1st argument exact_api.erl:55:5: The attempt to match a term of type exact_adt:exact_adt() against the pattern {'exact_adt'} breaks the opacity of the term exact_api.erl:59:39: 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:5: 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: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:18: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opacity of its argument -is_rec.erl:23:18: Guard test is_record({simple1_adt:d1(),1},'r',2) breaks the opacity of its argument -is_rec.erl:41:15: 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:18: 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:15: 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:18: 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:18: Guard test is_record(A::simple1_adt:d1(),'r',2) breaks the opacity of its argument +is_rec.erl:19:8: Guard test is_record(A::simple1_adt:d1(),'r',2) can never succeed +is_rec.erl:23:8: Guard test is_record({simple1_adt:d1(),1},'r',2) can never succeed +is_rec.erl:57:8: Guard test is_record(A::simple1_adt:d1(),'r',2) can never succeed is_rec.erl:61:8: The record #r{f1::simple1_adt:d1()} violates the declared type for #r{} -is_rec.erl:65:5: 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:104:5: Matching of pattern {'r2', 10} tagged with a record name violates the declared type of #r2{f1::10} -rec_api.erl:113:5: The attempt to match a term of type #r3{f1::queue:queue(_)} against the pattern {'r3', 'a'} breaks the opacity of queue:queue(_) +rec_api.erl:113:5: The pattern {'r3', 'a'} can never match the type #r3{f1::queue:queue(_)} rec_api.erl:118:18: Record construction #r3{f1::10} violates the declared type of field f1::queue:queue(_) -rec_api.erl:123:5: The attempt to match a term of type #r3{f1::10} against the pattern {'r3', 10} breaks the opacity of queue:queue(_) +rec_api.erl:123:5: Matching of pattern {'r3', 10} tagged with a record name violates the declared type of #r3{f1::10} rec_api.erl:24:18: Record construction #r1{f1::10} violates the declared type of field f1::rec_api:a() rec_api.erl:29:5: Matching of pattern {'r1', 10} tagged with a record name violates the declared type of #r1{f1::10} +rec_api.erl:33:10: The attempt to match a term of type rec_adt:a() against the pattern 'a' breaks the opacity of the term rec_api.erl:33:5: The attempt to match a term of type rec_adt:r1() against the pattern {'r1', 'a'} breaks the opacity of the term -rec_api.erl:35:2: Invalid type specification for function rec_api:adt_t1/1. - The success typing is rec_api:adt_t1(#r1{f1::'a'}) -> #r1{f1::'a'} - But the spec is rec_api:adt_t1(rec_adt:r1()) -> rec_adt:r1() - They do not overlap in the 1st argument, and the return types do not overlap -rec_api.erl:40:2: The specification for rec_api:adt_r1/0 has an opaque subtype rec_adt:r1() which is violated by the success typing () -> #r1{f1::'a'} -rec_api.erl:85:13: The attempt to match a term of type rec_adt:f() against the record field 'f' declared to be of type rec_api:f() breaks the opacity of the term +rec_api.erl:35:2: The specification for rec_api:adt_t1/1 has an opaque subtype rec_adt:r1() which is violated by the success typing (#r1{f1::'a'}) -> #r1{f1::'a'} +rec_api.erl:40:2: The specification for rec_api:adt_r1/0 has an opaque subtype rec_adt:r1() which is violated by the success typing () -> #r1{f1::rec_api:a()} +rec_api.erl:85:13: Record construction #r{f::rec_adt:f(),o::2} violates the declared type of field f::rec_api:f() rec_api.erl:99:18: Record construction #r2{f1::10} violates the declared type of field f1::rec_api:a() +simple1_api.erl:102:5: Guard test simple1_api:o2() =:= A::simple1_api:o1() can never succeed +simple1_api.erl:108:5: The test simple1_api:o1() =:= simple1_api:o2() can never evaluate to 'true' simple1_api.erl:113:5: The test simple1_api:d1() =:= simple1_api:d2() can never evaluate to 'true' simple1_api.erl:118:5: Guard test simple1_api:d2() =:= A::simple1_api:d1() can never succeed -simple1_api.erl:142:5: 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:5: Guard test simple1_adt:o2() =:= A::simple1_adt:o1() contains opaque terms as 1st and 2nd arguments -simple1_api.erl:154:5: 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:5: 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:5: 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:123:5: The test simple1_api:d1() =/= simple1_api:d2() can never evaluate to 'false' +simple1_api.erl:128:5: The test simple1_api:d1() /= simple1_api:d2() can never evaluate to 'false' +simple1_api.erl:142:5: The test simple1_adt:o1() =:= simple1_adt:o2() can never evaluate to 'true' +simple1_api.erl:148:5: Guard test simple1_adt:o2() =:= A::simple1_adt:o1() can never succeed +simple1_api.erl:154:5: The test simple1_adt:o1() =/= simple1_adt:o2() can never evaluate to 'false' +simple1_api.erl:160:5: The test simple1_adt:o1() /= simple1_adt:o2() can never evaluate to 'false' +simple1_api.erl:165:5: The test simple1_adt:c1() =:= simple1_adt:c2() can never evaluate to 'true' simple1_api.erl:181:8: Guard test A::simple1_adt:d1() =< B::simple1_adt:d2() contains opaque terms as 1st and 2nd arguments -simple1_api.erl:185:13: Guard test 'a' =< B::simple1_adt:d2() contains an opaque term as 2nd argument +simple1_api.erl:185:8: Guard test 'a' =< B::simple1_adt:d2() contains an opaque term as 2nd argument simple1_api.erl:189:8: Guard test A::simple1_adt:d1() =< 'd' contains an opaque term as 1st argument -simple1_api.erl:197:5: The type test is_integer(A::simple1_adt:d1()) breaks the opacity of the term A::simple1_adt:d1() simple1_api.erl:221:8: Guard test A::simple1_api:i1() > 3 can never succeed -simple1_api.erl:225:8: Guard test A::simple1_adt:i1() > 3 contains an opaque term as 1st argument +simple1_api.erl:225:8: Guard test A::simple1_adt:i1() > 3 can never succeed simple1_api.erl:233:8: Guard test A::simple1_adt:i1() < 3 contains an opaque term as 1st argument simple1_api.erl:239:8: Guard test A::1 > 3 can never succeed simple1_api.erl:243:8: Guard test A::1 > 3 can never succeed simple1_api.erl:257:8: Guard test is_function(T::simple1_api:o1()) can never succeed -simple1_api.erl:265:20: Guard test is_function(T::simple1_adt:o1()) breaks the opacity of its argument -simple1_api.erl:269:5: The type test is_function(T::simple1_adt:o1()) breaks the opacity of the term T::simple1_adt:o1() +simple1_api.erl:265:8: Guard test is_function(T::simple1_adt:o1()) can never succeed simple1_api.erl:274:8: Guard test is_function(T::simple1_api:o1(),A::simple1_api:i1()) can never succeed -simple1_api.erl:284:20: Guard test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opacity of its argument -simple1_api.erl:289:5: The type test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) breaks the opacity of the term T::simple1_adt:o1() -simple1_api.erl:294:20: 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:5: The type test is_function(T::simple1_adt:o1(),A::simple1_api:i1()) breaks the opacity of the term T::simple1_adt:o1() +simple1_api.erl:284:8: Guard test is_function(T::simple1_adt:o1(),A::simple1_adt:i1()) can never succeed simple1_api.erl:306:8: Guard test B::simple1_api:b2() =:= 'true' can never succeed simple1_api.erl:315:8: Guard test A::simple1_api:b1() =:= 'false' can never succeed simple1_api.erl:319:16: Guard test not(and('true','true')) can never succeed +simple1_api.erl:333:2: Invalid type specification for function simple1_api:bool_t7/0. + The success typing is simple1_api:bool_t7() -> none() + But the spec is simple1_api:bool_t7() -> integer() + The return types do not overlap simple1_api.erl:337:8: Clause guard cannot succeed. -simple1_api.erl:342:8: Guard test B::simple1_adt:b2() =:= 'true' contains an opaque term as 1st argument -simple1_api.erl:347:8: Guard test A::simple1_adt:b1() =:= 'true' contains an opaque term as 1st argument -simple1_api.erl:355:2: Invalid type specification for function simple1_api:bool_adt_t6/1. - The success typing is simple1_api:bool_adt_t6('true') -> 1 - But the spec is simple1_api:bool_adt_t6(simple1_adt:b1()) -> integer() - They do not overlap in the 1st argument +simple1_api.erl:342:8: Guard test B::simple1_adt:b2() =:= 'true' can never succeed +simple1_api.erl:361:2: Invalid type specification for function simple1_api:bool_t8/0. + The success typing is simple1_api:bool_t8() -> none() + But the spec is simple1_api:bool_t8() -> integer() + The return types do not overlap simple1_api.erl:365:8: Clause guard cannot succeed. -simple1_api.erl:368:2: Invalid type specification for function simple1_api:bool_adt_t8/2. - The success typing is simple1_api:bool_adt_t8(boolean(),boolean()) -> 1 - But the spec is simple1_api:bool_adt_t8(simple1_adt:b1(),simple1_adt:b2()) -> integer() - They do not overlap in the 1st and 2nd arguments +simple1_api.erl:374:2: Invalid type specification for function simple1_api:bool_t9/0. + The success typing is simple1_api:bool_t9() -> none() + But the spec is simple1_api:bool_t9() -> integer() + The return types do not overlap simple1_api.erl:378:8: Clause guard cannot succeed. -simple1_api.erl:381:2: Invalid type specification for function simple1_api:bool_adt_t9/2. - The success typing is simple1_api:bool_adt_t9('false','false') -> 1 - But the spec is simple1_api:bool_adt_t9(simple1_adt:b1(),simple1_adt:b2()) -> integer() - They do not overlap in the 1st and 2nd arguments simple1_api.erl:407:12: The size simple1_adt:i1() breaks the opacity of A -simple1_api.erl:418:9: The attempt to match a term of type non_neg_integer() against the variable A breaks the opacity of simple1_adt:i1() -simple1_api.erl:425:9: The attempt to match a term of type non_neg_integer() against the variable B breaks the opacity of simple1_adt:i1() simple1_api.erl:432:9: The pattern <<_:B>> can never match the type any() -simple1_api.erl:448:9: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opacity of simple1_adt:i1() simple1_api.erl:460:9: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary>> breaks the opacity of the term -simple1_api.erl:478:9: The call 'foo':A(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() -simple1_api.erl:486:5: The call A:'foo'(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() simple1_api.erl:499:9: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() simple1_api.erl:503:9: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() simple1_api.erl:507:5: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() simple1_api.erl:511:5: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() -simple1_api.erl:519:9: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments +simple1_api.erl:519:9: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() can never succeed +simple1_api.erl:521:9: Guard test A::simple1_adt:d2() == A::simple1_adt:d2() contains opaque terms as 1st and 2nd arguments simple1_api.erl:534:9: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument -simple1_api.erl:536:9: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument -simple1_api.erl:538:9: Guard test A::simple1_adt:d1() =:= 3 contains an opaque term as 1st argument -simple1_api.erl:548:5: 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:5: The call erlang:'=<'(A::simple1_adt:d1(),B::simple1_adt:d2()) contains opaque terms as 1st and 2nd arguments when terms of different types are expected in these positions -simple1_api.erl:565:17: Guard test {digraph:graph(),3} > {digraph:graph(),atom() | ets:tid()} contains an opaque term as 2nd argument +simple1_api.erl:536:9: Guard test A::simple1_adt:d1() == 3 can never succeed +simple1_api.erl:538:9: Guard test A::simple1_adt:d1() =:= 3 can never succeed +simple1_api.erl:540:9: Guard test A::simple1_adt:d1() == A::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments simple1_api.erl:91:2: The specification for simple1_api:tup/0 has an opaque subtype simple1_adt:tuple1() which is violated by the success typing () -> {'a','b'} simple2_api.erl:100:19: 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:100:19: The call lists:flatten(A::simple1_adt:tuple1()) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) simple2_api.erl:116:19: 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:16: Guard test {simple1_adt:d1(),3} > {simple1_adt:d1(),simple1_adt:tuple1()} contains an opaque term as 2nd argument -simple2_api.erl:125:19: 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:5: 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:17: 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:5: 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:24: 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:29: 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:59:24: The call lists:keysearch(1,A::simple1_adt:d1(),[]) will never return since it differs in the 2nd argument from the success typing arguments: (any(),pos_integer(),maybe_improper_list()) +simple2_api.erl:67:29: The call lists:keysearch('key',1,A::simple1_adt:tuple1()) will never return since it differs in the 3rd argument from the success typing arguments: (any(),pos_integer(),maybe_improper_list()) simple2_api.erl:96:37: 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/timer b/lib/dialyzer/test/opaque_SUITE_data/results/timer index d921968bc896..85d59db48375 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/timer +++ b/lib/dialyzer/test/opaque_SUITE_data/results/timer @@ -1,4 +1,5 @@ timer_use.erl:16:5: The pattern 'gazonk' can never match the type {'error',_} | {'ok',timer:tref()} -timer_use.erl:17:5: The attempt to match a term of type {'error',_} | {'ok',timer:tref()} against the pattern {'ok', 42} breaks the opacity of timer:tref() -timer_use.erl:18:5: The attempt to match a term of type {'error',_} | {'ok',timer:tref()} against the pattern {Tag, 'gazonk'} breaks the opacity of timer:tref() +timer_use.erl:17:5: The pattern {'ok', 42} can never match the type {'error',_} | {'ok',timer:tref()} +timer_use.erl:18:10: The attempt to match a term of type timer:tref() against the pattern {_, _} breaks the opacity of the term +timer_use.erl:19:24: Guard test Tag::'error' =/= 'error' can never succeed diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/union b/lib/dialyzer/test/opaque_SUITE_data/results/union index c05e17999eee..c21101ba686d 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/union +++ b/lib/dialyzer/test/opaque_SUITE_data/results/union @@ -1,5 +1,4 @@ union_use.erl:12:3: The attempt to match a term of type union_adt:u() against the pattern 'aaa' breaks the opacity of the term -union_use.erl:16:3: The type test is_tuple(union_adt:u()) breaks the opacity of the term union_adt:u() -union_use.erl:7:20: Guard test is_atom(A::union_adt:u()) breaks the opacity of its argument -union_use.erl:8:21: Guard test is_tuple(T::union_adt:u()) breaks the opacity of its argument +union_use.erl:7:12: Guard test is_atom(A::union_adt:u()) breaks the opacity of its argument +union_use.erl:8:12: Guard test is_tuple(T::union_adt:u()) breaks the opacity of its argument diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/weird b/lib/dialyzer/test/opaque_SUITE_data/results/weird index 8b9cda85dd0c..76c91b8b5dc2 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/weird +++ b/lib/dialyzer/test/opaque_SUITE_data/results/weird @@ -1,6 +1,6 @@ weird_warning1.erl:15:1: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #b{q::queue:queue(_)} weird_warning2.erl:13:1: Matching of pattern <{'b', Queue}, Key, Value> tagged with a record name violates the declared type of <#a{d::dict:dict(_,_)},'my_key','my_value'> -weird_warning3.erl:14:17: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') does not have a term of type #a{d::dict:dict(_,_)} | #b{q::queue:queue(_)} (with opaque subterms) as 1st argument -weird_warning3.erl:16:1: The attempt to match a term of type #a{d::queue:queue(_)} against the pattern {'a', Dict} breaks the opacity of queue:queue(_) +weird_warning3.erl:14:17: The call weird_warning3:add_element(#a{d::queue:queue(_)},'my_key','my_value') will never return since it differs in the 1st argument from the success typing arguments: (#a{d::dict:dict(_,_)} | #b{q::queue:queue(_)},any(),any()) +weird_warning3.erl:16:1: Matching of pattern {'a', Dict} tagged with a record name violates the declared type of #a{d::queue:queue(_)} weird_warning3.erl:18:1: Matching of pattern {'b', Queue} tagged with a record name violates the declared type of #a{d::queue:queue(_)} diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/wings b/lib/dialyzer/test/opaque_SUITE_data/results/wings index f95916e68044..db6281b8ac0f 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/wings +++ b/lib/dialyzer/test/opaque_SUITE_data/results/wings @@ -1,11 +1,12 @@ -wings_dissolve.erl:142:30: Guard test is_list(List::gb_sets:set(_)) breaks the opacity of its argument -wings_dissolve.erl:311:45: Guard test is_list(Faces::gb_sets:set(_)) breaks the opacity of its argument -wings_dissolve.erl:58:21: Guard test is_list(Faces::gb_sets:set(_)) breaks the opacity of its argument +wings_dissolve.erl:142:22: Guard test is_list(List::gb_sets:set(_)) can never succeed +wings_dissolve.erl:311:37: Guard test is_list(Faces::gb_sets:set(_)) can never succeed +wings_dissolve.erl:58:13: Guard test is_list(Faces::gb_sets:set(_)) can never succeed +wings_dissolve.erl:70:27: The call gb_sets:is_empty(Faces::[any(),...]) breaks the contract (Set) -> boolean() when Set :: set() wings_dissolve.erl:70:27: The call gb_sets:is_empty(Faces::[any(),...]) does not have an opaque term of type gb_sets:set(_) as 1st argument wings_edge.erl:245:1: The pattern can never match the type <_,'soft',_> -wings_edge_cmd.erl:70:31: The call gb_trees:size(P::gb_sets:set(_)) does not have an opaque term of type gb_trees:tree(_,_) as 1st argument +wings_edge_cmd.erl:70:31: The call gb_trees:size(P::gb_sets:set(_)) breaks the contract (Tree) -> non_neg_integer() when Tree :: tree() wings_edge_cmd.erl:72:18: The pattern [{_, P} | _] can never match the type [] wings_edge_cmd.erl:72:6: The pattern [_ | Parts] can never match the type [] -wings_io.erl:70:2: The attempt to match a term of type {'empty',queue:queue(_)} against the pattern {'empty', {In, Out}} breaks the opacity of queue:queue(_) +wings_io.erl:70:9: The attempt to match a term of type queue:queue(_) against the pattern {In, Out} breaks the opacity of the term wings_we.erl:195:37: The call wings_util:gb_trees_largest_key(Etab::gb_trees:tree(_,_)) contains an opaque term as 1st argument when a structured term of type {_,{_,_,_,'nil' | {_,_,_,'nil' | {_,_,_,_}}}} is expected 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 cdcaa5f9e827..577e2f9e9c6b 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 @@ -1,5 +1,13 @@ -module(opaque_adt). --export([atom_or_list/1]). +-export([atom_or_list/1, line/1, location/1]). + +-export_type([anno/0]). + +-type annotation() :: {'location', location()} | {'text', string()}. +-nominal column() :: pos_integer(). +-nominal line() :: non_neg_integer(). +-nominal location() :: line() | {line(), column()}. +-opaque anno() :: location() | [annotation(), ...]. -opaque abc() :: 'a' | 'b' | 'c'. @@ -9,3 +17,23 @@ atom_or_list(1) -> a; atom_or_list(2) -> b; atom_or_list(3) -> c; atom_or_list(N) -> lists:duplicate(N, a). + +-spec line(Anno) -> line() when + Anno :: anno(). +line(Anno) -> + case location(Anno) of + {Line, _Column} -> + Line; + Line -> + Line + end. + +-spec location(Anno) -> location() when + Anno :: anno(). + +location(Line) when is_integer(Line) -> + Line; +location({Line, Column}=Location) when is_integer(Line), is_integer(Column) -> + Location; +location(Anno) -> + ext:ernal(Anno, location). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug6.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug6.erl new file mode 100644 index 000000000000..654f0eca60fb --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug6.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(opaque_bug6). +-export([record_update/1]). + +record_update(R) -> + Anno = element(2, R), + [ln(Anno), Anno]. + +ln(Anno) -> + opaque_adt:line(Anno). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl index f01cc5e51908..ff991a201a4b 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_adt.erl @@ -1,6 +1,6 @@ -module(rec_adt). --export([new/0, get_a/1, get_b/1, set_a/2, set_b/2]). +-export([new/0, new/1, get_a/1, get_b/1, set_a/2, set_b/2]). -record(rec, {a :: atom(), b = 0 :: integer()}). @@ -9,6 +9,9 @@ -spec new() -> rec(). new() -> #rec{a = gazonk, b = 42}. +-spec new(integer()) -> rec(). +new(B) -> #rec{a = gazonk, b = B}. + -spec get_a(rec()) -> atom(). get_a(#rec{a = A}) -> A. diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl index 358e9f918ca4..24597e85d4db 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/rec/rec_use.erl @@ -1,6 +1,6 @@ -module(rec_use). --export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0, wrong4/0]). +-export([ok1/0, ok2/0, wrong1/0, wrong2/0, wrong3/0]). ok1() -> rec_adt:set_a(rec_adt:new(), foo). @@ -13,7 +13,7 @@ ok2() -> B1 =:= B2. wrong1() -> - case rec_adt:new() of + case rec_adt:new(42) of {rec, _, 42} -> weird1; R when tuple_size(R) =:= 3 -> weird2 end. @@ -25,6 +25,3 @@ wrong2() -> wrong3() -> R = rec_adt:new(), R =:= {rec, gazonk, 42}. - -wrong4() -> - tuple_size(rec_adt:new()). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl b/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl index ed6810634f74..5af9ee167263 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl +++ b/lib/dialyzer/test/opaque_SUITE_data/src/timer/timer_use.erl @@ -14,7 +14,8 @@ wrong() -> case timer:kill_after(42, self()) of gazonk -> weird; - {ok, 42} -> weirder; + {ok, 42} -> odd; + {ok, {_,_}} -> weirder; {Tag, gazonk} when Tag =/= error -> weirdest; {error, _} -> error end. diff --git a/lib/dialyzer/test/overspecs_SUITE_data/results/opaque b/lib/dialyzer/test/overspecs_SUITE_data/results/opaque index b0b41aba8edc..5f3ebca631bb 100644 --- a/lib/dialyzer/test/overspecs_SUITE_data/results/opaque +++ b/lib/dialyzer/test/overspecs_SUITE_data/results/opaque @@ -1,2 +1,3 @@ -opaque.erl:5:2: The success typing for opaque:accidental_supertype/0 implies that the function might also return gb_sets:set(_) but the specification return is 'other' | {_,_} +opaque.erl:8:9: Body yields the opaque type gb_sets:set(_) whose opacity is broken by the other clauses. +opaque.erl:9:9: Body yields the type 'other' which violates the opacity of the other clauses. diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 index e73698747c1f..6d6c886e6b06 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 +++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 @@ -1,4 +1,6 @@ +asn1ct.erl:1224:2: Body yields the type atom() | ets:tid() which violates the opacity of the other clauses. +asn1ct.erl:1227:2: Body yields the type 'ok' which violates the opacity of the other clauses. asn1ct.erl:1500:2: The variable Err can never match since previous clauses completely covered the type #type{} asn1ct.erl:1596:2: The variable _ can never match since previous clauses completely covered the type 'ber_bin_v2' asn1ct.erl:1673:2: The pattern 'all' can never match the type 'asn1_module' | 'exclusive_decode' | 'partial_decode' diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index ffeb712fc56d..044fc3a954f9 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -21,9 +21,21 @@ mnesia_frag_old_hash.erl:105:6: Call to missing or unexported function erlang:ha mnesia_frag_old_hash.erl:23:2: Callback info about the mnesia_frag_hash behaviour is not available mnesia_index.erl:52:45: The call mnesia_lib:other_val(Var::{_,'commit_work' | 'index' | 'setorbag' | 'storage_type' | {'index',_}},_ReASoN_::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) mnesia_lib.erl:1028:2: The pattern {'EXIT', Reason} can never match the type [any()] | {'error',_} +mnesia_lib.erl:1110:2: Body yields the type atom() | {'error',_} | ets:tid() which violates the opacity of the other clauses. +mnesia_lib.erl:1114:2: Body yields the type {_,_} which violates the opacity of the other clauses. +mnesia_lib.erl:1118:1: Body yields the type 'loaded' which violates the opacity of the other clauses. +mnesia_lib.erl:1119:1: Body yields the type atom() | {'error',_} | ets:tid() which violates the opacity of the other clauses. mnesia_lib.erl:957:2: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} mnesia_lib.erl:959:2: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} +mnesia_loader.erl:101:5: Body yields the type 'false' which violates the opacity of the other clauses. +mnesia_loader.erl:105:3: Body yields the type 'false' which violates the opacity of the other clauses. mnesia_loader.erl:36:43: The call mnesia_lib:other_val(Var::{_,'access_mode' | 'cstruct' | 'db_nodes' | 'setorbag' | 'snmp' | 'storage_type'},Reason::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) +mnesia_loader.erl:85:2: Body yields the type 'ignore' which violates the opacity of the other clauses. +mnesia_loader.erl:87:2: Body yields the type atom() | number() | {_,_} | ets:tid() which violates the opacity of the other clauses. +mnesia_loader.erl:93:3: Body yields the type atom() | number() | {_,_} | ets:tid() which violates the opacity of the other clauses. +mnesia_loader.erl:95:4: Body yields the type number() which violates the opacity of the other clauses. +mnesia_loader.erl:96:4: Body yields the type atom() | {_,_} | ets:tid() which violates the opacity of the other clauses. +mnesia_loader.erl:98:5: Body yields the type atom() | {_,_} | ets:tid() which violates the opacity of the other clauses. mnesia_locker.erl:1017:1: Function system_terminate/4 has no local return mnesia_log.erl:707:23: The test {'error',{[1..255,...],[any(),...]}} | {'ok',_} == atom() can never evaluate to 'true' mnesia_log.erl:727:13: The created fun has no local return @@ -36,6 +48,7 @@ mnesia_schema.erl:1258:2: Guard test FromS::'disc_copies' | 'disc_only_copies' | mnesia_schema.erl:1639:2: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434:2: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451:36: Guard test UseDirAnyway::'false' == 'true' can never succeed -mnesia_text.erl:180:3: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer() | {non_neg_integer(),pos_integer()},atom(),_}} | {'ok',_} +mnesia_schema.erl:496:13: Body yields the type atom() | ets:tid() which violates the opacity of the other clauses. +mnesia_text.erl:180:3: The variable T can never match since previous clauses completely covered the type {'error',{(erl_anno:location() :: {(erl_anno:line() :: non_neg_integer()),pos_integer()} | (erl_anno:line() :: non_neg_integer())),atom(),_}} | {'ok',_} mnesia_tm.erl:1522:1: Function commit_participant/5 has no local return mnesia_tm.erl:2169:1: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/bif1 b/lib/dialyzer/test/small_SUITE_data/results/bif1 index f35efeab5aa1..b3ef29a2a9f3 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/bif1 +++ b/lib/dialyzer/test/small_SUITE_data/results/bif1 @@ -1,3 +1,2 @@ -bif1.erl:13:1: Function string_chars/0 has no local return bif1.erl:16:25: The call string:chars(S::65,10,L2::bif1_adt:s()) contains an opaque term as 3rd argument when terms of different types are expected in these positions diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum index df2a90387b93..b0ed98abdcf1 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -1,7 +1,11 @@ maps_sum.erl:15:2: Invalid type specification for function maps_sum:wrong1/1. - The success typing is maps_sum:wrong1(maps:iterator(_,_) | map()) -> any() + The success typing is maps_sum:wrong1(map() | maps:iterator(_,_)) -> any() But the spec is maps_sum:wrong1([{atom(),term()}]) -> integer() They do not overlap in the 1st argument +maps_sum.erl:24:2: Invalid type specification for function maps_sum:wrong2/1. + The success typing is maps_sum:wrong2(_) -> none() + But the spec is maps_sum:wrong2(#{atom()=>term()}) -> integer() + The return types do not overlap maps_sum.erl:26:1: Function wrong2/1 has no local return maps_sum.erl:27:17: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) diff --git a/lib/dialyzer/test/underspecs_SUITE_data/results/opaque b/lib/dialyzer/test/underspecs_SUITE_data/results/opaque index 80048dea79f0..f18dca9d2943 100644 --- a/lib/dialyzer/test/underspecs_SUITE_data/results/opaque +++ b/lib/dialyzer/test/underspecs_SUITE_data/results/opaque @@ -1,2 +1,4 @@ -opaque.erl:5:2: The specification for opaque:accidental_supertype/0 states that the function might also return {_,_} but the inferred return is 'other' | gb_sets:set(_) +opaque.erl:5:2: Type specification opaque:accidental_supertype() -> {term(),term()} | 'other' is a supertype of the success typing: opaque:accidental_supertype() -> 'other' | gb_sets:set(_) +opaque.erl:8:9: Body yields the opaque type gb_sets:set(_) whose opacity is broken by the other clauses. +opaque.erl:9:9: Body yields the type 'other' which violates the opacity of the other clauses. diff --git a/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings b/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings index 44913ba8b772..3d92d31b7765 100644 --- a/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings +++ b/lib/dialyzer/test/unmatched_returns_SUITE_data/results/lc_warnings @@ -1,5 +1,4 @@ -lc_warnings.erl:32:5: Expression produces a value of type [opaque_atom_adt:opaque_atom()], but this value is unmatched lc_warnings.erl:43:5: Expression produces a value of type [array:array(_)], but this value is unmatched lc_warnings.erl:65:5: Expression produces a value of type [lc_warnings:opaque_tuple()], but this value is unmatched lc_warnings.erl:7:5: Expression produces a value of type ['ok' | {'error',atom()}], but this value is unmatched diff --git a/lib/dialyzer/test/user_SUITE_data/results/gcpFlowControl b/lib/dialyzer/test/user_SUITE_data/results/gcpFlowControl index 7bf005d8ada7..c929a4bbd9b8 100644 --- a/lib/dialyzer/test/user_SUITE_data/results/gcpFlowControl +++ b/lib/dialyzer/test/user_SUITE_data/results/gcpFlowControl @@ -1,2 +1,3 @@ +gcpFlowControl.erl:130:1: Body yields the type atom() | ets:tid() which violates the opacity of the other clauses. gcpFlowControl.erl:171:2: The pattern can never match the type <_,'available' | 'bucket' | 'rejectable' | 'rejects' | 'window',0 | 1 | 20> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 7d54c2b0bf77..04129eea96c8 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -2353,11 +2353,7 @@ map_info(_, T, _) -> bins_sum(L, true = _BinsInfo) -> {0, bins_sum2(L, dict:new())}; bins_sum(L, BinsInfo) when is_integer(BinsInfo) -> - bins_sum3(L, BinsInfo, dict:new()); -bins_sum(_, _) -> - %% We should actually not get here, but just in case - %% we have a logic error somewhere... - dict:new(). + bins_sum3(L, BinsInfo, dict:new()). bins_sum2([], D) -> D; diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl index 3232f1507a31..03546f5b67ff 100644 --- a/lib/diameter/src/base/diameter_sup.erl +++ b/lib/diameter/src/base/diameter_sup.erl @@ -78,7 +78,8 @@ ets_new(List) lists:foreach(fun ets_new/1, List); ets_new({Table, Opts}) -> - ets:new(Table, [named_table, public | Opts]). + ets:new(Table, [named_table, public | Opts]), + ok. %% tree/0 diff --git a/lib/edoc/src/edoc_doclet_markdown.erl b/lib/edoc/src/edoc_doclet_markdown.erl index b8056b2aef5c..796564c70904 100644 --- a/lib/edoc/src/edoc_doclet_markdown.erl +++ b/lib/edoc/src/edoc_doclet_markdown.erl @@ -403,10 +403,10 @@ filter_and_fix_anno(AST, [{{What, F, A}, _Anno, S, D, M} | T], ModuleDoc) end; type -> case lists:search(fun({attribute, _TypeAnno, TO, {FA, _}}) when - is_tuple(FA), TO =:= type orelse TO =:= opaque -> + is_tuple(FA), TO =:= type orelse TO =:= nominal -> {F, A} =:= FA; ({attribute, _TypeAnno, TO, {Type, _, Args}}) when - is_atom(Type), TO =:= type orelse TO =:= opaque -> + is_atom(Type), TO =:= type orelse TO =:= opaque orelse TO =:= nominal-> {F, A} =:= {Type, length(Args)}; (_) -> false diff --git a/lib/edoc/src/edoc_layout_chunks.erl b/lib/edoc/src/edoc_layout_chunks.erl index 548582b51726..b7c77987b8fd 100644 --- a/lib/edoc/src/edoc_layout_chunks.erl +++ b/lib/edoc/src/edoc_layout_chunks.erl @@ -222,7 +222,7 @@ select_tag(#tag{name = type, line = Line, origin = code} = T, TypeAttr = erl_syntax:revert(TypeTree), case TypeAttr of {attribute, _, Type, {Name, _, Args}} - when (type =:= Type orelse opaque =:= Type), + when (type =:= Type orelse opaque =:= Type orelse nominal =:= Type), length(Args) == Arity -> {true, TypeAttr}; _ -> diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index b43e66171f20..835c0162213f 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -243,6 +243,7 @@ get_all_tags(Es) -> %% Turns an opaque type into an abstract datatype. %% Note: top level annotation is ignored. opaque2abstr(opaque, _T) -> undefined; +opaque2abstr(nominal, T) -> T; opaque2abstr(record, T) -> T; opaque2abstr(type, T) -> T. @@ -667,6 +668,7 @@ analyze_type_attribute(Form) -> -spec is_tag(Tag :: tag_kind() | term()) -> boolean(). is_tag(callback) -> true; +is_tag(nominal) -> true; is_tag(opaque) -> true; is_tag(spec) -> true; is_tag(type) -> true; @@ -678,6 +680,7 @@ is_tag(_) -> false. -spec tag(Tag :: atom()) -> tag_kind() | unknown. tag(callback) -> callback; +tag(nominal) -> type; tag(opaque) -> type; tag(spec) -> spec; tag(type) -> type; diff --git a/lib/edoc/test/edoc_SUITE.erl b/lib/edoc/test/edoc_SUITE.erl index 46d23a6acbb9..c569ccd70f1f 100644 --- a/lib/edoc/test/edoc_SUITE.erl +++ b/lib/edoc/test/edoc_SUITE.erl @@ -25,13 +25,13 @@ %% Test cases -export([app/1,appup/1,build_std/1,build_map_module/1,otp_12008/1, build_app/1, otp_14285/1, infer_module_app_test/1, - module_with_feature/1, module_with_maybe/1]). + module_with_feature/1, module_with_maybe/1, module_with_nominal/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app,appup,build_std,build_map_module,otp_12008, build_app, otp_14285, - infer_module_app_test, module_with_feature]. + infer_module_app_test, module_with_feature, module_with_nominal]. groups() -> []. @@ -172,3 +172,13 @@ module_with_maybe(Config) -> PreprocessOpts = [{preprocess, true}, {dir, PrivDir}], ok = edoc:files([Source], PreprocessOpts), ok. + +module_with_nominal(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Source = filename:join(DataDir, "module_with_nominal.erl"), + DodgerOpts = [{dir, PrivDir}], + ok = edoc:files([Source], DodgerOpts), + PreprocessOpts = [{preprocess, true}, {dir, PrivDir}], + ok = edoc:files([Source], PreprocessOpts), + ok. \ No newline at end of file diff --git a/lib/edoc/test/edoc_SUITE_data/module_with_nominal.erl b/lib/edoc/test/edoc_SUITE_data/module_with_nominal.erl new file mode 100644 index 000000000000..3afbe040852f --- /dev/null +++ b/lib/edoc/test/edoc_SUITE_data/module_with_nominal.erl @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2022. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(module_with_nominal). +-compile([export_all,nowarn_export_all]). + +-nominal nominal_test_a() :: integer(). +-nominal nominal_test_b() :: erl_anno:location(). + +-spec t(nominal_test_b()) -> nominal_test_b(). +t(X) -> X. \ No newline at end of file diff --git a/lib/edoc/test/eep48_SUITE_data/eep48_specs.erl b/lib/edoc/test/eep48_SUITE_data/eep48_specs.erl index 84fb08dbd660..7da149f59125 100644 --- a/lib/edoc/test/eep48_SUITE_data/eep48_specs.erl +++ b/lib/edoc/test/eep48_SUITE_data/eep48_specs.erl @@ -3,10 +3,12 @@ -export([]). --export_type([opaque_type/0]). +-export_type([opaque_type/0,nominal_type/0]). -opaque opaque_type() :: atom(). +-nominal nominal_type() :: atom(). + -spec f_spec_type_without_name(atom()) -> ok. f_spec_type_without_name(Arg) -> ok. diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index bdda7769b23c..e290817f6fa1 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -526,6 +526,7 @@ list_dir(Dir) -> trie_new() -> gb_trees:empty(). +-dialyzer({no_opaque_union, [trie_store/2]}). trie_store([_ | _], []) -> []; trie_store([E | Es], T) -> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 172f4d5b280a..9b9c6fb61603 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -536,6 +536,7 @@ load_file(Mod) when is_atom(Mod) -> {Mod,Binary,File} -> load_module(Mod, File, Binary, false) end. +-dialyzer({no_opaque_union, [ensure_loaded/1]}). -doc """ Tries to load a module in the same way as `load_file/1`, unless the module is already loaded. @@ -574,6 +575,7 @@ ensure_loaded(Mod) when is_atom(Mod) -> end end. +-dialyzer({no_opaque_union, [ensure_prepare_loading/3]}). ensure_prepare_loading(Mod, missing, File) -> case erl_prim_loader:read_file(File) of {ok, Binary} -> erlang:prepare_loading(Mod, Binary); diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index f96b64710d91..65386ad6c7ff 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1305,6 +1305,7 @@ db_erase_tab(disc_only_copies, _Tab) -> ignore; db_erase_tab({ext, _Alias, _Mod}, _Tab) -> ignore. %% assuming that Tab is a valid ets-table +-dialyzer({no_opaque_union, [dets_to_ets/6]}). dets_to_ets(Tabname, Tab, File, Type, Rep, Lock) -> {Open, Close} = mkfuns(Lock), case Open(Tabname, [{file, File}, {type, disk_type(Tab, Type)}, @@ -1317,6 +1318,7 @@ dets_to_ets(Tabname, Tab, File, Type, Rep, Lock) -> Other end. +-dialyzer({no_opaque_union, [trav_ret/2]}). trav_ret(Tabname, Tabname) -> loaded; trav_ret(Other, _Tabname) -> Other. diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index fc8f19edffc8..b578ddac2309 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -57,6 +57,7 @@ disc_load_table(Tab, Reason, Cs) -> {type, Type}]), do_get_disc_copy2(Tab, Reason, Storage, Type). +-dialyzer({no_opaque_union, [do_get_disc_copy2/4]}). do_get_disc_copy2(Tab, Reason, Storage, _Type) when Storage == unknown -> verbose("Local table copy of ~0tp ~0p has recently been deleted, ignored.~n", [Tab, Reason]), diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index c73e0f7ed46e..13ee81991a2c 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -559,6 +559,7 @@ read_disc_schema(Keep, IgnoreFallback) -> end end. +-dialyzer({no_opaque_union, [do_read_disc_schema/2]}). do_read_disc_schema(Fname, Keep) -> T = case Keep of diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 32b1aaa2b750..27b401f4a01c 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -289,7 +289,7 @@ Floats (\+|-)?[0-9]+\.[0-9]+((E|e)(\+|-)?[0-9]+)? Token :: term(), ErrorInfo :: {error, error_info(), erl_anno:location()}, EndLoc :: erl_anno:location(). -string(_String) -> error(undef). +string(_String) -> erlang:nif_error(undef). -doc """ Scans `String` and returns either all the tokens in it or an `error` tuple. @@ -310,7 +310,7 @@ or [`erl_anno:location()`](`t:erl_anno:location/0`), depending on the ErrorInfo :: {error, error_info(), erl_anno:location()}, StartLoc :: erl_anno:location(), EndLoc :: erl_anno:location(). -string(_String, _StartLoc) -> error(undef). +string(_String, _StartLoc) -> erlang:nif_error(undef). -doc #{equiv => token(Cont, Chars, 1)}. -doc(#{title => <<"Generated Scanner Exports">>}). @@ -326,7 +326,7 @@ string(_String, _StartLoc) -> error(undef). ErrorInfo :: {error, error_info(), erl_anno:location()}, Token :: term(), EndLoc :: erl_anno:location(). -token(_Cont, _Chars) -> error(undef). +token(_Cont, _Chars) -> erlang:nif_error(undef). -doc """ This is a re-entrant call to try and scan a single token from `Chars`. @@ -361,7 +361,7 @@ io:request(InFile, {get_until,unicode,Prompt,Module,token,[Loc]}) Token :: term(), StartLoc :: erl_anno:location(), EndLoc :: erl_anno:location(). -token(_Cont, _Chars, _StartLoc) -> error(undef). +token(_Cont, _Chars, _StartLoc) -> erlang:nif_error(undef). -doc #{equiv => tokens(Cont, Chars, 1)}. -doc(#{title => <<"Generated Scanner Exports">>}). @@ -378,7 +378,7 @@ token(_Cont, _Chars, _StartLoc) -> error(undef). Token :: term(), ErrorInfo :: {error, error_info(), erl_anno:location()}, EndLoc :: erl_anno:location(). -tokens(_Cont, _Chars) -> error(undef). +tokens(_Cont, _Chars) -> erlang:nif_error(undef). -doc """ This is a re-entrant call to try and scan tokens from `Chars`. @@ -419,7 +419,7 @@ io:request(InFile, {get_until,unicode,Prompt,Module,tokens,[Loc]}) ErrorInfo :: {error, error_info(), erl_anno:location()}, StartLoc :: erl_anno:location(), EndLoc :: erl_anno:location(). -tokens(_Cont, _Chars, _StartLoc) -> error(undef). +tokens(_Cont, _Chars, _StartLoc) -> erlang:nif_error(undef). %%% %%% Exported functions diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 73151e25e07d..4d557cf3ead2 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -416,17 +416,19 @@ sockaddr_to_list(#{family := inet6, addr := Addr, port := Port, " , " ++ erlang:integer_to_list(SID); sockaddr_to_list(Addr) -> f("~p", [Addr]). - + +-dialyzer({no_opaque_union, [get_ets_tab_id/1]}). +get_ets_tab_id(Id) -> + case ets:info(Id, named_table) of + true -> ignore; + false -> Id + end. get_table_list(ets, Opts) -> HideUnread = proplists:get_value(unread_hidden, Opts, true), HideSys = proplists:get_value(sys_hidden, Opts, true), Info = fun(Id, Acc) -> try - TabId = case ets:info(Id, named_table) of - true -> ignore; - false -> Id - end, Name = ets:info(Id, name), Protection = ets:info(Id, protection), ignore(HideUnread andalso Protection == private, unreadable), @@ -442,7 +444,7 @@ get_table_list(ets, Opts) -> andalso is_atom((catch mnesia:table_info(Name, where_to_read))), mnesia_tab), Memory = ets:info(Id, memory) * erlang:system_info(wordsize), Tab = [{name,Name}, - {id,TabId}, + {id,get_ets_tab_id(Id)}, {protection,Protection}, {owner,Owner}, {size,ets:info(Id, size)}, diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 1ff45299a4ec..2232999e360e 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -946,6 +946,7 @@ do_gc_cache(Cache, [Key|Keys]) -> ets:delete(Cache, Key), do_gc_cache(Cache, Keys). +-dialyzer({no_opaque_union, [maybe_invalidate_cache/1]}). maybe_invalidate_cache(?NO_CACHE) -> ?NO_CACHE; maybe_invalidate_cache(Cache) -> diff --git a/lib/snmp/src/agent/snmpa_vacm.erl b/lib/snmp/src/agent/snmpa_vacm.erl index f159e6bd7aed..2194d178a394 100644 --- a/lib/snmp/src/agent/snmpa_vacm.erl +++ b/lib/snmp/src/agent/snmpa_vacm.erl @@ -188,6 +188,7 @@ loop_mib_view_get(Indexes) -> init(Dir) -> init(Dir, terminate). +-dialyzer({no_opaque_union, [init/2]}). init(Dir, InitError) -> FName = filename:join(Dir, "snmpa_vacm.db"), case file:read_file_info(FName) of diff --git a/lib/ssh/src/ssh_client_channel.erl b/lib/ssh/src/ssh_client_channel.erl index bcc2848b50ef..fd8ba096cb11 100644 --- a/lib/ssh/src/ssh_client_channel.erl +++ b/lib/ssh/src/ssh_client_channel.erl @@ -335,7 +335,7 @@ The user is responsible for any initialization of the process and must call `init/1`. """. -doc(#{since => <<"OTP 21.0">>}). --spec enter_loop(State) -> _ when State :: term(). +-spec enter_loop(State) -> no_return() when State :: term(). enter_loop(State) -> gen_server:enter_loop(?MODULE, [], State). diff --git a/lib/ssl/src/ssl_gen_statem.erl b/lib/ssl/src/ssl_gen_statem.erl index 060b202092bf..b46c7640654a 100644 --- a/lib/ssl/src/ssl_gen_statem.erl +++ b/lib/ssl/src/ssl_gen_statem.erl @@ -1552,7 +1552,12 @@ read_application_dist_data(_DHandle, [] = Front, BufferSize, [] = Rear) -> read_application_dist_data(DHandle, [], BufferSize, Rear) -> [Bin|Front] = lists:reverse(Rear), read_application_dist_data(DHandle, Front, BufferSize, [], Bin). -%% + +%% We suppress opacity warnings because we've violated the opacity of +%% `erlang:dist_handle() :: atom()` previously in the code, mixing it with +%% the magic atom 'undefined' caused the opacity to be removed leading to +%% warnings in calls to erlang:dist_ctrl_put_data/2 +-dialyzer({no_opaque, [read_application_dist_data/5]}). read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) -> case Bin0 of %% diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl index ef47d5a4df33..976c9b41a184 100644 --- a/lib/stdlib/src/erl_anno.erl +++ b/lib/stdlib/src/erl_anno.erl @@ -119,8 +119,8 @@ or a list of key-value pairs. -type column() :: pos_integer(). -type generated() :: boolean(). -type filename() :: file:filename_all(). --type line() :: non_neg_integer(). --type location() :: line() | {line(), column()}. +-nominal line() :: non_neg_integer(). +-nominal location() :: line() | {line(), column()}. -type record() :: boolean(). -type text() :: string(). diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 8a15221d6546..1d3437d58c87 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -180,8 +180,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: #{atom() => {anno(),Fields :: term()}}, locals=gb_sets:empty() %All defined functions (prescanned) :: gb_sets:set(fa()), - no_auto=gb_sets:empty() %Functions explicitly not autoimported - :: gb_sets:set(fa()) | 'all', + no_auto={set, gb_sets:empty()} %Functions explicitly not autoimported + :: 'all' | {set, gb_sets:set(fa())}, defined=gb_sets:empty() %Defined fuctions :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function @@ -1074,6 +1074,9 @@ attribute_state({attribute,A,type,{TypeName,TypeDef,Args}}, St) -> attribute_state({attribute,A,opaque,{TypeName,TypeDef,Args}}, St) -> St1 = untrack_doc({type, TypeName, length(Args)}, St), type_def(opaque, A, TypeName, TypeDef, Args, St1); +attribute_state({attribute,A,nominal,{TypeName,TypeDef,Args}}=AST, St) -> + St1 = untrack_doc(AST, St), + type_def(nominal, A, TypeName, TypeDef, Args, St1); attribute_state({attribute,A,spec,{Fun,Types}}, St) -> spec_decl(A, Fun, Types, St); attribute_state({attribute,A,callback,{Fun,Types}}, St) -> @@ -1155,6 +1158,9 @@ function_state({attribute,A,type,{TypeName,TypeDef,Args}}, St) -> function_state({attribute,A,opaque,{TypeName,TypeDef,Args}}, St) -> St1 = untrack_doc({type, TypeName, length(Args)}, St), type_def(opaque, A, TypeName, TypeDef, Args, St1); +function_state({attribute,A,nominal,{TypeName,TypeDef,Args}}=AST, St) -> + St1 = untrack_doc(AST, St), + type_def(nominal, A, TypeName, TypeDef, Args, St1); function_state({attribute,A,spec,{Fun,Types}}, St) -> spec_decl(A, Fun, Types, St); function_state({attribute,_A,doc,_Val}=AST, St) -> @@ -3818,6 +3824,8 @@ check_local_opaque_types(St) -> FoldFun = fun(_Type, #typeinfo{attr = type}, AccSt) -> AccSt; + (_Type, #typeinfo{attr = nominal, anno = _Anno}, AccSt) -> + AccSt; (Type, #typeinfo{attr = opaque, anno = Anno}, AccSt) -> case gb_sets:is_element(Type, ExpTs) of true -> AccSt; @@ -3886,7 +3894,8 @@ is_module_dialyzer_option(Option) -> error_handling,race_conditions,no_missing_calls, specdiffs,overspecs,underspecs,unknown, no_underspecs,extra_return,no_extra_return, - missing_return,no_missing_return,overlapping_contract + missing_return,no_missing_return,overlapping_contract, + opaque_union,no_opaque_union ]). %% try_catch_clauses(Scs, Ccs, In, ImportVarTable, State) -> @@ -5037,12 +5046,12 @@ auto_import_suppressed(CompileFlags) -> false -> L0 = [ X || {no_auto_import,X} <- CompileFlags ], L1 = [ {Y,Z} || {Y,Z} <- lists:flatten(L0), is_atom(Y), is_integer(Z) ], - gb_sets:from_list(L1) + {set, gb_sets:from_list(L1)} end. %% Predicate to find out if autoimport is explicitly suppressed for a function is_autoimport_suppressed(all,{_Func,_Arity}) -> true; -is_autoimport_suppressed(NoAutoSet,{Func,Arity}) -> +is_autoimport_suppressed({set, NoAutoSet},{Func,Arity}) -> gb_sets:is_element({Func,Arity},NoAutoSet). %% Predicate to find out if a function specific bif-clash suppression (old deprecated) is present bif_clash_specifically_disabled(St,{F,A}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 7babc9c7bc1d..090f74d7ad29 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -856,7 +856,7 @@ processed (see section [Error Information](#module-error-information)). -type af_type_decl() :: {'attribute', anno(), type_attr(), {type_name(), abstract_type(), [af_variable()]}}. --type type_attr() :: 'opaque' | 'type'. +-type type_attr() :: 'nominal' | 'opaque' | 'type'. -type af_function_spec() :: {'attribute', anno(), spec_attr(), {{function_name(), arity()}, @@ -1375,14 +1375,14 @@ parse_term(Tokens) -> end. -type attributes() :: 'export' | 'file' | 'import' | 'module' - | 'opaque' | 'record' | 'type'. + | 'nominal' | 'opaque' | 'record' | 'type'. build_typed_attribute({atom,Aa,record}, {typed_record, {atom,_An,RecordName}, RecTuple}) -> {attribute,Aa,record,{RecordName,record_tuple(RecTuple)}}; build_typed_attribute({atom,Aa,Attr}, {type_def, {call,_,{atom,_,TypeName},Args}, Type}) - when Attr =:= 'type' ; Attr =:= 'opaque' -> + when Attr =:= 'type' ; Attr =:= 'opaque' ; Attr =:= 'nominal'-> lists:foreach(fun({var, A, '_'}) -> ret_err(A, "bad type variable"); (_) -> ok end, Args), @@ -1395,6 +1395,7 @@ build_typed_attribute({atom,Aa,Attr}=Abstr,_) -> case Attr of record -> error_bad_decl(Abstr, record); type -> error_bad_decl(Abstr, type); + nominal -> error_bad_decl(Abstr, nominal); opaque -> error_bad_decl(Abstr, opaque); _ -> ret_err(Aa, "bad attribute") end. @@ -2246,6 +2247,11 @@ modify_anno1({attribute,A,opaque,{TypeName,TypeDef,Args}}, Ac, Mf) -> {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), {{attribute,A1,opaque,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,nominal,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,nominal,{TypeName,TypeDef1,Args1}},Ac3}; modify_anno1({attribute,A,Attr,Val}, Ac, Mf) -> {A1,Ac1} = Mf(A, Ac), {{attribute,A1,Attr,Val},Ac1}; diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index bff5a9231852..34eb7cc36f20 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -402,6 +402,8 @@ lattribute({attribute,_Anno,type,Type}, Opts) -> [typeattr(type, Type, Opts),leaf(".\n")]; lattribute({attribute,_Anno,opaque,Type}, Opts) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; +lattribute({attribute,_Anno,nominal,Type}, Opts) -> + [typeattr(nominal, Type, Opts),leaf(".\n")]; lattribute({attribute,_Anno,spec,Arg}, _Opts) -> [specattr(spec, Arg),leaf(".\n")]; lattribute({attribute,_Anno,callback,Arg}, _Opts) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 6d30ff35646b..85bce919bc2a 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -414,6 +414,7 @@ get_command(Prompt, Eval, Bs, RT, FT, Ds) -> record -> SpecialCase(rd); spec -> SpecialCase(ft); type -> SpecialCase(td); + nominal -> SpecialCase(td); _ -> erl_eval:extended_parse_exprs(Toks) end; [{atom, _, FunName}, {'(', _}|_] -> @@ -1386,6 +1387,10 @@ local_func(td, [{string, _, TypeDef}], Bs, _Shell, _RT, FT, _Lf, _Ef) -> true = ets:insert(FT, [{{type, TypeName}, AttrForm}]), true = ets:insert(FT, [{{type_def, TypeName}, TypeDef}]), {value, ok, Bs}; + {ok, {attribute,_,nominal,{TypeName, _, _}}=AttrForm} -> + true = ets:insert(FT, [{{type, TypeName}, AttrForm}]), + true = ets:insert(FT, [{{type_def, TypeName}, TypeDef}]), + {value, ok, Bs}; {error,{_Location,M,ErrDesc}} -> ErrStr = io_lib:fwrite(<<"~ts">>, [M:format_error(ErrDesc)]), exit(lists:flatten(ErrStr)) diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index a2f3519f923f..0a3e65b9727d 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -723,12 +723,6 @@ get_line(Node) -> L; {L, _} when is_integer(L) -> L; - {_, L} when is_integer(L) -> - L; - {L, _, _} when is_integer(L) -> - L; - {_, L, _} when is_integer(L) -> - L; Pos -> try erl_anno:line(Pos) of Line -> diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl index c9841c388e54..49ca53e6fbf7 100644 --- a/lib/syntax_tools/src/merl_transform.erl +++ b/lib/syntax_tools/src/merl_transform.erl @@ -281,6 +281,7 @@ is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× -> is_erlang_var(_) -> false. +-dialyzer({no_opaque_union, [get_location/1]}). get_location(T) -> Pos = erl_syntax:get_pos(T), case erl_anno:is_anno(Pos) of diff --git a/make/ex_doc.sha1sum b/make/ex_doc.sha1sum index 605a75e7c58d..4543c2fe8c5e 100644 --- a/make/ex_doc.sha1sum +++ b/make/ex_doc.sha1sum @@ -1 +1 @@ -b9ca6bd69a70b2b2bd0b93bf64dfb352981a7441 ../bin/ex_doc +d518f39fdf2307efbcdbc464589ffbf43193db85 ../bin/ex_doc diff --git a/make/ex_doc.sha256sum b/make/ex_doc.sha256sum index 231a3513f00c..b8ad1201dcfe 100644 --- a/make/ex_doc.sha256sum +++ b/make/ex_doc.sha256sum @@ -1 +1 @@ -d1e09ef6772132f36903fbb1c13d6972418b74ff2da71ab8e60fa3770fc56ec7 ../bin/ex_doc +b5cb71fef4b9b4ac06ec1e5ce9eed97a79777b13cecb64d69ca801e9b2fc548a ../bin/ex_doc diff --git a/make/ex_doc_link b/make/ex_doc_link index 0affbf101b8f..d70ee75e613e 100644 --- a/make/ex_doc_link +++ b/make/ex_doc_link @@ -1 +1 @@ -https://github.com/elixir-lang/ex_doc/releases/download/v0.34.1/ex_doc_otp_26 +https://github.com/elixir-lang/ex_doc/releases/download/v0.35.1/ex_doc_otp_27 diff --git a/make/ex_doc_vsn b/make/ex_doc_vsn index d7c007cf5a39..6911254bc622 100644 --- a/make/ex_doc_vsn +++ b/make/ex_doc_vsn @@ -1 +1 @@ -v0.34.1 +v0.35.1